如何用lisp合并有公共边的多边形（多边形可能为不闭合多段线或二维多段线画的）

hkluck

如何用lisp合并有公共边的多边形（多边形可能为不闭合多段线或二维多段线画的）？

guohq

转面域 再合并 再生成边界

yshf

使用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 - [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)
                        (caadr  cadar)
                        (caadr cadadr)
                        (caar  cadadr)
                    )
                )
            )
        )
    )
    (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)
            (ssadd  enl 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 - [sel] 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))
    )
)