Jump to content

select inside of a polyline


flopo

Recommended Posts

My 5 cents

(defun C:ICS (/ en ss lst ssall tmp head)
 ;;InSide Contour Select
 ;;!!!! [b][color="Red"]REQUIRED EXPRESS TOOLS[/color][/b]
 (vl-load-com)
 (if (and (setq en (car (entsel "\nSelect contour: ")))
          (wcmatch (cdr (assoc 0 (entget en))) "*POLYLINE")
     ) ;_ end of and
   (progn
     (setq lst (ACET-GEOM-OBJECT-POINT-LIST en 1e-3))
     (setq lst (mapcar '(lambda (x) (list (car x) (cadr x))) lst))
     (while lst
       (setq head (car lst)
             tmp  (cons head tmp)
             lst  (vl-remove-if
                    '(lambda (pt) (equal pt head 1e-6))
                    (cdr lst)
                  ) ;_ end of vl-remove-if
       ) ;_ end of setq
     ) ;_ end of while
     (setq lst (reverse tmp)) ;_ end of setq
     (ACET-SS-ZOOM-EXTENTS (ACET-LIST-TO-SS (list en)))
     (command "_.Zoom" "0.95x")      
     (if (setq ss (ssget "_CP" lst))
       (sssetfirst ss ss)
     ) ;_ end of if
   ) ;_ end of progn
 ) ;_ end of if
) ;_ end of defun 
(princ "\nType ICS") 

Link to comment
Share on other sites

Nice lisp, VVA! Can you add option to select or not those objects intersecting the polyline? Those one that are/are not completely inside the poly...?

Link to comment
Share on other sites

Other variant (add Outside contour select )

[b][color="Red"];;;!!!! REQUIRED EXPRESS TOOLS[/color][/b]
(defun C:ICS (/ en ss lst  tmp head what)
 ;;InSide Contour Select
 ;;!!!! REQUIRED EXPRESS TOOLS
 (vl-load-com)
 (if (and (setq en (car (entsel "\nSelect contour: ")))
         [color="Blue"] (wcmatch (cdr (assoc 0 (entget en))) "*POLYLINE")[/color]
          (or (initget "CP WP") t)
          (or
          (setq what (getkword "\nChoose option [CrossingPolygon/WindowPolygon] <WP>:"))
          (setq what "WP")
          )
     ) ;_ end of and
   (progn
     (setq lst (ACET-GEOM-OBJECT-POINT-LIST en 1e-3))
     (setq lst (mapcar '(lambda (x) (list (car x) (cadr x))) lst))
     (while lst
       (setq head (car lst)
             tmp  (cons head tmp)
             lst  (vl-remove-if
                    '(lambda (pt) (equal pt head 1e-6))
                    (cdr lst)
                  ) ;_ end of vl-remove-if
       ) ;_ end of setq
     ) ;_ end of while
     (setq lst (reverse tmp)) ;_ end of setq
     (ACET-SS-ZOOM-EXTENTS (ACET-LIST-TO-SS (list en)))
     (command "_.Zoom" "0.95x")      
     (if (setq ss (ssget (strcat "_" what) lst))
       (sssetfirst ss ss)
     ) ;_ end of if
   ) ;_ end of progn
 ) ;_ end of if
) ;_ end of defun 
(defun C:OCS (  / en ss lst ssall bbox tmp head)
;;;OutSide Contour Select
;;;!!!! REQUIRED EXPRESS TOOLS
(vl-load-com) 
 (if (and (setq en (car(entsel "\nSelect contour: "))) 
          [color="Blue"](wcmatch (cdr(assoc 0 (entget en))) "*POLYLINE")[/color] 
     )
   (progn 
     (setq lst (ACET-GEOM-OBJECT-POINT-LIST en 1e-3)) 
     (setq lst (mapcar '(lambda(x)(list (car x)(cadr x))) lst))
     (while lst
       (setq head (car lst)
         tmp (cons head tmp)
         lst (vl-remove-if '(lambda(pt)(equal pt head 1e-6))(cdr lst))
         )
       )
 (setq lst (reverse tmp))
     (if (and 
           (setq ss (ssget "_CP" lst)) 
           (setq ssall (ssget "_X" (list (assoc 410 (entget en))))) 
           (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssall)))) 
           (setq lst (vl-remove-if '(lambda(x)(minusp 
           (cdr(assoc 62 (tblsearch "layer" 
           (cdr(assoc 8 (entget x)))))))) lst)) 
           (setq ssall nil ssall (ACET-LIST-TO-SS lst)) 
          ) 
       (progn 
         (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) 
         (foreach e1 lst (ssdel e1 ssall)) 
         (SSSETFIRST ssall ssall) 
         ) 
       ) 
     ) 
   ) 
 ) 
(princ "\nType ICS or OCS")

PS

If you delete or commented out Blue line, then the contour can be also a circle, ellipse, spline

Link to comment
Share on other sites

  • 5 years later...
Other variant (add Outside contour select )

[b][color="Red"];;;!!!! REQUIRED EXPRESS TOOLS[/color][/b]
(defun C:ICS (/ en ss lst  tmp head what)
 ;;InSide Contour Select
 ;;!!!! REQUIRED EXPRESS TOOLS
 (vl-load-com)
 (if (and (setq en (car (entsel "\nSelect contour: ")))
         [color="Blue"] (wcmatch (cdr (assoc 0 (entget en))) "*POLYLINE")[/color]
          (or (initget "CP WP") t)
          (or
          (setq what (getkword "\nChoose option [CrossingPolygon/WindowPolygon] <WP>:"))
          (setq what "WP")
          )
     ) ;_ end of and
   (progn
     (setq lst (ACET-GEOM-OBJECT-POINT-LIST en 1e-3))
     (setq lst (mapcar '(lambda (x) (list (car x) (cadr x))) lst))
     (while lst
       (setq head (car lst)
             tmp  (cons head tmp)
             lst  (vl-remove-if
                    '(lambda (pt) (equal pt head 1e-6))
                    (cdr lst)
                  ) ;_ end of vl-remove-if
       ) ;_ end of setq
     ) ;_ end of while
     (setq lst (reverse tmp)) ;_ end of setq
     (ACET-SS-ZOOM-EXTENTS (ACET-LIST-TO-SS (list en)))
     (command "_.Zoom" "0.95x")      
     (if (setq ss (ssget (strcat "_" what) lst))
       (sssetfirst ss ss)
     ) ;_ end of if
   ) ;_ end of progn
 ) ;_ end of if
) ;_ end of defun 
(defun C:OCS (  / en ss lst ssall bbox tmp head)
;;;OutSide Contour Select
;;;!!!! REQUIRED EXPRESS TOOLS
(vl-load-com) 
 (if (and (setq en (car(entsel "\nSelect contour: "))) 
          [color="Blue"](wcmatch (cdr(assoc 0 (entget en))) "*POLYLINE")[/color] 
     )
   (progn 
     (setq lst (ACET-GEOM-OBJECT-POINT-LIST en 1e-3)) 
     (setq lst (mapcar '(lambda(x)(list (car x)(cadr x))) lst))
     (while lst
       (setq head (car lst)
         tmp (cons head tmp)
         lst (vl-remove-if '(lambda(pt)(equal pt head 1e-6))(cdr lst))
         )
       )
 (setq lst (reverse tmp))
     (if (and 
           (setq ss (ssget "_CP" lst)) 
           (setq ssall (ssget "_X" (list (assoc 410 (entget en))))) 
           (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssall)))) 
           (setq lst (vl-remove-if '(lambda(x)(minusp 
           (cdr(assoc 62 (tblsearch "layer" 
           (cdr(assoc 8 (entget x)))))))) lst)) 
           (setq ssall nil ssall (ACET-LIST-TO-SS lst)) 
          ) 
       (progn 
         (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) 
         (foreach e1 lst (ssdel e1 ssall)) 
         (SSSETFIRST ssall ssall) 
         ) 
       ) 
     ) 
   ) 
 ) 
(princ "\nType ICS or OCS")

PS

If you delete or commented out Blue line, then the contour can be also a circle, ellipse, spline

 

 

 

Sorry to resurrect this thread. I have been using this ICS command quite a bit over the last several months. Now all of a sudden it stopped working. Every time I select a polyline, it hangs for a few seconds and then gives the following:

 

 

Hard error occurred ***

internal stack limit reached (simulated)

 

 

I am using AutoCAD 2007 and have even tried re-installing it to try to correct the issue with no luck. I also tried another computer and it has the same problem.

 

Any help will be greatly appreciated. This has become one of my favorite commands and now I feel like I lost a finger.

 

EDIT: So I ran it through VLINE and found which line it was breaking at. It stopped at (list en) in the line below. After commenting it out, it worked.

 

;; (ACET-SS-ZOOM-EXTENTS (ACET-LIST-TO-SS (list en)))

 

 

Thanks,

KoKos

Edited by KoKos
Link to comment
Share on other sites

  • 2 years later...
Originally Posted by VVA View Post

Other variant (add Outside contour select )

...

 

This routine is very useful. Would It be possible to add an option to select multiple objects instead of only one, as in Tharwat's routine? The linked routine is missing the OCS option, and interactive CP/WP option, which I appreciate.

Link to comment
Share on other sites

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.

×
×
  • Create New...