Jump to content

Selecting everything within the selected closed area.

macros55

By macros55
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

macros55 Contributor

macros55

Posted
Posted

Hello Guys,
I have such a lisp, Selecting everything within the selected closed area. But it is not possible to choose more than one closed area. What I want is to select more than one closed area, and then when I run the command, it will select everything in the selected closed areas.

SS1: Only those fully included in the boundary content are selected.
SS2: Those who are fully included in the border content and touch the border line (those half inside and half outside) are selected.
Thank you everyone.

SS1-SS2 Selecting everything within the selected closed area..lsp

Emmanuel Delay Proficient

Emmanuel Delay

Posted
Posted

Can you upload a .dwf file ?

It seems to me like this can be solved with quite little amount of code.

 

It needs to count intersections of the objects with the closed polylines.

SS1  ->

    - there must be no intersections.  

    and

    - check if at least 1 point of the object is inside one of the closed polylines.

 

SS2  ->

     - check if at least 1 point of the object is inside one of the closed polylines.

    or

    - any intersection

Steven P Grand Master

Steven P

Posted
Posted

Just me being picky but I would tidy the code up first, so that the indents match  and not what closing brackets close what command - it makes things easier to follow.

 

From your code there are a lot of sub functions but I think this is the part to look at:

  

  (setq en (car(entsel "\Select boundry line: "))) 
  (if (and en (wcmatch (cdr(assoc 0 (entget en))) "*POLYLINE,SPLINE,CIRCLE,ARC,ELLIPSE")) 
    (progn 
      (setq lst (TraceObject (vlax-ename->vla-object en))) 
      (lib:Zoom2Lst lst);_xetti deqiqlesdirin 
      (setq lst (mapcar '(lambda(x)(trans x 0 1)) lst)) 
      (setq lst (mapcar '(lambda(x)(list (car x)(cadr x))) lst)) 
      (if (setq ss (ssget opt lst))
        (SSSETFIRST ss ss)
      ) 
      (setq ss nil)
    )
  )
  (princ)
)

 

 

Instead of (setq en (car (entsel "\nSelect Boundry Line: ") try using a ssget:

  

(setq MySs (ssget '((0. *POLYLINE,SPLINE,CIRCLE,ARC,ELLIPSE"))) )

 

and loop through that, I like to use a counter and go that way, something like this:

  

  (setq acount 0)
  (while (< acount (sslength MySS))
    (setq en (ssname MySS acount))              


.... do stuff to en ....                  
                  
                  
    (setq acount (+ acount 1))
  ) ; end while

 

I'd make your selection set, SS, and then use ssadd function to join that to an overall selection set. Note that I think you need to loop through each entity in your selection set, SS, to add them to another, the LISP won't add duplicated entities.

 

 

Have a go, use a selection set to select the boundary lines and then with a loop for each boundary line add the entities enclosed with ssadd to your main selection set

 

 

Steven P Grand Master

Steven P

Posted
Posted

I'll have a think and a look tomorrow

BIGAL Grand Master

BIGAL

Posted
Posted

Just some comments, no code.

 

Pline as rectang is ok

Curvey pline is a problem as ssget "WP" does not support objects rather it uses object points. 

Revlcoud will ignore the curves so may miss an object that is inside a arc. But may be ok.

A circle is not supported in Ssget "WP" but easy to make into multi chords of reasonable size. 

 

Given how old ssget is you would think the option OB would be added by now. 

  • Like 1
Steven P Grand Master

Steven P

Posted
Posted (edited)

 

Try this which should use the selection as before (noting BigAls comments) but to allow multiple outlines. Only limited testing so might not be 100% there.

 

One thing that came up in a question the other day was zoom - I'd look at that - to return the screen to the same view as the user started - link below

 

EDIT: 2nd thing I noticed is that SS2 (crossing polygon selection) will also select the original outline, window polygon won't - do want these to be consistent both with or without the outlines selected

  

(defun SelectContour ( opt / en ss lst MySS MySScount SScount SelSet)

;;;; Sub Functions ;;;;
  (defun DTR (a)(* pi (/ a 180.0))) 
  (defun  lib:pt_extents (vlist / tmp) 
    (setq tmp (mapcar '(lambda (x) (vl-remove-if 'null x)) (mapcar '(lambda (what) (mapcar '(lambda (x) (nth what x)) vlist)) '(0 1 2))));_setq 
    (list (mapcar '(lambda(x)(apply 'min x)) tmp)(mapcar '(lambda(x)(apply 'max x)) tmp))
  )
  (defun lib:IsPtInView (pt / VCTR Y_Len SSZ X_Pix Y_Pix X_Len Lc Uc) 
    (setq pt (trans pt 0 1)
          VCTR (getvar "VIEWCTR") Y_Len (getvar "VIEWSIZE") 
          SSZ (getvar "SCREENSIZE") 
          X_Pix (car SSZ) Y_Pix (cadr SSZ) 
          X_Len (* (/ X_Pix Y_Pix) Y_Len) 
          Lc (polar VCTR (dtr 180.0) (* 0.5 X_Len)) 
          Uc (polar Lc 0.0 X_Len) 
          Lc (polar Lc (dtr 270.0) (* 0.5 Y_Len)) 
          Uc (polar Uc (dtr 90.0) (* 0.5 Y_Len))
    )
    (if (and
          (> (car pt) (car Lc))
          (< (car pt) (car Uc)) 
          (> (cadr pt) (cadr Lc))
          (< (cadr pt) (cadr Uc))
        ) 
      T
      nil
    )
  ) 
  (defun lib:Zoom2Lst( vlist / bl tr Lst OS) 
    (setq   Lst (lib:pt_extents vlist) bl (car Lst) tr (cadr Lst)) 
    (if (not (and (lib:IsPtInView bl) (lib:IsPtInView tr))) 
      (progn
        (setq OS (getvar "OSMODE"))
        (setvar "OSMODE" 0) 
        (command "_.Zoom" "_Window" (trans bl 0 1)(trans tr 0 1) "_.Zoom" "0.95x") 
        (setvar "OSMODE" OS)
        T
      )
      NIL
    )
  ) 
  (defun TraceObject (obj / typlst typ TracePline TraceACE TraceLine TraceSpline TraceType1Pline TraceType23Pline) 
    (defun ZClosed (lst) 
      (if (and
            (vlax-curve-isClosed obj) 
            (not(equal (car lst)(last lst) 1e-6))
          ) 
        (append lst (list (car lst)))
        lst
      )
    ) 
    (defun TracePline (obj / param endparam anginc tparam pt blg ptlst delta inc arcparam flag) 
      (setq param (vlax-curve-getStartParam obj) 
            endparam (vlax-curve-getEndParam obj) 
            anginc (* pi (/ 7.5 180.0))
      ) 
      (setq tparam param) 
      (while (<= param endparam) 
        (setq pt (vlax-curve-getPointAtParam obj param)) 
        (if (not (equal pt (car ptlst) 1e-12)) 
          (setq ptlst (cons pt ptlst))
        ) 
        (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 anginc)))) 
                  arcparam (+ param inc)) 
            (while (< arcparam (1+ param)) 
              (setq pt (vlax-curve-getPointAtParam obj arcparam) 
                    ptlst (cons pt ptlst) 
                    arcparam (+ inc arcparam)
              )
            )
          ) 
        ) ; end if
        (setq param (1+ param))
      ) ; end while
      (if (and
            (apply 'and ptlst) 
            (> (length ptlst) 1)
          ) 
        (ZClosed (reverse ptlst))
      )
    ) ;end 
    (defun TraceACE (obj / startparam endparam anginc delta div inc pt ptlst) 
      (setq startparam (vlax-curve-getStartParam obj) 
            endparam (vlax-curve-getEndParam obj) 
            anginc (* pi (/ 5.0 180.0))) 
      (if (equal endparam (* pi 2) 1e-12) 
        (setq delta endparam) 
        (setq delta (NormalAngle (- endparam startparam)))
      ) 
      (setq div (1+ (fix (/ delta anginc))) 
            inc (/ delta div)
      ) 
      (while (or 
          (< startparam endparam) 
          (equal startparam endparam 1e-12)
        )  ; endor
        (setq pt (vlax-curve-getPointAtParam obj startparam) 
              ptlst (cons pt ptlst) 
              startparam (+ inc startparam)
        )
      ) 
      (reverse ptlst)
    ) ;end 
    (defun TraceLine (obj)
      (list (vlax-get obj 'StartPoint) (vlax-get obj 'EndPoint))
    ) 
    (defun TraceSpline (obj / startparam endparam ncpts inc param fd ptlst pt1 pt2 ang1 ang2 a) 
      (setq startparam (vlax-curve-getStartParam obj) 
            endparam (vlax-curve-getEndParam obj) 
            ncpts (vlax-get obj 'NumberOfControlPoints) 
            inc (/ (- endparam startparam) (* ncpts 7)) 
            param (+ inc startparam) 
            fd (vlax-curve-getfirstderiv obj param) 
            ptlst (cons (vlax-curve-getStartPoint obj) ptlst)
      ) 
      (while (< param endparam) 
        (setq pt1 (vlax-curve-getPointAtParam obj param) 
              ang1 fd 
              param (+ param inc) 
              pt2 (vlax-curve-getPointAtParam obj param) 
              fd (vlax-curve-getfirstderiv obj param) 
              ang2 fd 
              a (abs (3d_angw1w2 ang1 ang2))
        )
        (if (> a 0.00218166)(setq ptlst (cons pt1 ptlst)))) 
      (if (not (equal (setq pt1 (vlax-curve-getEndPoint obj)) (car ptlst) 1e-8)) 
        (setq ptlst (cons pt1 ptlst))
      ) 
      (reverse ptlst)
    ) ;end 
    (defun TraceType1Pline (obj / ptlst objlst lst) 
      (setq ptlst (list (vlax-curve-getStartPoint obj)) 
            objlst (vlax-invoke obj 'Explode)) 
      (foreach x objlst 
        (setq lst (TraceACE x)) 
        (if (not (equal (car lst) (last ptlst) 1e-8)) 
          (setq lst (reverse lst))
        ) 
        (setq ptlst (append ptlst (cdr lst))) 
        (vla-delete x)
      )
      (ZClosed ptlst)
    ) ;end 
    (defun TraceType23Pline (obj / objlst ptlst lastpt) 
      (setq objlst (vlax-invoke obj 'Explode) 
            lastpt (vlax-get (last objlst) 'EndPoint)
      ) 
      (foreach x objlst 
        (setq ptlst (cons (vlax-get x 'StartPoint) ptlst)) 
        (vla-delete x)
      )
      (ZClosed (reverse (cons lastpt ptlst)))
    ) ;end 
    (defun Trace3DPline (obj / coord ptlst) 
      (setq coord (vlax-get obj 'Coordinates)) 
      (repeat (/ (length coord) 3) 
        (setq ptlst (cons (list (car coord) (cadr coord)(caddr coord)) ptlst)) 
        (setq coord (cdddr coord))
      )
      (ZClosed (reverse ptlst))
    ) ;end 
    (defun NormalAngle (a)
      (if (numberp a)(angtof (angtos a 0 14) 0))
    ) 
    (defun 3d_angw1w2 (Wekt1 Wekt2 / CosA) 
      (if (equal (setq CosA (/ (apply '+ (mapcar '* Wekt1 Wekt2)) (distance '(0 0 0) Wekt1) (distance '(0 0 0) Wekt2))) -1.0 1e-6) 
        Pi 
      (if (equal CosA 0.0 1e-6) (* 0.5 PI)(atan (sqrt (- 1 (* CosA CosA))) CosA)))) 
      (setq typlst '("AcDb2dPolyline" "AcDbPolyline" "AcDb3dPolyline" "AcDbCircle" "AcDbArc" "AcDbEllipse" "AcDbSpline" "AcDbLine")) 
      (or (eq (type obj) 'VLA-OBJECT) 
        (setq obj (vlax-ename->vla-object obj))
      ) 
      (setq typ (vlax-get obj 'ObjectName)) 
      (if (vl-position typ typlst) 
        (cond ((or (eq typ "AcDb2dPolyline") (eq typ "AcDbPolyline")) 
          (cond ((or 
               (not (vlax-property-available-p obj 'Type)) 
               (= 0 (vlax-get obj 'Type))) 
              (TracePline obj)) 
            ((or (= 3 (vlax-get obj 'Type)) (= 2 (vlax-get obj 'Type))) 
              (TraceType23Pline obj)) 
            ((= 1 (vlax-get obj 'Type)) 
              (TraceType1Pline obj)))) 
       ((eq typ "AcDbLine")(TraceLine obj)) 
       ((or (eq typ "AcDbCircle") (eq typ "AcDbArc") (eq typ "AcDbEllipse")) 
         (TraceACE obj)) 
       ((eq typ "AcDbSpline")(TraceSpline obj)) 
       ((eq typ "AcDb3dPolyline")(Trace3DPline obj)) 
    ))) 

;;;; End Sub Functions ;;;;
    (vl-load-com) 

    (princ "\nArea Outlines: ")
    (setq MySS (ssget) )  ; Select outlines selection set
    (setq MySScount 0)    ; A counter for looping
    (setq SelSet (ssadd)) ; An empty selection set
    (while (< MySScount (sslength MySS)) ; Loop through outlines selection set
      (setq en (ssname MySS MySScount))  ; Outline entity name
      (if (and                           ; being lazy, copy and paste.. if
            en                           ; ...there is an outline entity
            (wcmatch (cdr(assoc 0 (entget en))) "*POLYLINE,SPLINE,CIRCLE,ARC,ELLIPSE") ;... outline entity is one of these
        ) ; end and
        (progn 
          (setq lst (TraceObject (vlax-ename->vla-object en))) 
          (lib:Zoom2Lst lst) ;_xetti deqiqlesdirin 
          (setq lst (mapcar '(lambda(x) (trans x 0 1)) lst)) 
          (setq lst (mapcar '(lambda(x) (list (car x)(cadr x)))
          lst ; is this line needed?
        ) ; end progn
      )   ; end if

      (if (setq ss (ssget opt lst))  ; Selection set of entities in the selected outline
        (progn
          (setq SScount 0) ; a counter
          (while (< SScount (sslength ss)) ; loop through selected internal entities
            (setq SelSet (ssadd (ssname ss SScount) SelSet)) ; add entity to overall selection set
            (setq SScount (+ SScount 1)) ; increase counter
          ) ; end while
        ) ; end progn
      )  ; end if
      (setq MySScount (+ MySScount 1))
    ) ; end while

    (setq ss nil))
  )
  (if SelSet (SSSETFIRST SelSet SelSet) ) ; select selection set

  (princ) ; exit quietly
)
(defun C:SS1 ()(SelectContour "_WP")) ;_Select Contour Window Polygon 
(defun C:SS2 ()(SelectContour "_CP")) ;_Select Contour Crossing Polygon 
(princ "\n Command: SS1 and SS2 enter (princ)

 

 

 

 

Edited by Steven P

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...