如何用lisp合并有公共边的多边形（多边形可能为不闭合多段线或二维多段线画的）
如何用lisp合并有公共边的多边形（多边形可能为不闭合多段线或二维多段线画的）？转面域 再合并 再生成边界 本帖最后由 yshf 于 2021-4-17 22:32 编辑
使用Lee Mac的outline
;|
http://www.theswamp.org/index.php?topic=48031.msg573108#msg573108
Lee Mac
Re: Create boundary (polyline) around selected objects
<< Reply #33 on: November 26, 2014, 06:24:28 PM >>
|;
(defun c:outline ( / sel )
(vl-load-com)
(if (setq sel (ssget))
(sssetfirst nil (LM:outline sel))
)
(princ)
)
;; Object Outline-Lee Mac
;; Attempts to generate a polyline outlining the selected objects.
;; sel - Selection Set to outline
(defun LM:outline ( sel / app are box cmd dis enl ent lst obj rtn tmp )
(setq app (vlax-get-acad-object)
box (LM:ssboundingbox sel)
dis (/ (apply 'distance box) 20.0)
lst (mapcar '(lambda ( a o ) (mapcar o a (list dis dis))) box '(- +))
are (apply '* (apply 'mapcar (cons '- (reverse lst))))
dis (* dis 1.5)
ent
(entmakex
(append
'( (000 . "LWPOLYLINE")
(100 . "AcDbEntity")
(100 . "AcDbPolyline")
(090 . 4)
(070 . 1)
)
(mapcar '(lambda ( x ) (cons 10 (mapcar '(lambda ( y ) ((eval y) lst)) x)))
'( (caar cadar)
(caadrcadar)
(caadr cadadr)
(caarcadadr)
)
)
)
)
)
(apply 'vlax-invoke
(vl-list* app 'zoomwindow
(mapcar '(lambda ( a o ) (mapcar o a (list dis dis 0.0))) box '(- +))
)
)
(setq cmd (getvar 'cmdecho)
enl (entlast)
rtn (ssadd)
)
(while (setq tmp (entnext enl)) (setq enl tmp))
(setvar 'cmdecho 0)
(command
"_.-boundary" "_a" "_b" "_n" sel ent "" "_i" "_y" "_o" "_p" "" "_non"
(trans (mapcar '- (car box) (list (/ dis 3.0) (/ dis 3.0))) 0 1) ""
)
(while (< 0 (getvar 'cmdactive)) (command ""))
(entdel ent)
(while (setq enl (entnext enl))
(if (and (vlax-property-available-p (setq obj (vlax-ename->vla-object enl)) 'area)
(equal (vla-get-area obj) are 1e-4)
)
(entdel enl)
(ssaddenl rtn)
)
)
(vla-zoomprevious app)
(setvar 'cmdecho cmd)
rtn
)
;; Selection Set Bounding Box-Lee Mac
;; Returns a list of the lower-left and upper-right WCS coordinates of a
;; rectangular frame bounding all objects in a supplied selection set.
;; s - Selection set for which to return bounding box
(defun LM:ssboundingbox ( s / a b i m n o )
(repeat (setq i (sslength s))
(if
(and
(setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
(vlax-method-applicable-p o 'getboundingbox)
(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))
)
(setq m (cons (vlax-safearray->list a) m)
n (cons (vlax-safearray->list b) n)
)
)
)
(if (and m n)
(mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n))
)
)
页:
[1]