Создание контура подрезки для блока

Понадобилось мне тут полностью программно создать контур подрезки для блока. Все, что находил в интернете, касалось модификации или чтения уже готового контура, а создание все время выполнялось командой _.xclip.

Ну, мириться с таким положением дел я не стал, кое-что наваял. Чем и хочу похвастаться / поделиться / опозориться (нужное подчеркнуть) :).

Предупреждаю сразу - исходника не будет, т.к. код не проверялся во всех возможных случаях. Пока что могу сказать следующее: код работает для блоков в мировой системе координат, повернутых под любым углом и имеющими любые коэффициенты масштабирования по любым осям. Не обрабатывается вариант дуговой подрезки (скажу честно - пока не надо, потому и голову не ломал).

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
(defun _lispru-block-xclip (ename pt-lst / data dict tempdict templist)
                          ;|
*    Создание контура подрезки для вхождения блока
* На основе кодов, предоставленных в
* http://www.theswamp.org/index.php?topic=25232.msg303688;topicseen#msg303688
* http://www.theswamp.org/index.php?topic=39201.msg444355#msg444355
*    Параметры вызова:
  ename    ename-указатель на вхождения блока.
  pt-lst   список точек, ограничивающих область подрезки. Правила определения -
           как в стандартной команде _.xclip
*    Примеры вызова:
(_lispru-block-xclip
  (car (entsel "\nSelect block : "))
  (mapcar 'cdr (vl-remove-if-not
                 '(lambda(x)
                    (= (car x) 10)
                   )
                 (entget (car (entsel "\nSelect pline : "))))))
|;

          ; Set the xclip boundry
  (if (and (setq data (entget ename))
           (setq dict (if (setq templist (assoc 360 data))
                        (cdr templist)
                        (entmakex '((0 . "DICTIONARY") (100 . "AcDbDictionary")))
                        ) ;_ end of if
                 ) ;_ end of setq
           (setq tempdict
                  (if (setq templist (dictsearch dict "ACAD_FILTER"))
                    (cdr (assoc -1 templist))
                    (dictadd dict "ACAD_FILTER" (entmakex '((0 . "DICTIONARY") (100 . "AcDbDictionary"))))
                    ) ;_ end of if
                 ) ;_ end of setq
           ) ;_ end of and
    (progn
      (entupd ename)
      (dictremove tempdict "SPATIAL")
      (dictadd
        tempdict
        "SPATIAL"
        (entmakex
          (append
            '((0 . "SPATIAL_FILTER")
              (100 . "AcDbFilter")
              (100 . "AcDbSpatialFilter")
              )
            (list (cons 70 (length pt-lst)))
            (mapcar
              (function
                (lambda (x)
                  (cons 10 x)
                  ) ;_ end of LAMBDA
                ) ;_ end of FUNCTION
              pt-lst
              ) ;_ end of mapcar
            (list (assoc 210 (entget ename)))
            '((11 0.0 0.0 0.0)
              (71 . 1)
              (72 . 0)
              (73 . 0)
              )
            (mapcar
              (function
                (lambda (x)
                  (cons 40 x)
                  ) ;_ end of lambda
                ) ;_ end of function
              (apply (function append)
                     ((lambda (a p x y z)
                        (list
                          (mapcar '(lambda (_x) (/ _x x))
                                  (list (cos a) (- (sin a)) 0. (- 0. (* (car p) (cos a)) (* (cadr p) (- (sin a)))))
                                  ) ;_ end of mapcar
                          (mapcar '(lambda (_y) (/ _y y))
                                  (list (sin a) (cos a) 0. (- 0. (* (car p) (sin a)) (* (cadr p) (cos a))))
                                  ) ;_ end of mapcar
                          (list 0. 0. 1. 0.)
                          '(1. 0. 0. 0.)
                          '(0. 1. 0. 0.)
                          '(0. 0. 1. 0.)
                          ) ;_ end of list
                        ) ;_ end of lambda
                       (- (cdr (assoc 50 (entget ename))))
                       (cdr (assoc 10 (entget ename)))
                       (cdr (assoc 41 (entget ename)))
                       (cdr (assoc 42 (entget ename)))
                       (cdr (assoc 43 (entget ename)))
                       )
                     ) ;_ end of list
              ) ;_ end of mapcar
            ) ;_ end of append
          ) ;_ end of entmakex
        ) ;_ end of dictadd
          ;fltdata))
      (entmod
        (if (setq templist (assoc 360 data))
          (subst (cons 360 dict) templist data)
          (progn
            (setq templist (member (assoc 5 data) (reverse data)))
            (append
              (reverse templist)
              (append
                (list
                  '(102 . "{ACAD_XDICTIONARY")
                  (cons 360 dict)
                  '(102 . "}")
                  ) ;_ end of list
                (member (assoc 5 data) data)
                ) ;_ end of append
              ) ;_ end of append
            ) ;_ end of progn
          ) ;_ end of if
        ) ;_ end of entmod
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun

Если есть идеи, как код усовершенствовать (например, заставить код работать в неактивном документе, или дополнить обработкой дуг) - милости прошу.

Размещено в Код LISP, Функции LISP · Метки: ,



Комментарии

Есть 2 коммент. к “Создание контура подрезки для блока”
  1. TararykovDG пишет:

    Алексей, доброго времени дня! К сожалению идей, как усовершенствовать код у меня нет, пока появились только вопросы, если не затруднит поясни пожалуйста. Во-первых, обработка дуг, вроде бы даже штатная команда _.xclip не создает контур по полилинии у которой есть дуговой сегмент (во всяком случае у меня в ACAD2008 именно так). Во-вторых, Твой код создает контур, который оставляет видимой ту часть блока, которая внутри контура, а как сделать наоборот (т. е. имеется ввиду опция "обратной подрезки"), сам перелазил dxf-коды для двух вариантов контуров разницы не нашел.

  2. Кулик Алексей aka kpblc пишет:

    Доброго.
    Насчет инвертирования подрезки - вот чего не знаю, того не знаю. Подобной задачи в принципе не ставилось никогда, а быстрый просмотр dxf-представления копий блоков с "нормальной" и "инвертированной" подрезками ничего не дал.
    Хотя, если посмотреть на ACAD_XDICTIONARY, то для нормальной подрезки ссылка идет на один словарь, а для инвертированной - на другой (имею в виду ACAD_FILTER). Может, будет иметь смысл попробовать выполнить (entget item '("*")) для каждого ACAD_FILTER и посмотреть - может, там еще где-то разница есть?
    P.S. Сейчас, к сожалению, возможности выполнить нормальный разбор ситуации нет :(

Поделитесь своим мнением


Я не робот.