Jump to content

Select all the blocks that are touching polylines


wal_dab

Recommended Posts

Try this:

 

(defun c:test (/ add ss i e l d g lst s n)
 ;;------------------------------------;;
 ;;	Tharwat 15.09.2015		;;
 ;; Select blocks that are touching	;;
 ;; the selected LWpolylines		;;
 ;;------------------------------------;;
 (princ "\nSelect LWPolyines :")
 (if (setq add (ssadd)
           ss  (ssget '((0 . "LWPOLYLINE")))
     )
   (repeat (setq i (sslength ss))
     (setq e   (ssname ss (setq i (1- i)))
           l   (vlax-curve-getdistatpoint e (vlax-curve-getendpoint e))
           d   (/ l 300.)
           g   d
           lst nil
     )
     (repeat 300
       (setq lst (cons (vlax-curve-getpointatdist e g) lst)
             g   (+ g d)
       )
     )
     (setq lst (append lst (list (vlax-curve-getstartpoint e))))
     (if (setq s (ssget "_F" lst '((0 . "INSERT"))))
       (repeat (setq n (sslength s))
         (ssadd (ssname s (setq n (1- n))) add)
       )
     )
   )
 )
 (sssetfirst nil add)
 (princ)
)

Link to comment
Share on other sites

Try this:

 

(defun c:test (/ add ss i e l d g lst s n)
 ;;------------------------------------;;
 ;;	Tharwat 15.09.2015		;;
 ;; Select blocks that are touching	;;
 ;; the selected LWpolylines		;;
 ;;------------------------------------;;
 (princ "\nSelect LWPolyines :")
 (if (setq add (ssadd)
           ss  (ssget '((0 . "LWPOLYLINE")))
     )
   (repeat (setq i (sslength ss))
     (setq e   (ssname ss (setq i (1- i)))
           l   (vlax-curve-getdistatpoint e (vlax-curve-getendpoint e))
           d   (/ l 300.)
           g   d
           lst nil
     )
     (repeat 300
       (setq lst (cons (vlax-curve-getpointatdist e g) lst)
             g   (+ g d)
       )
     )
     (setq lst (append lst (list (vlax-curve-getstartpoint e))))
     (if (setq s (ssget "_F" lst '((0 . "INSERT"))))
       (repeat (setq n (sslength s))
         (ssadd (ssname s (setq n (1- n))) add)
       )
     )
   )
 )
 (sssetfirst nil add)
 (princ)
)

 

Nice ONE, Tharwat.:thumbsup:

Link to comment
Share on other sites

but it dos not work for all touching block

 

It does select and work as intended, change the width of the polyline to zero and zoom in to the blocks that they have not been selected to see that these blocks are NOT touching any polyline .

Link to comment
Share on other sites

Another one:

(vl-load-com)

(defun c:test2 (/ _kpblc-conv-selset-to-ename pl selset res prec)

 (defun _kpblc-conv-selset-to-ename (selset / tab item)
   (cond
     ((not selset) nil)
     ((= (type selset) 'pickset)
      (repeat (setq tab  nil
                    item (sslength selset)
                    ) ;_ end setq
        (setq tab (cons (ssname selset (setq item (1- item))) tab))
        ) ;_ end repeat
      )
     ) ;_ end of cond
   ) ;_ end of defun

 (if (and (= (type (setq pl (vl-catch-all-apply
                              (function
                                (lambda ()
                                  (car (entsel "\nSelect LWPolyline <Cancel> : "))
                                  ) ;_ end of lambda
                                ) ;_ end of function
                              ) ;_ end of vl-catch-all-apply
                         ) ;_ end of setq
                   ) ;_ end of type
             'ename
             ) ;_ end of =
          (setq selset (_kpblc-conv-selset-to-ename (ssget "_X" (list '(0 . "INSERT") (assoc 410 (entget pl))))))
          ) ;_ end of and
   (progn
     (setq prec   1e-1
           pl     (vlax-ename->vla-object pl)
           selset (vl-remove-if-not
                    (function
                      (lambda (x / pt pt_closest)
                        (setq pt         (cdr (assoc 10 (entget x)))
                              pt_closest (vlax-curve-getclosestpointto pl pt)
                              ) ;_ end of setq
                        (< (distance pt pt_closest) prec)
                        ) ;_ end of lambda
                      ) ;_ end of function
                    selset
                    ) ;_ end of vl-remove-if-not
           res    (ssadd)
           ) ;_ end of setq
     (foreach item selset (ssadd item res))
     (if (> (sslength res) 0)
       (sssetfirst res res)
       ) ;_ end of if
     ) ;_ end of progn
   ) ;_ end of if
 ) ;_ end of defun

Link to comment
Share on other sites

Why not another this does use another routine that returns the pline co ords instead of creating a pline just use the ssget "F"

 

; do offset 1st then 
(if (not getcoords)(load "pline co-ords")) ; returns the pline co-ords
; do offset here
(setq obj (entlast)) ; return last offset line
(co-ords2xy)
(princ co-ordsxy)
; this should return co-ordsxy
(entdel obj) ; del offset pline
(setq x -1) ; so x starts at nth 0 at start and closing
(command "PLINE" (while (= (getvar "cmdactive") 1)
                   (COMMAND (repeat (length co-ordsxy) 
                            (nth (setq x (+ x 1)) co-ordsxy)
                            )
                    )
                 )   
)
(command "C")

Link to comment
Share on other sites

 

Why not another this does use another routine that returns the pline co ords instead of creating a pline just use the ssget "F"

 

Hi BIGAL,

 

The function ssget with the string mode "_F" does work on straight segments BUT not with polylines that have curves.

Link to comment
Share on other sites

  • 3 months later...
Try this:

 

(defun c:test (/ add ss i e l d g lst s n)
 ;;------------------------------------;;
 ;;	Tharwat 15.09.2015		;;
 ;; Select blocks that are touching	;;
 ;; the selected LWpolylines		;;
 ;;------------------------------------;;
 (princ "\nSelect LWPolyines :")
 (if (setq add (ssadd)
           ss  (ssget '((0 . "LWPOLYLINE")))
     )
   (repeat (setq i (sslength ss))
     (setq e   (ssname ss (setq i (1- i)))
           l   (vlax-curve-getdistatpoint e (vlax-curve-getendpoint e))
           d   (/ l 300.)
           g   d
           lst nil
     )
     (repeat 300
       (setq lst (cons (vlax-curve-getpointatdist e g) lst)
             g   (+ g d)
       )
     )
     (setq lst (append lst (list (vlax-curve-getstartpoint e))))
     (if (setq s (ssget "_F" lst '((0 . "INSERT"))))
       (repeat (setq n (sslength s))
         (ssadd (ssname s (setq n (1- n))) add)
       )
     )
   )
 )
 (sssetfirst nil add)
 (princ)
)

 

Sir,

 

Pls update the code to work with attached drawing

Conditions of selection

To select nos of blocks through which poly line of specific layer passes, provided when asked for selecting poly line multi section or select similar options to be included

new block.dwg

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