Jump to content

Question: how to select objects located in a polyline vertices

Radu Iordache

By Radu Iordache
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Radu Iordache Contributor

Radu Iordache

Posted
Posted

Does anybody know if there is a way of selecting the objects that are located in the vertices of a chosen polyline? Let's say that I have a polyline with some blocks inserted in it's vertices. I would like to be able to create a selection set with these blocks in order to further extract their attributes. I've read something about FS from Express tools but seems to be unavailable in ProgeCAD (Intellicad). Thanks!

Tsuky Community Regular

Tsuky

Posted
Posted

Test this if can be process with ProgeCAD? 

(defun c:sel_blk&vertex ( / name_blk ss_blk ss_poly ent lst_pt ss n ent_blk pt_ins)
  (while (not (tblsearch "BLOCK" (setq name_blk (getstring "\nName of block: " T))))
    (princ "\n ** incorrect name block! **")
  )
  (setq ss_blk (ssget "_X" (list '(0 . "INSERT") (cons 2 name_blk))))
  (cond
    (ss_blk
      (princ "\nSelect polyline")
      (while (not (setq ss_poly (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))))
      (setq
        ent (ssname ss_poly 0)
        lst_pt (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget ent)))
        ss (ssadd)
      )
      (repeat (setq n (sslength ss_blk))
        (setq pt_ins (cdr (assoc 10 (entget (setq ent_blk (ssname ss_blk (setq n (1- n))))))))
        (mapcar
          '(lambda (x)
            (if (equal (list (car pt_ins) (cadr pt_ins)) x 1E-08) (ssadd ent_blk ss))
          )
          lst_pt
        )
      )
      (sssetfirst nil ss)
    )
  )
  (prin1)
)

 

Radu Iordache Contributor

Radu Iordache

Posted
  • Author
Posted
15 hours ago, Tsuky said:

Test this if can be process with ProgeCAD? 

(defun c:sel_blk&vertex ( / name_blk ss_blk ss_poly ent lst_pt ss n ent_blk pt_ins)
  (while (not (tblsearch "BLOCK" (setq name_blk (getstring "\nName of block: " T))))
    (princ "\n ** incorrect name block! **")
  )
  (setq ss_blk (ssget "_X" (list '(0 . "INSERT") (cons 2 name_blk))))
  (cond
    (ss_blk
      (princ "\nSelect polyline")
      (while (not (setq ss_poly (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))))
      (setq
        ent (ssname ss_poly 0)
        lst_pt (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget ent)))
        ss (ssadd)
      )
      (repeat (setq n (sslength ss_blk))
        (setq pt_ins (cdr (assoc 10 (entget (setq ent_blk (ssname ss_blk (setq n (1- n))))))))
        (mapcar
          '(lambda (x)
            (if (equal (list (car pt_ins) (cadr pt_ins)) x 1E-08) (ssadd ent_blk ss))
          )
          lst_pt
        )
      )
      (sssetfirst nil ss)
    )
  )
  (prin1)
)

 

Unfortunately, I can't get it to work in ProgeCAD. Though I see that in Autocad it's working, great lisp!

Tsuky Community Regular

Tsuky

Posted
Posted

Maybe the function (vl-remove) is causing problems for ProgeCAD...
Then try this version! 

