Создание контура подрезки для блока
Понадобилось мне тут полностью программно создать контур подрезки для блока. Все, что находил в интернете, касалось модификации или чтения уже готового контура, а создание все время выполнялось командой _.xclip.
Ну, мириться с таким положением дел я не стал, кое-что наваял. Чем и хочу похвастаться / поделиться / опозориться (нужное подчеркнуть) 
.
Предупреждаю сразу – исходника не будет, т.к. код не проверялся во всех возможных случаях. Пока что могу сказать следующее: код работает для блоков в мировой системе координат, повернутых под любым углом и имеющими любые коэффициенты масштабирования по любым осям. Не обрабатывается вариант дуговой подрезки (скажу честно – пока не надо, потому и голову не ломал).
;|
* Создание контура подрезки для вхождения блока
* На основе кодов, предоставленных в
* 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
Если есть идеи, как код усовершенствовать (например, заставить код работать в неактивном документе, или дополнить обработкой дуг) – милости прошу.
Материалы для проектирования, работы и разработки (и не только в AutoCAD)