Jump to content

Find points connected with line or polyline


Bane

Recommended Posts

Hello everybody,

I use ssget function to select all point entities in drawing. I need some kind of filter to select only those points which represents a starting or ending point of existing line or polyline. Other (free) points should be excluded from selection set.

 

Any help is very welcome.

Thank you

Link to comment
Share on other sites

Give that a try

Not tested enough

 

;; local defun
(defun _remove-points(/ en i pe pt sscol ssl ssp)
(setq sscol (ssadd))
(setq ssp (ssget "_X" (list
	       (cons 0 "POINT")
               (cons 410 (getvar "CTAB")))))
(setq i -1)
(while (setq en (ssname ssp (setq i (1+ i))))
      (setq pt (cdr (assoc 10 (entget en))))
 (if  (setq ssl (ssget "C" (list (car pt)(cadr pt))
		(list (car pt)(cadr pt))
		(list
		  (cons 0 "LINE,*POLYLINE")
		  (cons 410 (getvar "CTAB")))))
   (progn
     (setq pe (ssname ssl 0))
     (if (or
    (equal (vlax-curve-getclosestpointto pe pt)
		   (vlax-curve-getstartpoint pe) 0.00001)
    (equal (vlax-curve-getclosestpointto pe pt)
		  (vlax-curve-getendpoint pe) 0.00001))
(ssadd en sscol); gather the desired points into separate selection set
)
     ))
 )
sscol ;<-- return selection set with desired points
 )
;; usage:
(defun C:test ()
 (setq ss (_remove-points))
 (alert (strcat "Desired points found: " (itoa (sslength ss))))
 (princ)
 )
(vl-load-com)

 

~'J'~

Link to comment
Share on other sites

Sorry, I forgot to add this line:

(vl-load-com)

this function load ActiveX DLLs (VLA-functions)

I edited my code above, try it again

BTW, tested on A2008 only

 

~'J'~

Link to comment
Share on other sites

That's it. Thank you.

 

There is only one more problem, but probably, it is AutoCads' bug. I finished this code by inserting circles on points in new selection set. If I zoom "extents" some points that should have circle on it are omitted. If I zoom "in" to that points and start this code again, everything is ok.

 

I can live with this.

 

Thank you for help.

 

Best wishes.

Link to comment
Share on other sites

Hope an addition will be fix this problem:

(defun C:test ()
(command "._zoom" "_e")
 (setq ss (_remove-points))
 (alert (strcat "Desired points found: " (itoa (sslength ss))))
(command "._zoom" "_p")
 (princ)
 )

 

~'J'~

Link to comment
Share on other sites

I already tried something similar. In my current drawing there are 2 points which must be selected in selection set because they represent starting points of two lines. But when I start this code they are not selected. Only if I zoom in more enough to see clearly that two points, everything is ok.

 

Maybe it is important to notice that third line passes very close to that points (about 2mm).

 

I can send an example, if you want.

 

Thanks.

 

Hope an addition will be fix this problem:

(defun C:test ()
(command "._zoom" "_e")
 (setq ss (_remove-points))
 (alert (strcat "Desired points found: " (itoa (sslength ss))))
(command "._zoom" "_p")
 (princ)
 )

~'J'~

Link to comment
Share on other sites

I think you need to set OSMODE to 0 before

you'll draw circles in these points

Okay, upload your drawing to see where is

a problem

 

~'J'~

Link to comment
Share on other sites

Autocad has a nasty habit of snapping the wrong object when using lisp etc its usually a good idea to turn your osmode to 0 and reset it (setvar "osmode" myosmode) at the end of your code.

 

Also another bug I came across similar problem for a lisp to work I had to zoom in to a reasonable viewing scale, in close fine, too far out would not work! Used first pick then zoomed scale before next pick point.

Link to comment
Share on other sites

Here is another method, not as fast though.

(defun find-points (/ en i pt result ssl ssp EndPoints TmpLst1 TmpLst2)
 (vl-load-com)
 (setq ssp (ssget "_X"
                  (list
                    (cons 0 "POINT")
                    (cons 410 (getvar "CTAB"))
                  )
           )
 )
 (setq ssl (ssget "_X"
                  (list
                    (cons 0 "LINE,*POLYLINE")
                    (cons 410 (getvar "CTAB"))
                  )
           )
 )
 ;;  get all endpoints from Lines & Polylines
 (setq i -1)
 (while (setq en (ssname ssl (setq i (1+ i))))
   (setq EndPoints (cons (vlax-curve-getstartpoint en) EndPoints)
         EndPoints (cons (vlax-curve-getendpoint en) EndPoints)
   )
 )
 ;;  Loop through All points, find any matching end points
 (setq i -1)
 (while (setq en (ssname ssp (setq i (1+ i))))
   (setq pt (cdr (assoc 10 (entget en))))
   (setq TmpLst1 EndPoints
         TmpLst2 nil
   )
   (While ; loop through All Line endpoints, remove any matches
     (and EndPoints
          (setq p (car TmpLst1))
          (if (equal (distance pt p) 0.0 0.00001)
            (progn ; got a matching point
              (setq result (cons en result)) ; gather points into a list
              (setq Endpoints (append (reverse TmpLst2) (cdr TmpLst1)))
              nil ; Exit While Loop
            )
            (setq TmpLst2 (cons p TmpLst2)
                  TmpLst1 (cdr TmpLst1)) ; not a match, stay in loop
          )
     )
   )
 )
 result   ; <-- return list with desired points
)

 

 

 

;; usage:
(defun C:test (/ lst)
 (if (setq lst (find-points))
   (alert (strcat "Desired points found: " (itoa (length lst))))
   (alert "No points found: ")
 )
 (princ)
)

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