(defun c:sel_blk&vertex ( / name_blk ss_blk ss_poly ent ss dxf_ent nbs cnt lst_pt n ent_blk pt_ins)
  (while (not (tblsearch "BLOCK" (setq name_blk (getstring "\nName of block: " T))))
    (princ "\n ** incorrect name block! **")
  )
  (setq ss_blk (ssget "_X" (list '(0 . "INSERT") (cons 2 name_blk))))
  (cond
    (ss_blk
      (princ "\nSelect polyline")
      (while (not (setq ss_poly (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))))
      (setq
        ent (ssname ss_poly 0)
        ss (ssadd)
        dxf_ent (entget ent)
        nbs (cdr (assoc 90 dxf_ent))
        cnt 0
      )
      (while (< cnt nbs)
        (if (= (caar dxf_ent) 10)
          (setq
            lst_pt (cons (cdar dxf_ent) lst_pt)
            cnt (1+ cnt)
          )
        )
        (setq dxf_ent (cdr dxf_ent))
      )
      (repeat (setq n (sslength ss_blk))
        (setq pt_ins (cdr (assoc 10 (entget (setq ent_blk (ssname ss_blk (setq n (1- n))))))))
        (mapcar
          '(lambda (x)
            (if (equal (list (car pt_ins) (cadr pt_ins)) x 1E-08) (ssadd ent_blk ss))
          )
          lst_pt
        )
      )
      (sssetfirst nil ss)
    )
  )
  (prin1)
)

 

Radu Iordache Contributor

Radu Iordache

Posted
  • Author
Posted
1 hour ago, Tsuky said:

Maybe the function (vl-remove) is causing problems for ProgeCAD...
Then try this version! 

(defun c:sel_blk&vertex ( / name_blk ss_blk ss_poly ent ss dxf_ent nbs cnt lst_pt n ent_blk pt_ins)
  (while (not (tblsearch "BLOCK" (setq name_blk (getstring "\nName of block: " T))))
    (princ "\n ** incorrect name block! **")
  )
  (setq ss_blk (ssget "_X" (list '(0 . "INSERT") (cons 2 name_blk))))
  (cond
    (ss_blk
      (princ "\nSelect polyline")
      (while (not (setq ss_poly (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))))
      (setq
        ent (ssname ss_poly 0)
        ss (ssadd)
        dxf_ent (entget ent)
        nbs (cdr (assoc 90 dxf_ent))
        cnt 0
      )
      (while (< cnt nbs)
        (if (= (caar dxf_ent) 10)
          (setq
            lst_pt (cons (cdar dxf_ent) lst_pt)
            cnt (1+ cnt)
          )
        )
        (setq dxf_ent (cdr dxf_ent))
      )
      (repeat (setq n (sslength ss_blk))
        (setq pt_ins (cdr (assoc 10 (entget (setq ent_blk (ssname ss_blk (setq n (1- n))))))))
        (mapcar
          '(lambda (x)
            (if (equal (list (car pt_ins) (cadr pt_ins)) x 1E-08) (ssadd ent_blk ss))
          )
          lst_pt
        )
      )
      (sssetfirst nil ss)
    )
  )
  (prin1)
)

 

It doesn't. First it says there is something wrong with the selection mode for ssget. I solve this by replacing "_+.:E:S" with ":S". It asks for the block name, then the polyline. After I click the polyline, it does nothing and exits the command without returning any error. It's strange, usualy when some function is not working it says something like bad argument type or function X not defined, though many lisps work without problems. Anyway, thank you so much for your time.

Tsuky Community Regular

Tsuky

Posted
Posted
6 hours ago, Radu Iordache said:

It doesn't. First it says there is something wrong with the selection mode for ssget. I solve this by replacing "_+.:E:S" with ":S". It asks for the block name, then the polyline. After I click the polyline, it does nothing and exits the command without returning any error. It's strange, usualy when some function is not working it says something like bad argument type or function X not defined, though many lisps work without problems. Anyway, thank you so much for your time.

If it is the "_+.:E:S" option of (ssget) that is causing the problem in ProgeCAD.
Here is another way to circumvent this obstacle.

  

(defun c:sel_blk&vertex ( / name_blk ss_blk loop sel ent lst_pt ss n ent_blk pt_ins)
  (while (not (tblsearch "BLOCK" (setq name_blk (getstring "\nName of block: " T))))
    (princ "\n ** incorrect name block! **")
  )
  (setq ss_blk (ssget "_X" (list '(0 . "INSERT") (cons 2 name_blk))))
  (cond
    (ss_blk
      (setq loop T)
      (while loop
        (setq sel (entsel "\nSelect polyline"))
        (cond
          ((and sel (eq (cdr (assoc 0 (entget (car sel)))) "LWPOLYLINE"))
            (setq
              loop nil
              ent (car sel)
              lst_pt (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget ent)))
              ss (ssadd)
            )
            (repeat (setq n (sslength ss_blk))
              (setq pt_ins (cdr (assoc 10 (entget (setq ent_blk (ssname ss_blk (setq n (1- n))))))))
              (mapcar
                '(lambda (x)
                  (if (equal (list (car pt_ins) (cadr pt_ins)) x 1E-08) (ssadd ent_blk ss))
                )
                lst_pt
              )
            )
            (sssetfirst nil ss)
          )
          (T (princ "\nIs not a LWPOLYLINE or the selection is empty!"))
        )
      )
    )
  )
  (prin1)
)

 

Radu Iordache Contributor

Radu Iordache

Posted
  • Author
Posted
10 hours ago, Tsuky said:

If it is the "_+.:E:S" option of (ssget) that is causing the problem in ProgeCAD.
Here is another way to circumvent this obstacle.

  

(defun c:sel_blk&vertex ( / name_blk ss_blk loop sel ent lst_pt ss n ent_blk pt_ins)
  (while (not (tblsearch "BLOCK" (setq name_blk (getstring "\nName of block: " T))))
    (princ "\n ** incorrect name block! **")
  )
  (setq ss_blk (ssget "_X" (list '(0 . "INSERT") (cons 2 name_blk))))
  (cond
    (ss_blk
      (setq loop T)
      (while loop
        (setq sel (entsel "\nSelect polyline"))
        (cond
          ((and sel (eq (cdr (assoc 0 (entget (car sel)))) "LWPOLYLINE"))
            (setq
              loop nil
              ent (car sel)
              lst_pt (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget ent)))
              ss (ssadd)
            )
            (repeat (setq n (sslength ss_blk))
              (setq pt_ins (cdr (assoc 10 (entget (setq ent_blk (ssname ss_blk (setq n (1- n))))))))
              (mapcar
                '(lambda (x)
                  (if (equal (list (car pt_ins) (cadr pt_ins)) x 1E-08) (ssadd ent_blk ss))
                )
                lst_pt
              )
            )
            (sssetfirst nil ss)
          )
          (T (princ "\nIs not a LWPOLYLINE or the selection is empty!"))
        )
      )
    )
  )
  (prin1)
)

 

Thank you for your reply! Unfortunately it's the same. No error but does nothing, just exists the command after selecting the polyline.

Radu Iordache Contributor

Radu Iordache

Posted
  • Author
Posted (edited)

Thanks everybody for your time. I finally found this one, works in ProgeCAD too.

 

(defun c:SLBL  (/ set->list plset blk sel i pl o)

 (defun set->list (a / l)
   (if    a
     (repeat (setq i (sslength a))
(setq l (cons (ssname a (setq i (1- i))) l))
     )
   )
   l
 )
 (if (setq plset (ssget '((0 . "*polyline"))))
   (progn
     (setq blk    (set->list (ssget "_X" '((0 . "insert"))))
    sel    (ssadd)
     )
     (repeat (setq i (sslength plset))
(setq
  pl (vlax-ename->vla-object (ssname plset (setq i (1- i))))
)
(setq o    (vl-remove-if-not
      '(lambda (x / a b)
         (setq a (cdr (assoc 10 (entget x)))
           b (vlax-curve-getclosestpointto pl a)
         )
         (< (distance a b) 1e-4)
       )
      blk
    )
)
(foreach x o (ssadd x sel))
     )
     (sssetfirst nil sel)
   )
 )
 (princ)
)

Edited by Radu Iordache
2m3n Newbie

2m3n

Posted
Posted
On 3/30/2023 at 12:55 PM, Radu Iordache said:

Thanks everybody for your time. I finally found this one, works in ProgeCAD too.

 

(defun c:SLBL  (/ set->list plset blk sel i pl o)

 (defun set->list (a / l)
   (if    a
     (repeat (setq i (sslength a))
(setq l (cons (ssname a (setq i (1- i))) l))
     )
   )
   l
 )
 (if (setq plset (ssget '((0 . "*polyline"))))
   (progn
     (setq blk    (set->list (ssget "_X" '((0 . "insert"))))
    sel    (ssadd)
     )
     (repeat (setq i (sslength plset))
(setq
  pl (vlax-ename->vla-object (ssname plset (setq i (1- i))))
)
(setq o    (vl-remove-if-not
      '(lambda (x / a b)
         (setq a (cdr (assoc 10 (entget x)))
           b (vlax-curve-getclosestpointto pl a)
         )
         (< (distance a b) 1e-4)
       )
      blk
    )
)
(foreach x o (ssadd x sel))
     )
     (sssetfirst nil sel)
   )
 )
 (princ)
)

 

I've tried hardly but I've lack of knowledge. Can somebody help me to combine this one to another one I have? The lisp (RotAP) is rotating objects along the polyline. What I want is first select all the objects and then rotate it with only one click on a polyline. 

 

Thanks in advance for your time.

RotAP.lsp

  • 2 months later...
2m3n Newbie

2m3n

Posted
Posted
On 4/3/2023 at 10:14 PM, 2m3n said:

 

I've tried hardly but I've lack of knowledge. Can somebody help me to combine this one to another one I have? The lisp (RotAP) is rotating objects along the polyline. What I want is first select all the objects and then rotate it with only one click on a polyline. 

 

Thanks in advance for your time.

RotAP.lsp 1.36 kB · 1 download

 

Anyone?!

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