Lisp(?) to draw Polyline across multiple center points

[Anonymous]

(Posting here, since when I posted on general foruns I was recommended to do so:)

Hi, people.
I need some help.

I'm stucked with a job that I must deliver done by next monday.
This job consist in redrawing routes based on older files to a new map and filling this routes with relevant information (I will expand on this later).
These routes are represented by polylines that must have its vertexes matching center points of a block.

 

These blocks represent electrical poles (is that how we call it in english? I'm brazilian). I have been doing this clicking in center-point by center-point, one by one. And I'm fast.
But now I have a little health issue that's making me slower and slower. I have something that may translate to carpal tunnel syndrome in english and it's making my hand hurt really bad.

These routes, polylines, may demand thousands and thousands of clicks in the center points of these blocks, and if add the clicking for pan and navigation... I know it is quite normal in autocad, but when we are talking about this AND speed AND health issues... Things get dark.

The general view of the position of the poles it this:

 I believe it is possible to understand the size of this demon (and it hasn't even finished - pole-wise) with this image.

It is also possible to see here that I already have much of it done. But I do not.

These lines represent other things. In order to add and analyze the data I have to, I must redraw. I do not have enough time nor my english is flexible enough to explain it, but I have to see file by file and redraw it with my own two eyes and my own two hands. It is a insane-importantness-level thing, that may strenghen our argument in legal subjects in the next monday meeting.

So let's get to what I need help with.
I can write something in autoLISP, but I'm not good (nor I have the time to experiment) enough.

I want something that allow me to select these blocks - or circles - that I need and automatically draw a polyline based on it's center points. As the sample above showed.

I'm attaching this file so anyone who can help me may play with it.

The rules would be: one direction.
From the "first" center point" to the nearest next and so on until it "links" all the selected blocks/circles with this polyline.

Is it possible? Is there already a command or lisp out there that makes this for me? (didn't have luck so far with my search)

 

Please, guys. Help me.

[ВeekeeCZ]

Hmm, Traveling Salesman problem...

THIS routine by CADstudio will solve it.

Fix the block's insertion point first using THIS Lee Mac's routine.

[marko_ribar]

Maybe this, untested though...

(defun c:connect ( / ss i e plist p nextpt plist-sorted pp )
  (while (or (prompt "\nSelect blocks or circles...") (not (setq ss (ssget '((0 . "INSERT,CIRCLE"))))))
    (prompt "\nEmpty sel. set...")
  )
  (repeat (setq i (sslength ss))
    (setq e (ssname ss (setq i (1- i))))
    (setq plist (cons (cdr (assoc 10 (entget e))) plist))
  )
  (setq p (getpoint "\nPick or specify start point - use osnap cen or ins : "))

  (defun nextpt ( p plist / car-sort pp )

    (defun car-sort ( l f / removenth r k )

      (defun removenth ( l n / k )
        (setq k -1)
        (vl-remove-if '(lambda ( x ) (= (setq k (1+ k)) n)) l)
      )

      (setq k -1)
      (vl-some '(lambda ( a ) (setq k (1+ k)) (if (vl-every '(lambda ( x ) (apply f (list a x))) (removenth l k)) (setq r a))) l)
      r
    )  

    (setq plist (vl-remove-if '(lambda ( x ) (equal x p 1e-3)) plist))
    (setq pp (car-sort plist '(lambda ( a b ) (<= (distance p a) (distance p b)))))
    pp
  )

  (if p
    (progn
      (while (cadr plist)
        (setq plist-sorted (cons p plist-sorted))
        (setq pp (nextpt p plist))
        (setq plist (vl-remove-if '(lambda ( x ) (equal x p 1e-3)) plist))
        (setq p pp)
      )
      (setq plist-sorted (cons (car plist) plist-sorted))
      (setq plist-sorted (reverse plist-sorted))
      (entmake
        (append
          (list
            '(0 . "LWPOLYLINE")
            '(100 . "AcDbEntity")
            '(100 . "AcDbPolyline")
            (cons 90 (length plist-sorted))
            (cons 70 (if (= 1 (getvar 'plinegen)) 128 0))
            '(38 . 0.0)
          )
          (mapcar '(lambda ( p ) (cons 10 p)) plist-sorted)
          (list '(210 0.0 0.0 1.0))
        )
      )
    )
  )
  (princ)
)

HTH.

[marko_ribar · Accepted solution]

Some minor revision... Still untested...

(defun c:connect ( / ss i e plist p nextpt plist-sorted rtn pp )
  (while (or (prompt "\nSelect blocks or circles...") (not (setq ss (ssget '((0 . "INSERT,CIRCLE"))))))
    (prompt "\nEmpty sel. set...")
  )
  (repeat (setq i (sslength ss))
    (setq e (ssname ss (setq i (1- i))))
    (setq plist (cons (cdr (assoc 10 (entget e))) plist))
  )
  (setq p (getpoint "\nPick or specify start point - use osnap cen or ins : "))

  (defun nextpt ( p plist / car-sort pp )

    (defun car-sort ( l f / removenth r k )

      (defun removenth ( l n / k )
        (setq k -1)
        (vl-remove-if '(lambda ( x ) (= (setq k (1+ k)) n)) l)
      )

      (setq k -1)
      (vl-some '(lambda ( a ) (setq k (1+ k)) (if (vl-every '(lambda ( x ) (apply f (list a x))) (removenth l k)) (setq r a))) l)
      r
    )  

    (setq plist (vl-remove-if '(lambda ( x ) (equal x p 1e-3)) plist))
    (setq pp (car-sort plist '(lambda ( a b ) (<= (distance p a) (distance p b)))))
    (list pp plist)
  )

  (if p
    (progn
      (while (cadr plist)
        (setq plist-sorted (cons p plist-sorted))
        (setq rtn (nextpt p plist))
        (setq pp (car rtn) plist (cadr rtn))
        (setq p pp)
      )
      (setq plist-sorted (cons (car plist) plist-sorted))
      (setq plist-sorted (reverse plist-sorted))
      (entmake
        (append
          (list
            '(0 . "LWPOLYLINE")
            '(100 . "AcDbEntity")
            '(100 . "AcDbPolyline")
            (cons 90 (length plist-sorted))
            (cons 70 (if (= 1 (getvar 'plinegen)) 128 0))
            '(38 . 0.0)
          )
          (mapcar '(lambda ( p ) (cons 10 p)) plist-sorted)
          (list '(210 0.0 0.0 1.0))
        )
      )
    )
  )
  (princ)
)

[DannyNL · Accepted solution]

Try this one as well. 

All type of objects can be selected and the vertex point for the polyline is determined by the center of the bounding box of the object.

Tested on several drawings incl. your example drawing.

With your example drawing the points are not 100% accurate; this is caused as the block contains another block with several dynamic visibility parameters and the center of the bounding box is not exactly in the center of the circle. But as the offset of the polyline points is the same for all those blocks, you could easily move the created polyline afterwards so it runs exactly through the center of the circles.

(defun c:CreateShortPath (/ GetMidPoints SortPointList CSP_Point CSP_Selection CSP_PointList)

   (defun GetMidPoints (GMP_Selection / GMP_Object GMP_Point1 GMP_Point2 GMP_Return)
      (if
         (and
            (= (type GMP_Selection) 'PICKSET)
            (> (sslength GMP_Selection) 0)
         )
         (progn
            (foreach GMP_Object (vl-remove-if '(lambda (GMP_Item) (listp (cadr GMP_Item))) (ssnamex GMP_Selection))
               (if
                  (vlax-method-applicable-p (setq GMP_Object (vlax-ename->vla-object (cadr GMP_Object))) 'GetBoundingBox)
                  (progn
                     (vla-GetBoundingBox GMP_Object 'GMP_Point1 'GMP_Point2)
                     (setq GMP_Return
                        (cons
                           (mapcar '(lambda (GMP_Value1 GMP_Value2) (/ (+ GMP_Value1 GMP_Value2) 2.0)) (vlax-safearray->list GMP_Point1) (vlax-safearray->list GMP_Point2))
                           GMP_Return                        
                        )
                     )
                  )
               )
            )
         )
      )
      GMP_Return
   )

   (defun SortPointList (SPL_PointList / SPL_Point SPL_Return)
      (setq SPL_PointList (vl-sort SPL_PointList '(lambda (SPL_Item1 CSPCSP_Item2)(< (distance SPL_Item1 (car SPL_PointList))(distance CSPCSP_Item2 (car SPL_PointList))))))
      (repeat (length SPL_PointList)
         (setq SPL_Return (cons (setq SPL_Point (car SPL_PointList)) SPL_Return))
         (setq SPL_PointList (cdr SPL_PointList))
         (setq SPL_PointList (vl-sort SPL_PointList '(lambda (SPL_Item1 CSPCSP_Item2)(< (distance SPL_Item1 SPL_Point)(distance CSPCSP_Item2 SPL_Point)))))
      )
      (reverse SPL_Return)
   )
   
   (if
      (and
         (setq CSP_Selection (ssget))
         (setq CSP_Point (getpoint "\nIndicate startpoint: "))                  
      )
      (progn         
         (setq CSP_PointList (SortPointList (cons CSP_Point (GetMidPoints CSP_Selection))))
         (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
         (entmake
            (append
               (list
                  '(0 . "LWPOLYLINE")
                  '(100 . "AcDbEntity")
                  '(100 . "AcDbPolyline")
                  (cons 90 (length CSP_PointList))
                  (cons 70 (if (= 1 (getvar 'PLINEGEN)) 128 0))
                  '(38 . 0.0)
               )
               (mapcar '(lambda (CSP_Item) (cons 10 CSP_Item)) CSP_PointList)
               (list '(210 0.0 0.0 1.0))
            )
         )         
         (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
      )                
   )
   (princ) 
)  

[ronjonp]

Here's another:

(defun c:path (/ _daisychain a ll p pt s ur)
  ;; RJP - 6.1.2018
  ;; Creates a path using the midpt of bounding box of blocks
  (defun _daisychain (pt l / tmp out dsort)
    (defun dsort (pt l / d1 d2)
      (vl-sort l (function (lambda (d1 d2) (< (distance pt d1) (distance pt d2)))))
    )
    (setq tmp (dsort pt l))
    (while (setq tmp (dsort (car tmp) tmp)) (setq out (cons (car tmp) out)) (setq tmp (cdr tmp)))
    (reverse out)
  )
  (cond	((and (setq p (getpoint "\nPick point to sort from: "))
	      (setq s (ssget '((0 . "insert") (2 . "Poste_Concreto"))))
	      (setq s
		     (mapcar '(lambda (x)
				(vla-getboundingbox (vlax-ename->vla-object x) 'll 'ur)
				(mapcar	'(lambda (a) (/ a 2.))
					(apply 'mapcar (cons '+ (mapcar 'vlax-safearray->list (list ll ur))))
				)
				;; If your block had an insertion point at the center of the circle then the line below would be enough
				;; (vlax-get x 'insertionpoint)
			      )
			     (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
		     )
	      )
	      (setq s (_daisychain p s))
	 )
	 (entmakex (append (list '(0 . "LWPOLYLINE")
				 '(100 . "AcDbEntity")
				 '(100 . "AcDbPolyline")
				 '(8 . "Netell-Aerial-Network_Authorized (Real-Built)")
				 (cons 90 (length s))
				 '(38 . 0.0)
			   )
			   (mapcar '(lambda (x) (cons 10 x)) s)
			   (list '(210 0.0 0.0 1.0))
		   )
	 )
	)
  )
  (princ)
)
(vl-load-com)

[Anonymous]

(2 weeks later...)

That monday was great because you guys.
Not only I was able to finish in time thanks to these lisps as well as my finalized project will become a pilot of a great operation here in Sao Paulo by the energy company who manages the electricity here.

The outcome was greater than the expected by various aspects, but it only became possible because of your solutions.

My hand could rest a tremenduous lot because of you.

My gratitude!

(while we are at it, do someone knows how to do this with alligned dimensions? select a multiple objects, exactly like these poles and then generate the dimensions for each center-to-center? is there something already done with this function?)

[dlanorh]

Maybe the solution HERE can help

[Anonymous]

Rather than throw in another routine the suggestions/posts all end up with a list of points so by not erasing that list but squeezing in before the end of the defun a loop, dim pt1 pt2, setq pt1 pt2 and repeat etc 

[viporpa]

Is there a way to get this LISP to work by connecting just points instead of center of circles ?

[Kent1Cooper]

---

@viporpa wrote:

Is there a way to get this LISP to work by connecting just points instead of center of circles ?

---

If by that you mean Point entities, you could change this in @marko_ribar's code:

(while (or (prompt "\nSelect blocks or circles...") (not (setq ss (ssget '((0 . "INSERT,CIRCLE"))))

 to this:

(while (or (prompt "\nSelect blocks or circles or points...") (not (setq ss (ssget '((0 . "INSERT,CIRCLE,POINT"))))

Since the location of a Point is kept in the same (assoc 10) entry in entity data as the insertion point of a Block or the center of a Circle, the rest should be able to remain the same.  You can remove the INSERT and CIRCLE possibilities from the filter, if you really want selection to "see" only  Points.

[viporpa]

Thank you , perfect !

[Anonymous]

Hello, great lisp (createshortpath)

I was wondering how you coul get the line going straight on the upper line and than going down to the lower line.

Now it's going up and down.

Also I would like to insert a + on the beginning and a - at the end.

If possible even name the pline. is this possible?

regards Werner

[Anonymous]

Thanks a lot for great lisp.
I am trying to create left, right and midle axis of a road with taken 3 point with some interval. Example picture as below.

Is it possible to do this with your lisp to define an initial direction, maximum deflection angle, minimum and maximum segment lenght variables?

[Sea-Haven]

This is posted else where did ask if original points where from a text file csv etc no answer so far

[Anonymous]

Greetings!

Do you have a point limit for this feat?

[Anonymous]

Greetings! Is it possible to change this code to create the polyline by joining the points obeying an angle criterion and not the closest path? For example, selecting a starting point and giving it a starting angle, from there the code looks for the next point to draw the line obeying the angle (range) and distance (maximum distance) criteria.

[ajmalnattika]

Is it possible to make like only x-axis and y-axis only? That means only ortho mode. length of the line is no issue

Like the attached picture that

[Sea-Haven]

This would be better asked as a new post its very different to the original request, the turn 90 needs some sort of rules or user input very different to the auto join. 

[SROBERTS-2017]

I just came across this and i am trying to modify so that it will pick end points and i have got that to work but it select the beginning point that i have chosen and then jumps up to the top of the line and i want it to stay at the bottom and go across all my line, thank you for any help!!!