多段线交叉部分剪切,并合并未剪切部分,如何实现
本帖最后由 慧不绘 于 2016-5-12 10:40 编辑本人业余能写些小程序,现在遇到了下面的问题,忘前辈们指点一二!
如下图所示,左边是2个封闭的多段线,我希望程序这样运行:输入指令后选择这两个多段线,如果不封闭则提示并停止程序,如果封闭,则剪切掉他们重合的部分,并 合并未剪切部分,如右图结果!
我觉得方法可能有两种:1,剪切掉重合部分,并合并未剪切部分;2,复制提取出2个对象外围的轨迹,并把选择的对象删除!
不知如何实现,忘提供解决方法,思路等,谢谢!
预计先实现2个对象的合并,后面再考虑对多个对象的同时合并,如第二幅图
;; 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
)
)
) kozmosovia 发表于 2016-5-12 17:43 static/image/common/back.gif
;; Outline Objects-Lee Mac
;; Attempts to generate a polyline outlining the selected objects. ...
完美解决,多谢!
页:
[1]