Jump to content

How can I create a group of connected lines?

exceed

By exceed
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

exceed Proficient

exceed

Posted
Posted

 

spacer.png

 

condition :

1. All objects are straight lines with 3D points.

2. When they intersect, the end points meet. = Intersections that do not meet endpoints are not valid.

 

The steps I've been thinking :

1. get dxf numbers 10 and 11 to create a point list in a row. this is main point list

2. If both endpoints of a line are unique in the point list, they are created into separate groups and delete from the main point list.

3. Start grouping based on one reference line.

4. Find other lines that share the same endpoint as this reference line,

  Two points of the original line are removed from the main point list.

  opposite point of the collected lines is used as the next net.

5. counts each time captures a line, and when no more can be collected, group with entity names are extracted by forming them into a list within a list.

  and go back to step 3. starts collecting the next group.

6. It ends when the number of members in the main point list becomes 0, and different colors are assigned to each group.

 

If there is a better way, please let me know.

 

  • Like 1
mhupp Grand Master

mhupp

Posted
Posted
On 6/13/2024 at 4:05 AM, exceed said:

If there is a better way, please let me know.

 

posted this

  1. make main selection of lines
  2. set Lastent as place holder
  3. run Join command lines that can will be joined. (tho now that i look at some of your examples might not work as intended)
  4. process newly created entitys (grouped lines that are now polylines?) into a new selection set SS2
  5. foreach poly in SS2
    1. set Lastent as place holder
    2. explode poly
    3. process newly created entitys back to lines to a new selection set
    4. set a random color

 

Back to what you posted I think dxf 10 and 11 are like 15 decimal places and I had a hard time matching things with out adding a fuzz distance

if you go that route pull the entity name also all at once (Entity (SPT) (EPT)) and then use some lambda magic to find the ones that are touching.

 

NM 🐐 already did it

https://www.lee-mac.com/chainsel.html

  • Like 1
devitg Experienced

devitg

Posted
Posted
On 6/13/2024 at 5:05 AM, exceed said:

 

spacer.png

 

condition :

1. All objects are straight lines with 3D points.

2. When they intersect, the end points meet. = Intersections that do not meet endpoints are not valid.

 

The steps I've been thinking :

1. get dxf numbers 10 and 11 to create a point list in a row. this is main point list

2. If both endpoints of a line are unique in the point list, they are created into separate groups and delete from the main point list.

3. Start grouping based on one reference line.

4. Find other lines that share the same endpoint as this reference line,

  Two points of the original line are removed from the main point list.

  opposite point of the collected lines is used as the next net.

5. counts each time captures a line, and when no more can be collected, group with entity names are extracted by forming them into a list within a list.

  and go back to step 3. starts collecting the next group.

6. It ends when the number of members in the main point list becomes 0, and different colors are assigned to each group.

 

If there is a better way, please let me know.

 

@exceed please upload your-sample.dwg

exceed Proficient

exceed

Posted
  • Author
Posted (edited)

spacer.png

  

