慧不绘 发表于 2016-5-12 10:38:47

多段线交叉部分剪切,并合并未剪切部分,如何实现

本帖最后由 慧不绘 于 2016-5-12 10:40 编辑

本人业余能写些小程序,现在遇到了下面的问题,忘前辈们指点一二!
如下图所示,左边是2个封闭的多段线,我希望程序这样运行:输入指令后选择这两个多段线,如果不封闭则提示并停止程序,如果封闭,则剪切掉他们重合的部分,并 合并未剪切部分,如右图结果!
我觉得方法可能有两种:1,剪切掉重合部分,并合并未剪切部分;2,复制提取出2个对象外围的轨迹,并把选择的对象删除!
不知如何实现,忘提供解决方法,思路等,谢谢!
预计先实现2个对象的合并,后面再考虑对多个对象的同时合并,如第二幅图



kozmosovia 发表于 2016-5-12 17:43:00


;; Outline Objects-Lee Mac
;; Attempts to generate a polyline outlining the selected objects.
;; sel - Selection Set to outline
;; Returns: A selection set of all objects created
(defun vlobj-GetOutline        (sel          /           LM:ssboundingbox
                       LM:startundo           LM:endundo             A
                       APP          ARE           B          BOX             CMD
                       DIS          ENL           ENT          LST             O
                       OBJ          RTN           TMP          X             Y
                        )
;; 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)
      )
    )
)

;; Start Undo-Lee Mac
;; Opens an Undo Group.

(defun LM:startundo (doc)
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo-Lee Mac
;; Closes an Undo Group.

(defun LM:endundo (doc)
    (while (= 8 (logand 8 (getvar 'undoctl)))
      (vla-endundomark doc)
    )
)

(if (setq box (LM:ssboundingbox sel))
    (progn
      (setq app        (vlax-get-acad-object)
          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
    )
)
)

慧不绘 发表于 2016-5-14 09:28:28

kozmosovia 发表于 2016-5-12 17:43 static/image/common/back.gif
;; Outline Objects-Lee Mac
;; Attempts to generate a polyline outlining the selected objects. ...

完美解决,多谢!

start4444 发表于 2018-5-3 10:16:17

页: [1]
查看完整版本: 多段线交叉部分剪切,并合并未剪切部分,如何实现