Automatic Route Length

[Elektrik]

Is there a lisp that could automatically give the lenghts of all lines' routes at the end. The lines should not have to be polylines, lines touching each other should be enough, and the lisp should give the lenght of each line route at the end. Is something like that possible?

[Emmanuel Delay]

It's not that easy.

Part of the solution can be found here (I think)

But it's not the exact solution to your problem

 

[ronjonp]

Take a look HERE

[Emmanuel Delay]

Are there any rules to which kind of structures can exist?  Do you have a more complicated example?

[Elektrik]

On ‎7‎/‎25‎/‎2019 at 11:45 AM, Emmanuel Delay said:

Are there any rules to which kind of structures can exist?  Do you have a more complicated example?

 

First of all, English is not my native language, so I will do my best to explain in what way I want to use such a lisp. Let's assume I am designing an Internet protocol surveillance system with cameras. The cameras are connected to the system via data cables from a rack cabinet. If there are a lot of cameras in the design, there is not enough space for each cable to be shown by separate lines in the architectural layout (like a corridor). So, from the rack cabin to the last equipment block (camera) only a single line is drawn, and cables to each camera branch out from this main line. And, if the visible lines are selected, it will not give the total length of all the cables. That's why I am looking for a way to automatically calculate the length of the main line from the rack cabinet to the cable branch line + branch cable to the equipment. The lisp should recognize the parts of main line between the starting point (a rack cabinet in this example) and each branch as separate lines and sum it up with the length of the relevant branch line. When a starting point (like the starting point of the main line from the cabinet) is selected, it will provide the total length of each separate branch line at the end of the relevant lines. I hope I somehow explained it.

[ronjonp]

The link I posted to will do exactly what you want. You have to keep your routes as polylines though.

 

Quote

;; RJP - 08.26.2013
;; Expects a selection of polylines to determine the usable 'routes'
;; as well as a selection of blocks that are the points to trace back 
;; to a picked 'home' point

 

Edited July 26, 2019 by ronjonp

[BIGAL]

A simple more manual method play with elev, this will create your plines all with a Z on correct layer all lengths will be correct, Autocad should honor the z value so highest pline and color will sit on top of the others. Or a simple add Z should be easy to provide.

 

eg pline1 @ Z 0

pline2 @z 1

pline3 @z 2 and so on.

 

Perimeter:  293.7853
                Location:  X=   68  Y=   178  Z=   0
Perimeter:  223.7853
                Location:  X=   134  Y=   174  Z=   2.5
Perimeter:  163.7853
                Location:  X=   198  Y=   178  Z=   5
 

 

Edited July 27, 2019 by BIGAL

[ronjonp]

On 7/26/2019 at 11:35 PM, BIGAL said:

A simple more manual method play with elev, this will create your plines all with a Z on correct layer all lengths will be correct, Autocad should honor the z value so highest pline and color will sit on top of the others. Or a simple add Z should be easy to provide.

 

eg pline1 @ Z 0

pline2 @z 1

pline3 @z 2 and so on.

 

Perimeter:  293.7853
                Location:  X=   68  Y=   178  Z=   0
Perimeter:  223.7853
                Location:  X=   134  Y=   174  Z=   2.5
Perimeter:  163.7853
                Location:  X=   198  Y=   178  Z=   5
 

 

 

I think the issue is the OP is not drawing the routes as your showing. They want to have one leg with branches teeing off but also get a total length of wire.

 

[BIGAL]

Your right ronjonp the algorithm maybe can maybe be simplified as the original code was for very complex runs, if you make the longest run a pline, pick it then pick branches using intersectwith and getdistatpoint you can work out the length by adding the two. No code just an idea. Looking at image seems practical.

 

Pick start, pick end, pick branch/s, tot & lens.

 

There is a lisp for radius on end of line don't use fillet see image.

[Emmanuel Delay]

I made something. 

It's not finished, but I think it does (more or less) what you want.  It's not fool proof.

 

