删除边界外的对象
大家好。我需要一个例程,可以删除aotucad绘图中闭合多段线或边界(基于我的选择点输入或输出)内外的所有对象。
有什么解决办法吗?
谢谢 这里有一个在闭合多段线内松弛的例程。
http://cadtips.cadalyst.com/polylines/erase-inside-a-closed-pline 谢谢你的评论。
我以前测试过。但它总是显示出这样的错误:
“多段线未闭合。。。
未选择任何内容。。。
选择对象:“
我不明白这个错误的原因。因为我自己画了一个闭合的折线。 这里有一个关于内部的快速示例:
(defun c:pDel (/ GroupByNum _GetLocked lst->str ENT I LK OBJ PTLST SS)
(vl-load-com)
;; Lee Mac~02.04.10
(defun GroupByNum (lst num / rtn)
(setq rtn nil)
(if lst
(cons (reverse
(repeat num
(progn
(setq rtn (cons (car lst) rtn)
lst (cdr lst))
rtn)))
(GroupByNum lst num))))
(defun _GetLocked (/ tdef lk)
(while (setq tdef (tblnext "LAYER" (not tdef)))
(if (= 4 (logand 4 (cdr (assoc 70 tdef))))
(setq lk (cons (cdr (assoc 2 tdef)) lk)))))
(defun lst->str (lst del / str)
(setq str (car lst))
(while (setq lst (cdr lst)) (setq str (strcat str del (car lst))))
str)
(while
(progn
(setq ent (car (entsel "\nSelect Polyline: ")))
(cond ((eq 'ENAME (type ent))
(if (wcmatch (cdr (assoc 0 (entget ent))) "*POLYLINE")
(progn
(setq ptLst
(GroupByNum
(vlax-get
(setq obj (vlax-ename->vla-object ent)) 'Coordinates)
(if (eq "AcDbPolyline" (vla-get-ObjectName obj)) 2 3)))
(if (cadr
(sssetfirst nil
(setq i -1 ss
(ssget "_WP" ptLst
(if (setq lk (_GetLocked))
(list (cons -4 "<NOT")
(cons 8 (lst->str lk ",")) (cons -4 "NOT>")))))))
(if (progn
(initget "Yes No")
(not (eq "No" (getkword "\nDelete Objects? <Yes> : "))))
(while (setq ent (ssname ss (setq i (1+ i))))
(entdel ent))
(sssetfirst nil nil))
(princ "\n** No Objects Found **")))
(princ "\n** Object Must be a Polyline **"))))))
(princ))
试试这个,一个快速、无错误的控制
我试了几次就成功了
;;; Erase in or out of polylineLPS 2010-04-02
(defun c:test (/ idx obj endparam cnt pnt ss1)
(vl-load-com)
(setq ptlst nil)
(setq ss1 nil)
(setq obj (vlax-ename->vla-object (car (setq pl (entsel "\nSelect polyline boundary: ")))))
(if (or; test if polyline and has area
(/= (vlax-get-property obj 'ObjectName) "AcDbPolyline")
(zerop (vlax-get-property obj 'Area))
)
(princ "\nSelected entity is not a polyline or can not be used for a section window")
)
(setq p1 (getpoint "Pick side to erase: ")
pnt (entmakex
(list (cons 0 "point")
(cons 10 p1))
)
)
(setq ptlst (list (vlax-curve-getStartPoint obj))
idx 1)
(if (zerop (vlax-get obj 'Closed))
(setq endparam (vlax-curve-getParamAtPoint obj (vlax-curve-getEndPoint obj)));if open param at end point
(setq endparam (cdr (assoc 90 (entget (vlax-vla-object->ename obj)))));if closed # vertices
)
(while
(<= idx endparam)
(if;test for curve -thanks to Lee Mac and others
(not
(equal
(angle '(0 0 0)
(vlax-curve-getSecondDeriv obj (1- idx))) 0.0 1e-
);not
(progn
(setq cnt (1- idx))
(repeat 15;divide curve
(setq ptlst(cons (vlax-curve-getPointAtParam obj (+ cnt 0.0625)) ptlst)
cnt (+ 0.0625 cnt))
);repeat
);progn
);if
(setq ptlst (cons (vlax-curve-getPointAtParam obj idx) ptlst)
idx (1+ idx))
);while
(setq ptlst (reverse ptlst))
(setq ss1(ssget "_WP" ptlst))
(if
(ssmemb pnt ss1)
(vl-cmdf "erase" ss1 "")
(progn
(setq ss1(ssget "_CP" ptlst))
(vl-cmdf "erase" "all" "r" ss1 pl ""))
)
(princ)
);defun
我使用Autodesk Map中的MAPTRIM。 我非常感谢李、伊普赛弗和阿兰·杰特。
在测试了您在这个线程中发布的所有代码后,我发现了一些错误或无操作。
根据李的代码:
选择多段线:
**未找到任何对象**
根据ipseifert的代码:
选择多段线边界:
拾取要擦除的边:;错误:错误的参数类型:
LSETP零
根据alanjt的代码:
按“i”字表示内部,什么也没发生。
通过键入“o”表示外部,所有图元都会删除,但选定的lwpolyline除外。
如果我的画操作错误,请帮助我。
对我来说效果很好。对象是否接触选定的LW多段线?
你能举个例子吗? 是否在多段线边界外拾取了内部没有可选择实体的多段线边界?如果是这样的话,你真的不需要例行公事。 这将擦除选定线内或接触选定线的对象。。。
(defun c:EIO (/ _p2ss o ent ssIn ssOut)
;; Erase Inside/Outside of selected LWPolyline
;; Alan J. Thompson, 04.02.10
(vl-load-com)
(or *EIO:Opt* (setq *EIO:Opt* "Inside"))
(setq _p2ss (lambda (ename)
(ssget "_WP"
((lambda (e / l)
(foreach x e (and (eq 10 (car x)) (setq l (cons (cdr x) l))))
(reverse l)
) ;_ lambda
(entget ename)
)
) ;_ ssget
) ;_ lambda
) ;_ setq
(and (setq o (car (entsel "\nSelect LWPolyline: ")))
(or (eq "LWPOLYLINE" (cdr (assoc 0 (setq ent (entget o)))))
(alert "Invalid object!")
) ;_ or
(not (initget 0 "Inside Outside"))
(setq *EIO:Opt*
(cond
((getkword (strcat "\nSpecify erase option <" *EIO:Opt* ">: ")))
(*EIO:Opt*)
) ;_ cond
) ;_ setq
(cond
((and (eq *EIO:Opt* "Inside") (setq ssIn (_p2ss o)))
((lambda (i)
(while (setq e (ssname ssIn (setq i (1+ i))))
(or (eq o e) (vl-catch-all-apply (function entdel) (list e)))
) ;_ while
) ;_ lambda
-1
)
)
((eq *EIO:Opt* "Outside")
(setq ssIn(_p2ss o)
ssOut (ssget "_X" (list (cons 410 (getvar 'ctab))))
) ;_ setq
((lambda (i)
(while (setq e (ssname ssOut (setq i (1+ i))))
(if ssIn
(or (ssmemb e ssIn) (eq o e) (vl-catch-all-apply (function entdel) (list e)))
(or (eq o e) (vl-catch-all-apply (function entdel) (list e)))
) ;_ if
) ;_ while
) ;_ lambda
-1
)
)
) ;_ cond
) ;_ and
(princ)
) ;_ defun
页:
[1]
2