Topic: trim & erase exterior entities..

[Joe Burke]

I picked up this getpolypoints function here somewhere....with that said, this would select all objects within a selected polyline.

Code: [Select]

(defun c:xxx (/ pl ss)
  (Defun GetPolyPoints (POLY / entPoly lstReturn)
    (SetQ entPoly (EntGet POLY))
    (SetQ lstReturn (List (Cdr (Assoc 10 entPoly))))
    (While
      (Assoc 10
     (SetQ entPoly (Cdr (Member (Assoc 10 entPoly) entPoly)))
      )
       (SetQ lstReturn (Cons (Cdr (Assoc 10 entPoly)) lstReturn))
    )
    (Reverse lstReturn)
  )
  (setq pl (getpolypoints (car (entsel)))
ss (ssget "_WP" pl)
  )
  (sssetfirst nil ss)
)

The following may be of interest when a pline is used to create a selection set. It traces arcs in plines. It also includes checking for duplicate adjacent points, which causes things like (ssget "wp" ptlst) to fail.

Code: [Select]

;; JB  4/1/2006
;; Arguments: obj - a heavy or lightweight pline ename or vla-object.
;;            deg - the approximate number of degrees between points
;;                  along an arc. Suggested value: 10.
;; Returns: WCS point list if successful.
;; Notes: The number of points returned when tracing an arc is proportional
;;        to the included angle.
;;        Duplicate adjacent points are removed.
;;        The last closing point is included given a closed pline.

