kasra 发表于 2022-7-6 06:40:54

删除边界外的对象

大家好。
我需要一个例程,可以删除aotucad绘图中闭合多段线或边界(基于我的选择点输入或输出)内外的所有对象。
有什么解决办法吗?
谢谢

ReMark 发表于 2022-7-6 06:46:40

这里有一个在闭合多段线内松弛的例程。
 
http://cadtips.cadalyst.com/polylines/erase-inside-a-closed-pline

kasra 发表于 2022-7-6 06:49:41

谢谢你的评论。
我以前测试过。但它总是显示出这样的错误:
“多段线未闭合。。。
未选择任何内容。。。
选择对象:“
我不明白这个错误的原因。因为我自己画了一个闭合的折线。

Lee Mac 发表于 2022-7-6 06:53:24

这里有一个关于内部的快速示例:
 

(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))

lpseifert 发表于 2022-7-6 06:55:20

试试这个,一个快速、无错误的控制
我试了几次就成功了

;;; 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

alanjt 发表于 2022-7-6 06:58:03

我使用Autodesk Map中的MAPTRIM。

KJB 发表于 2022-7-6 07:00:44

我非常感谢李、伊普赛弗和阿兰·杰特。
在测试了您在这个线程中发布的所有代码后,我发现了一些错误或无操作。
根据李的代码:
选择多段线:
**未找到任何对象**
根据ipseifert的代码:
选择多段线边界:
拾取要擦除的边:;错误:错误的参数类型:
LSETP零
根据alanjt的代码:
按“i”字表示内部,什么也没发生。
通过键入“o”表示外部,所有图元都会删除,但选定的lwpolyline除外。
如果我的画操作错误,请帮助我。

kasra 发表于 2022-7-6 07:03:42

 
对我来说效果很好。对象是否接触选定的LW多段线?
你能举个例子吗?

alanjt 发表于 2022-7-6 07:08:21

是否在多段线边界外拾取了内部没有可选择实体的多段线边界?如果是这样的话,你真的不需要例行公事。

lpseifert 发表于 2022-7-6 07:11:13

这将擦除选定线内或接触选定线的对象。。。
 
(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
查看完整版本: 删除边界外的对象