The algorithm draws polylines and text objects on the drawing.  These can be removed if needed.

 

Requirements:

- Only lines!!

- I expect a main line that has 1 Autocad Line that goes to the end.  Branches must have an endpoint that's connected on the main line.  Let those intersect points not be endpoints on the main line (or you will confuse my algorithm).

 

Command ARL

Then select the lines.

Then select the start point.  This must be the end of the line!  

 

Try it on my dwg in attachment first.  Then see if it works for your drawings

 

(vl-load-com)

;; Intersections  -  Lee Mac
;; Returns a list of all points of intersection between two objects
;; for the given intersection mode.
;; ob1,ob2 - [vla] VLA-Objects
;;     mod - [int] acextendoption enum of intersectwith method
        ;; acextendnone           Do not extend either object
        ;; acextendthisentity     Extend obj1 to meet obj2
        ;; acextendotherentity     Extend obj2 to meet obj1
        ;; acextendboth           Extend both objects
(defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
        )
        (repeat (/ (length lst) 3)
            (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                  lst (cdddr lst)
            )
        )
    )
    (reverse rtn)
)
;; test LM:intersections
(defun c:test ( / ob1 ob2)
  (setq ob1 (vlax-ename->vla-object (car (entsel "\nObj 1"))))
  (setq ob2 (vlax-ename->vla-object (car (entsel "\nObj 2"))))
  (LM:intersections  ob1 ob2 acextendnone)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; http://www.lee-mac.com/attributefunctions.html
;; Set Attribute Value  -  Lee Mac
;; Sets the value of the first attribute with the given tag found within the block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; val - [str] Attribute Value
;; Returns: [str] Attribute value if successful, else nil.
(defun LM:vl-setattributevalue ( blk tag val )
    (setq tag (strcase tag))
    (vl-some
       '(lambda ( att )
            (if (= tag (strcase (vla-get-tagstring att)))
                (progn (vla-put-textstring att val) val)
            )
        )
        (vlax-invoke blk 'getattributes)
    )
)

;; https://www.cadtutor.net/forum/topic/18257-entmake-functions/
(defun Insert (pt Nme sc rot)
 (entmakex (list (cons 0 "INSERT")
                 (cons 2 Nme)
                 (cons 10 pt)  ;; insert point
                 (cons 41 sc)  ;; scale x
                 (cons 42 sc)  ;; scale y
                 (cons 50 rot)
            ))
)

(defun Line (p1 p2)
 (entmakex (list (cons 0 "LINE")
                 (cons 10 p1)
                 (cons 11 p2)))
)

(defun LWPoly (lst cls)
 (entmakex (append (list (cons 0 "LWPOLYLINE")
                         (cons 100 "AcDbEntity")
                         (cons 100 "AcDbPolyline")
                         (cons 90 (length lst))
                         (cons 70 cls))
                   (mapcar (function (lambda (p) (cons 10 p))) lst)))
)

(defun Text (pt hgt str)
 (entmakex (list (cons 0 "TEXT")
                 (cons 10  pt)
                 (cons 40 hgt)
                 (cons 1  str)))
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; returns the other side of a line
(defun other_side (obj pt / p1 p2 res)
  (setq res nil)
  (if obj (progn
    (setq p1 (cdr (assoc 10 (entget obj))))
    (setq p2 (cdr (assoc 11 (entget obj))))
    (if (< (distance pt p1 ) very_small)
      (setq res p2)
      (setq res p1)
    )
  ))
  res
)

;; given an ss selection and an OSNAP point, which lines have endpoint on that point?
;; the length of the result tells you if it's 1: an endpoint, 2: a bend, 3 or more: a star point
;; returns a list of indexes
(defun find_lines_by_pt ( ss pt / i result p1 p2 obj)
  (setq result (list))
  (setq i 0)
  (repeat (sslength ss)
    (setq obj (ssname ss i))
    (setq p1 (cdr (assoc 10 (entget obj))))
    (setq p2 (cdr (assoc 11 (entget obj))))
    (if (or (< (distance pt p1 ) very_small) (< (distance pt p2 ) very_small))
      (setq result (append result (list i)))
    )
    (setq i (+ i 1))
  )
  result
)

;; pt is an endpoint of l1
;; we want to know if pt is an intersect point (, but not an endpoint!) on l2
(defun point_is_intersect (pt l1 l2 / ob1 ob2 ints p1 p2 ins r1 r2 r3)
  (setq ob1 (vlax-ename->vla-object l1))
  (setq ob2 (vlax-ename->vla-object l2))
  (setq ints (LM:intersections  ob1 ob2 acextendnone))

  (if (setq ins (nth 0 ints)) (progn
    ;; see if intersect point is an endpoint of l1
    (setq p1 (cdr (assoc 10 (entget l1))))
    (setq p2 (cdr (assoc 11 (entget l1))))
    (if (or (< (distance ins p1 ) very_small) (< (distance ins p2 ) very_small))
      (setq r1 T)
    )
    ;; see if intersect point is an endpoint of l2
    (setq p1 (cdr (assoc 10 (entget l2))))
    (setq p2 (cdr (assoc 11 (entget l2))))
    (if (or (< (distance ins p1 ) very_small) (< (distance ins p2 ) very_small))
      (setq r2 T)
    )
    ;; see if intersect point is pt
    (if (< (distance ins pt ) very_small)
      (setq r3 T)
    )
  ))  
  (and r1 (not r2) r3)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; you should not try (= floating_point_number1 floating_point_number1), or (= floating_point_number1 0.0)
;; the way floating point numbers are coded the result will not always be what you think it will be.
;; so instead I see if a number is smaller than an arbitrary small number
(setq very_small 0.000001)

;; ss selections are passed by reference.  So (setq ss_copy ss) will not keep the original selection if ss chages (because of ssadd or ssdel).
;; so this function makes a copy where ss_copy will not be affected if ss changes when you use (setq ss_copy (copy_ss ss)).
;; the function copies the contents of the original selection one by one
(defun copy_ss (ss / i result)
  (setq i 0)
  (setq result (ssadd))
  (repeat (sslength ss)
    (ssadd (ssname ss i) result)
    (setq i (+ i 1))
  )
  result
)

(defun gt (ss pt0 / pt1 plines lines ob1 ss_copy ss_copy2 lst)
  (setq plines (list))
  (setq ss_copy ss)
  (setq lines (find_lines_by_pt ss pt0))
  ;;(princ lines)  
  (setq ob1 (ssname ss (nth 0 lines)))
  (setq lst (list pt0))
 
  (while (setq pt1 (other_side ob1 pt0))
    (setq lst (append lst (list pt1)))
    (setq pt0 pt1)
    (ssdel (ssname ss (nth 0 lines)) ss_copy)
    (setq lines (find_lines_by_pt ss_copy pt0))
    (if (> (length lines) 0)  (progn   
        (setq ob1 (ssname ss (nth 0 lines)))
      )
      (progn
        (setq ob1 nil)
      )
    )
  )
  ;; we return an associated list of useful data
  (list
    (cons "plines" (setq plines (LWPoly lst 0)))
    (cons "ss" ss_copy)
    (cons "end" pt0)
    (cons "vertices" (length lst))
    (cons "plinelength" (vlax-curve-getDistAtParam plines (vlax-curve-getEndParam plines)))
  )
)

(defun c:arl ( / ss ss_copy pt0 pline plines trunk ent plinelength lengths i ob1 ob2 total_length)

;; FIRST we look for the main line

  (setq lengths 0.0)
  (setq ss (ssget (list (cons 0 "LINE"))))
  (setq pt0 (osnap (getpoint "\nSelect the trunk <osnap on the base of the trunk>: \n") "_end"))
 
  (setq trunk (gt ss pt0))
  ;; extract data
  (setq ss_copy (cdr (assoc "ss" trunk)))
  (setq pline (cdr (assoc "plines" trunk)))
  (setq endpoint (cdr (assoc "end" trunk)))
  (setq plinelength (cdr (assoc "plinelength" trunk)))
  (setq total_length plinelength)
 
  (Text
    endpoint
    2.5
    (rtos plinelength 2 4)
  )
 
;; NEXT, we look for branches that intersect the main line  

  (setq i 0)
  (setq ss_copy2 (copy_ss ss_copy))  ;; we need a copy of ss_copy as it is right now.  Because gg will alter copy_ss.
  (setq ob1 (vlax-ename->vla-object pline))
  (repeat (sslength ss_copy)
    (setq ob2 (vlax-ename->vla-object (ssname ss_copy i)))
    (setq pt0 (LM:intersections  ob1 ob2 acextendnone))
    (if (= (vl-princ-to-string (type pt0)) "LIST") (progn

      (setq trunk2 (gt ss_copy (nth 0 pt0)))
      (setq ss_copy (copy_ss ss_copy2))

      (setq endpoint (cdr (assoc "end" trunk2)))
      (setq vertices (cdr (assoc "vertices" trunk2)))
      (setq plinelength (cdr (assoc "plinelength" trunk2)))
      
      ;; now we have to add that length of the branch to the distance on the main line (to the intersect point)
      (setq plinelength (+ plinelength (vlax-curve-getDistAtPoint ob1 (nth 0 pt0))))  
      (setq total_length (+ total_length plinelength))
      
      (Text
        endpoint
        2.5
        (rtos plinelength 2 4)
      )
      
    ))
    (setq i (+ i 1))
  )
 
  (princ "\nTotal length: ")
  (princ (rtos total_length 2 4))
  (princ)

)

tree4.dwg

[aaron.gonzalez]

On 7/26/2019 at 3:43 PM, ronjonp said:

The link I posted to will do exactly what you want. You have to keep your routes as polylines though.

 

 

Hi ron, can you share the lisp please?

[Jonathan Handojo]

9 hours ago, aaron.gonzalez said:

Hi ron, can you share the lisp please?

 

This is something that I use in my daily work. As opposed to air flow, I use it to draw pex piping from the manifolds (or the riser shaft) to each of the apartments on that floor. On another instance, I also use it to determine the maximum distance from a sewer stack riser to each of the fixtures being drained to it. So far this serves my purpose and works on lines and polylines without any arc segments.

 

(defun c:foo
    (/ *error*  acadobj  activeundo	      adoc     branch	cmd	 ept
    getcoords	    ints     lay      ln       maincords	 msp
    newpts   spt	    ss	     stpl     vln      x ADOC CMD CP EPS EX IPS PLPS RTN SP SSL X Y
    )
    (defun *error* ( msg )
    (vla-EndUndoMark adoc)
    (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*"))
        (princ (strcat "Error: " msg))
        )
    )
    
    (setq acadobj (vlax-get-acad-object)
    adoc (vla-get-ActiveDocument acadobj)
    msp (vla-get-ModelSpace adoc)
    activeundo nil)
    (if (= 0 (logand 8 (getvar "UNDOCTL"))) (vla-StartUndoMark adoc) (setq activeundo T))

    (setq cmd (getvar 'cmdecho))
    (if
    (and
        (setq ss (ssget "_:L" '((0 . "LINE,LWPOLYLINE"))))
        (progn
        (setq ips (LM:intersectionsinset ss)
            ssl (mapcar
                '(lambda (x / ex)
                (setq ex (cdr (assoc 210 (entget x))))
                (cons x
                    (mapcar
                        '(lambda (a) (trans (cdr a) ex 0))
                        (vl-remove-if-not
                        '(lambda (y) (member (car y) '(10 11)))
                        (entget x)
                        )
                        )
                    )
                )
                (selset-to-list ss)
                )
            )
        (foreach x ssl
            (setq
            rtn
            (append
                rtn
                (list
                (cons
                    (car x)
                    (vl-sort
                    (append
                        (cdr x)
                        (vl-remove nil
                        (mapcar
                            '(lambda (y / cp)
                                (cond
                                ((or
                                    (equal y x)
                                    (equal (cadr x) (cadr y) 1e-7)
                                    (equal (last x) (cadr y) 1e-7)
                                    (equal (cadr x) (last y) 1e-7)
                                    (equal (last x) (last y) 1e-7)
                                    )
                                nil
                                )
                                ((equal (cadr y) (setq cp (vlax-curve-getClosestPointTo (car x) (cadr y))) 1e-7) cp)
                                ((equal (last y) (setq cp (vlax-curve-getClosestPointTo (car x) (last y))) 1e-7) cp)
                                )
                                )
                            ssl
                            )
                        )
                        )
                    '(lambda (a b)
                        (<
                            (vlax-curve-getParamAtPoint (car x) a)
                            (vlax-curve-getParamAtPoint (car x) b)
                            )
                        )
                    )
                    )
                )
                )
            )
            )
        (setq rtn (apply 'append (mapcar '(lambda (x) (mapcar '(lambda (a b) (list a b)) (cdr x) (cddr x))) rtn)))
        )
        (setq
        eps (apply 'append (mapcar '(lambda (x) (list (cadr x) (last x))) ssl))
        eps (vl-remove-if '(lambda (x) (vl-some '(lambda (y) (equal x y 1e-7)) ips)) eps)
        sp (getpoint "\nSpecify starting point <exit>: ")
        )
        )
    (progn
        (setq sp (trans sp 1 0) eps (vl-remove-if '(lambda (x) (equal x sp 1e-7)) eps)
        ssl (mapcar '(lambda (x) (cons (vlax-ename->vla-object (car x)) (cdr x))) ssl)
        )
        (foreach ps eps
        (and
            (setq plps (TreePath rtn sp ps))
            (entmake
            (append
                (list
                '(0 . "LWPOLYLINE")
                '(100 . "AcDbEntity")
                '(100 . "AcDbPolyline")
                (cons 90 (length plps))
                )
                (apply 'append
                (mapcar
                    '(lambda (x)
                        (list
                        (list 10 (car x) (cadr x))
                        '(40 . 0.0)
                        '(41 . 0.0)
                        '(42 . 0.0)
                        '(91 . 0.0)
                        )
                        )
                    plps
                    )
                )
                )
            )
            (mapcar
            '(lambda (x)
                (if
                (and
                    (not (vlax-erased-p (car x)))
                    (vl-some '(lambda (y) (vl-some '(lambda (z) (equal z y 1e-7)) plps)) (cdr x))
                    )
                (vla-delete (car x))
                )
                )
            ssl
            )
            )
        )
        )
    )
    (if activeundo nil (vla-EndUndoMark adoc))
    (princ)
    )

(defun selset-to-list (selset / lst iter)
    (if selset
    (repeat (setq iter (sslength selset))
        (setq lst (cons (ssname selset (setq iter (1- iter))) lst))
        )
    )
    )

;;; TreePath
;;; Attempts to find a single route from one point to another through a network of nodes
;;; (similar to every turn/signal from that of a car GPS)
;;; With thanks to ronjonp & ymg from "TheSwamp" for ideas to help out:
;;; http://www.theswamp.org/index.php?topic=45092.45
;;; 
;;; lst - a list of lists where each sublist is a list of two points between each node to calculate
;;; sp - starting point
;;; ep - ending point
;;;
;;; Returns a list of points reaching from SP to EP.
;;; If SP or EP is not found within the list of nodes, returns nil (as opposed to an endless loop).

(defun TreePath (lst sp ep / cl op rtn)
    (setq op (list (list sp sp)) go t)
    (while (and op (not (equal (caar cl) ep 1e-7)))
    (setq cl (cons (car op) cl) op (cdr op))
    (mapcar
        (function
            (lambda (a / c s)
                (if
                (cond
                    ((equal (caar cl) (car a) 1e-7)
                    (setq c (cadr a))
                    )
                    ((equal (caar cl) (cadr a) 1e-7)
                    (setq c (car a))
                    )
                    )
                (progn
                    (cond
                    ((vl-some '(lambda (z) (equal z c 1e-7)) (mapcar 'car cl)))
                    ((progn
                        (setq op
                            (mapcar
                            '(lambda (ss)
                                (if (and (equal c a 1e-7)
                                    (< (distance c (cadr ss))
                                    (apply 'distance a)
                                    )
                                    )
                                (progn (setq s t) c)
                                ss
                                )
                                )
                            op
                            )
                        )
                        s
                        )
                    )
                    (t (setq op (cons (list c (caar cl)) op)))
                    )
                    (setq lst (vl-remove-if '(lambda (x) (equal a x 1e-7)) lst))
                    )
                )
            )
        )
        lst
    )
    (setq op (vl-sort op '(lambda (a b) (< (apply 'distance a) (apply 'distance b)))))
    )
    (if (equal (caar cl) ep 1e-7)
    (progn
        (setq rtn (list (caar cl)))
        (foreach x cl
        (if
            (and
            (equal (car rtn) (car x))
            (not (apply 'equal (append x '(1e-7))))
            )
            (setq rtn (cons (cadr x) rtn))
            )
        )
        rtn
        )
    )
    )

;; Intersections in Set  -  Lee Mac
;; Returns a list of all points of intersection between all objects in a supplied selection set.
;; sel - [sel] Selection Set

(defun LM:intersectionsinset ( sel / id1 id2 ob1 ob2 rtn )
    (repeat (setq id1 (sslength sel))
        (setq ob1 (vlax-ename->vla-object (ssname sel (setq id1 (1- id1)))))
        (repeat (setq id2 id1)
            (setq ob2 (vlax-ename->vla-object (ssname sel (setq id2 (1- id2))))
                  rtn (cons (LM:intersections ob1 ob2 acextendnone) rtn)
            )
        )
    )
    (apply 'append (reverse rtn))
)

;; Intersections  -  Lee Mac
;; Returns a list of all points of intersection between two objects
;; for the given intersection mode.
;; ob1,ob2 - [vla] VLA-Objects
;;     mod - [int] acextendoption enum of intersectwith method

(defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
        )
        (repeat (/ (length lst) 3)
            (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                  lst (cdddr lst)
            )
        )
    )
    (reverse rtn)
)

 

[ronjonp]

On 9/4/2021 at 7:04 PM, aaron.gonzalez said:

Hi ron, can you share the lisp please?

The code is still at the link posted HERE.

[aaron.gonzalez]

thanks very much, its very usefull form me.

[aaron.gonzalez]

it´s work very well, if you apply firt the ARL Function by Emmanuel and afther that apply your lisp, the leng of each run it´s more clear.

is it possible to do that each run can be share with any "X" offset? for example take the most far run for to do the other routes with offset.

 

any one commet more,  look this link https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/perpendicular-line-from-multiple-block-base-point-to-polyline/td-p/8927658 

for whatever installation  if you combine this 3 lisp you can a get in a little time all the leng of all divices, its very usefull for electricians

 

thank very much for your effort 

 

[Gintare]

FOO LISP is amazing, is it also possible to do it that it would takes blocks too, not only intersections? (Orange blocks) 

 

Edited January 2, 2023 by Gintare

[BIGAL]

Trying to remember the answer draws individual plines based on a start point and joining to blocks. You supply the gap between the plines. I am pretty sure solution was over at forums/Autodesk. I remember I did something will try to find.