(defun TracePline (obj deg / typ param endparam pt blg
                             ptlst delta inc arcparam)
  (and
    (or
      (= (type obj) 'VLA-OBJECT)
      (setq obj (vlax-ename->vla-object obj))
    )
    (setq typ (vlax-get obj 'ObjectName))
    (or (= typ "AcDb2dPolyline") (= typ "AcDbPolyline"))
    (setq param 0   
          endparam (vlax-curve-getEndParam obj)
    )   
    (while (<= param endparam)
      (setq pt (vlax-curve-getPointAtParam obj param))
      ;Avoid duplicate points between start and end.
      (if (not (equal pt (car ptlst) 1e-12))
        (setq ptlst (cons pt ptlst))
      )
      ;A closed pline returns an error (invalid index)
      ;when asking for the bulge of the end param.
      (if
        (and
          (/= param endparam)
          (setq blg (abs (vlax-invoke obj 'GetBulge param)))
          (/= 0 blg)
        )
        (progn
          (setq delta (* 4 (atan blg)) ;included angle
                inc (/ 1.0 (1+ (fix (/ delta (* pi (/ deg 180.0))))))
                arcparam (+ param inc)
          )
          (while (< arcparam (1+ param))
            (setq pt (vlax-curve-getPointAtParam obj arcparam)
                  ptlst (cons pt ptlst)
                  arcparam (+ inc arcparam)
            )
          )
        )
      )
      (setq param (1+ param))
    )
  ) ;and
  (if
    (and
      (apply 'and ptlst)
      (> (length ptlst) 1)
    )
    (reverse ptlst)
  )
) ;end


[CAB]

Thanks Joe.

[ronjonp]

Is this pretty much the same as Joe's routine?

http://www.theswamp.org/index.php?topic=8878.msg114385#msg114385

[CAB]

No, That routine creates a pline from a pt list while Joe's routine creates a point list from a pline.
More importantly his routine creates extra points when an arc i encountered in a pine that allow the boundary to more closely trace the actual arc.

[caddog]

;;;--------------------------------------------------------
;;;函数： c:SWP
;;;--------------------------------------------------------
;;;编制日期:2006.4.1
;;;编制者  :何俊
;;;函数说明:本函数选择用户指定多边形内的实体(注意多边形要在当前视口内)。
;;;--------------------------------------------------------
(DEFUN c:sw (/ ENAME #MYLIST SS1)
  (princ "\n 选择用户指定多边形内的实体(注意多边形要在当前视口内)。")
  (SETQ ename (CAR (ENTSEL "\n请选择一个多边形:")))
  (SETQ #mylist (getpllist ename))
  (SETQ ss1 (SSGET "_WP" #mylist))
  (SSSETFIRST NIL ss1)
  (SETQ ss1 ss1)
) ;_ 结束defun
;;;--------------------------------------------------------
;;;函数： c:CWP
;;;--------------------------------------------------------
;;;编制日期:2006.4.1
;;;编制者  :何俊
;;;函数说明:本函数选择用户指定多边形内以及与多边形相交的实体
;;;         (注意多边形要在当前视口内)。
;;;--------------------------------------------------------
(DEFUN c:cw (/ ENAME #MYLIST SS1)
  (princ "\n 选择用户指定多边形内以及与多边形相交的实体(注意多边形要在当前视口内)")
  (SETQ ename (CAR (ENTSEL "\n请选择一个多边形:")))
  (SETQ #mylist (getpllist ename))
  (SETQ ss1 (SSGET "_CP" #mylist))
  (SSSETFIRST NIL ss1)
  (SETQ ss1 ss1)
) ;_ 结束defun


;;;--------------------------------------------------------
;;;函数： c:es
;;;--------------------------------------------------------
;;;编制日期:2006.4.
;;;编制者  :何俊
;;;函数说明:本函数选择用户指定多边形外的实体(注意多边形要在当前视口内)。
;;;--------------------------------------------------------

(DEFUN c:es (/ ename #mylist ss1)
  (princ "\n 选择用户指定多边形外的实体(注意多边形要在当前视口内)。")
  (SETQ ename (CAR (ENTSEL "\n请选择一个多边形:")))
  (SETQ #mylist (getpllist ename))
  (SETQ ss1 (SSGET "_WP" #mylist))
  (COMMAND "select" "all" "r")
  (COMMAND ss1)
  (COMMAND "")
  (SETQ ss1 (SSGET "_p"))
  (SSSETFIRST NIL ss1)
  (SETQ ss1 ss1)

) ;_ 结束defun
;;;--------------------------------------------------------
;;;函数： c:Cs
;;;--------------------------------------------------------
;;;编制日期:2006.4.
;;;编制者  :何俊
;;;函数说明:本函数选择用户指定多边形外且不与多边形相交实体
;;;         (注意多边形要在当前视口内)。
;;;--------------------------------------------------------

(DEFUN c:Cs (/ ename #mylist ss1)
  (princ "\n 选择用户指定多边形外且不与多边形相交实体(注意多边形要在当前视口内)")
  (SETQ ename (CAR (ENTSEL "\n请选择一个多边形:")))
  (SETQ #mylist (getpllist ename))
  (SETQ ss1 (SSGET "_cP" #mylist))
  (COMMAND "select" "all" "r")
  (COMMAND ss1)
  (COMMAND "")
  (SETQ ss1 (SSGET "_p"))
  (SSSETFIRST NIL ss1)
  (SETQ ss1 ss1)

) ;_ 结束defun

[caddog]

DEFUN getPlList (#entity)
  (SETQ obj (ENTGET #entity))
  (SETQ lw_t8 (CDR (ASSOC 8 obj)))
  (SETQ obj_1 nil)
  (WHILE (/= (ASSOC 10 obj) nil)
    (IF   (AND (= (CAAR obj) 10)
        (NOT (EQUAL (CDAR obj) (LAST obj_1) 0.001))
   )
      (SETQ obj_1 (APPEND obj_1 (LIST (CDAR obj))))
    )               
    (SETQ obj (CDR obj))
  )
  (SETQ obj obj_1)
  (IF (EQUAL (CAR obj) (LAST obj) 0.0001)
    (SETQ obj (REVERSE (CDR (REVERSE obj))))
  )
  ;;
  (SETQ #temp obj)
)

[ronjonp]

I picked up this getpolypoints function here somewhere....with that said, this would select all objects within a selected polyline.

Code: [Select]

(defun c:xxx (/ pl ss)
  (Defun GetPolyPoints (POLY / entPoly lstReturn)
    (SetQ entPoly (EntGet POLY))
    (SetQ lstReturn (List (Cdr (Assoc 10 entPoly))))
    (While
      (Assoc 10
     (SetQ entPoly (Cdr (Member (Assoc 10 entPoly) entPoly)))
      )
       (SetQ lstReturn (Cons (Cdr (Assoc 10 entPoly)) lstReturn))
    )
    (Reverse lstReturn)
  )
  (setq pl (getpolypoints (car (entsel)))
ss (ssget "_WP" pl)
  )
  (sssetfirst nil ss)
)

The following may be of interest when a pline is used to create a selection set. It traces arcs in plines. It also includes checking for duplicate adjacent points, which causes things like (ssget "wp" ptlst) to fail.

Code: [Select]

;; JB  4/1/2006
;; Arguments: obj - a heavy or lightweight pline ename or vla-object.
;;            deg - the approximate number of degrees between points
;;                  along an arc. Suggested value: 10.
;; Returns: WCS point list if successful.
;; Notes: The number of points returned when tracing an arc is proportional
;;        to the included angle.
;;        Duplicate adjacent points are removed.
;;        The last closing point is included given a closed pline.

(defun TracePline (obj deg / typ param endparam pt blg
                             ptlst delta inc arcparam)
  (and
    (or
      (= (type obj) 'VLA-OBJECT)
      (setq obj (vlax-ename->vla-object obj))
    )
    (setq typ (vlax-get obj 'ObjectName))
    (or (= typ "AcDb2dPolyline") (= typ "AcDbPolyline"))
    (setq param 0   
          endparam (vlax-curve-getEndParam obj)
    )   
    (while (<= param endparam)
      (setq pt (vlax-curve-getPointAtParam obj param))
      ;Avoid duplicate points between start and end.
      (if (not (equal pt (car ptlst) 1e-12))
        (setq ptlst (cons pt ptlst))
      )
      ;A closed pline returns an error (invalid index)
      ;when asking for the bulge of the end param.
      (if
        (and
          (/= param endparam)
          (setq blg (abs (vlax-invoke obj 'GetBulge param)))
          (/= 0 blg)
        )
        (progn
          (setq delta (* 4 (atan blg)) ;included angle
                inc (/ 1.0 (1+ (fix (/ delta (* pi (/ deg 180.0))))))
                arcparam (+ param inc)
          )
          (while (< arcparam (1+ param))
            (setq pt (vlax-curve-getPointAtParam obj arcparam)
                  ptlst (cons pt ptlst)
                  arcparam (+ inc arcparam)
            )
          )
        )
      )
      (setq param (1+ param))
    )
  ) ;and
  (if
    (and
      (apply 'and ptlst)
      (> (length ptlst) 1)
    )
    (reverse ptlst)
  )
) ;end


Thanks for this Joe ... saved me a bunch of time today. 

[SOFITO_SOFT]

Hello everyone
I'd do this with the "BREAKALL.lsp" published here.
For then most difficult : It has a subfunction that break all elements of  pickset1 (all) with the element of pickset2 ( only the green poly ).
After a "ERASE" using a "FENCE" over a parallel outside ( very near) the green polyline ... and you have solved the problem of entities crossing the green poly
For other entities, there are several other algorithms outside / inside  in published programs ..
Greetings.....