(defun c:lgcheck ( / fuzz ss ssl i linelist speplist ent entlist sp ep 
                  spep speplistlen 1spep spepfilter
                  spepfilterlen 1linelist ptlist linelistlen
                  1line ptlist_count linelist2
                  linelist2len catchstack 1stline netfilter
                  1net j linelist3 linelist3len
                  targetline targetsp targetep)
  (setq fuzz 10)
  (if (setq ss (ssget '((0 . "LINE"))))
    (progn
      (setq ssl (sslength ss))
      (setq i 0)
      (setq linelist '())
      (setq speplist '())
      (repeat ssl
        (setq ent (ssname ss i))
        (setq entlist (entget ent))
        (setq sp (cdr (assoc 10 entlist)))
        (setq ep (cdr (assoc 11 entlist)))
        (setq spep (vl-sort (list sp ep) (function (lambda (a b) (cond ((< (car a) (car b))) ((= (car a) (car b)) (< (cadr a) (cadr b))))))))
        (setq linelist (cons (cons spep ent) linelist))
        (setq speplist (cons spep speplist))
;        (setq ptlist (cons ep (cons sp ptlist)))
        (setq i (+ i 1))
      )
      (princ "\n line list before delete duplicate - ")
      (princ (length linelist))
      (setq speplist (LM:Unique speplist))
      (setq speplistlen (length speplist))
      (setq i 0)
      (repeat speplistlen
        (setq 1spep (nth i speplist))
        (setq spepfilter (massoc 1spep linelist))
        (setq spepfilterlen (length spepfilter))
        (if (> spepfilterlen 1)
          (progn
            (repeat (- spepfilterlen 1)
              (setq linelist (vl-remove (cons 1spep (car spepfilter)) linelist))
              (entdel (car spepfilter))
              (setq spepfilter (cdr spepfilter))
            )
          )
          (progn
          )
        )
        (setq i (+ i 1))
      )
      
      (princ "\n line list after delete duplicate - ")
      (princ (length linelist))
      (setq ptlist '())
      (setq linelistlen (length linelist))
      (setq i 0)
      (repeat linelistlen
        (setq 1line (nth i linelist))
        (setq sp (car (car 1line)))
        (setq ep (cadr (car 1line)))
        (setq ptlist (cons ep (cons sp ptlist)))
        (setq i (+ i 1))
      )
      
      ;(princ linelist)
      ;(princ ptlist)
      ;(setq ptlist (vl-sort ptlist (function (lambda (a b) (cond ((< (car a) (car b))) ((= (car a) (car b)) (< (cadr a) (cadr b))))))))
      (setq ptlist_count (LM:CountItems ptlist))
      ;(princ ptlist_count)
      (setq i 0)
      (princ "\n line list before delete isolated - ")
      (princ (length linelist))
      (setq linelist2 linelist)
      (repeat (length linelist)
        (setq 1line (nth i linelist))
        (setq sp (car (car 1line)))
        (setq ep (cadr (car 1line)))
        (if (and (= 1 (cdr (assoc sp ptlist_count))) (= 1 (cdr (assoc ep ptlist_count))))
          (progn
            (setq ptlist (vl-remove sp ptlist))
            (setq ptlist (vl-remove ep ptlist))
            (setq linelist2 (vl-remove 1line linelist2))
            (_addline sp (list 0 0 0) 3)
          )
          (progn
          )
        )
        (setq i (+ i 1))
      )
      (princ "\n line list after delete isolated - ")
      (princ (length linelist2))
      (setq linelist2len (length linelist2))
      ;(setq catchlist (list 1stline))
      (setq catchstack '())
      (while (> (length linelist2) 0)
        (setq 1stline (car linelist2))
        (setq netfilter (list (car (car 1stline)) (cadr (car 1stline))))
        ;(princ netfilter)
        (setq catchlist (list 1stline))
        (setq linelist2 (cdr linelist2))
        (while (> (length netfilter) 0)
          (setq 1net (car netfilter))
          ;(princ "\n 1net - ")
          ;(princ 1net)
          (setq j 0)
          (setq linelist3 linelist2)
          (setq linelist3len (length linelist3))
          (repeat linelist3len
            (setq targetline (car linelist3))
            (setq targetsp (car (car targetline)))
            (setq targetep (cadr (car targetline)))
            (cond
              ((and 
                 (and (< (- (atof (vl-princ-to-string  (car 1net))) fuzz) (atof (vl-princ-to-string  (car targetsp)))) (< (atof (vl-princ-to-string  (car targetsp))) (+ (atof (vl-princ-to-string  (car 1net))) fuzz)))
                 (and (< (- (atof (vl-princ-to-string  (cadr 1net))) fuzz) (atof (vl-princ-to-string  (cadr targetsp)))) (< (atof (vl-princ-to-string  (cadr targetsp))) (+ (atof (vl-princ-to-string  (cadr 1net))) fuzz)))
                 (and (< (- (atof (vl-princ-to-string  (caddr 1net))) fuzz) (atof (vl-princ-to-string  (caddr targetsp)))) (< (atof (vl-princ-to-string  (caddr targetsp))) (+ (atof (vl-princ-to-string  (caddr 1net))) fuzz)))
               )
                (setq netfilter (append netfilter (list targetep)))   
                (setq catchlist (cons targetline catchlist))
                (setq linelist2 (vl-remove targetline linelist2))
              )
              ((and 
                 (and (< (- (atof (vl-princ-to-string  (car 1net))) fuzz) (atof (vl-princ-to-string  (car targetep)))) (< (atof (vl-princ-to-string  (car targetep))) (+ (atof (vl-princ-to-string  (car 1net))) fuzz)))
                 (and (< (- (atof (vl-princ-to-string  (cadr 1net))) fuzz) (atof (vl-princ-to-string  (cadr targetep)))) (< (atof (vl-princ-to-string  (cadr targetep))) (+ (atof (vl-princ-to-string  (cadr 1net))) fuzz)))
                 (and (< (- (atof (vl-princ-to-string  (caddr 1net))) fuzz) (atof (vl-princ-to-string  (caddr targetep)))) (< (atof (vl-princ-to-string  (caddr targetep))) (+ (atof (vl-princ-to-string  (caddr 1net))) fuzz)))
               )
                (setq netfilter (append netfilter (list targetsp)))
                (setq catchlist (cons targetline catchlist))
                (setq linelist2 (vl-remove targetline linelist2))
              )
              (t
              )
            )
            (setq linelist3 (cdr linelist3))
          )
          (setq netfilter (cdr netfilter))
        )
        (setq catchstack (cons (list (length catchlist) catchlist) catchstack))
      )
      ;(princ "\n group - ")
      ;(princ catchstack)
      (princ "\n group count - ")
      (princ (length catchstack))
      (setq catchstack (vl-sort catchstack (function (lambda (a b) (> (car a) (car b))))))      
      (setq i 0)
      (repeat (length catchstack)
        (setq 1group (cadr (nth i catchstack)))
        (setq 1grouplen (length 1group))
        (setq j 0)
        (repeat 1grouplen
          (setq 1groupatomline (nth j 1group))
          (setq 1groupatomename (cdr 1groupatomline))
          (vlax-put-property (vlax-ename->vla-object 1groupatomename) 'color (+ i 1))
          (setq j (+ j 1))
        )
        (setq i (+ i 1))
      )
    ) 
    (progn
    )
  )
  
  
  
  (princ)
)

;; Unique  -  Lee Mac
;; Returns a list with duplicate elements removed.

(defun LM:Unique ( l )
    (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l)))))
)

;; Count Items  -  Lee Mac
;; Returns a list of dotted pairs detailing the number of
;; occurrences of each item in a supplied list.

(defun LM:CountItems ( l / c x )
    (if (setq x (car l))
        (progn
            (setq c (length l)
                  l (vl-remove x (cdr l))
            )
            (cons (cons x (- c (length l))) (LM:CountItems l))
        )
    )
)

(defun massoc ( key lst / itm )
    (if (setq itm (assoc key lst))
        (cons (cdr itm) (massoc key (cdr (member itm lst))))
    )
)

  (defun _addline (startpt endpt col)
    (entmakex (apply 'append
		     (list (list '(0 . "LINE")
				 (cons 100 "AcDbEntity")
				 ;(cons 8 layer)
				 (cons 100 "AcDbLine")
         (cons 62 col)
				 (cons 10 startpt)
				 (cons 11 endpt)
                      
			   )
		     )
	      )
     )
  )

 

 

 

I thought about it over the weekend and tried to solve my homework.

thanks for reply.

 

 

 

This is used to check the integrity of the nodes and edges for the dijkstra algorithm for 3d route and points

 

 

Drawing1.dwg

Edited by exceed
  • Like 1
mhupp Grand Master

mhupp

Posted
Posted

I Would see some plumbers using that!

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