HOang6893 Posted September 13, 2022 Posted September 13, 2022 (edited) Hello experts. I am looking for a solution to my problem. My work involves lengthwise mass dissection on a plane. On the plane I have main lines (Cable Trucking), you imagine it is a tree, consisting of trunk, main branches and sub-branches. I am trying to search the forum and have found some solutions but not completely solved my problem. Hope you can help me to solve this problem. Thank you. Inquiry. Find the length of all branches to the origin, showing the length at the end of each branch. (end of each branch can be block, circle, or nothing, lines can be line and polyline) I have attached the data path including: drawing and some lisp I found. Once again, thank you very much for your support. https://lcies-my.sharepoint.com/:f:/g/personal/hoang_m_lyoffice_net/Eq__Xnx_urpOmUdHYe4XHSUB-Y_2bA-X-1eAXdyQCcKufQ?e=5Twv8H ARL.lsp Drawing1.dwg shortlinespath.lsp Edited September 13, 2022 by HOang6893 Quote
marko_ribar Posted September 13, 2022 Posted September 13, 2022 Here is something I cobbled, but if you really need it working, you'll have to debug it further... Regards... (defun c:treelengths ( / *error* picknode process processtree maketree cmd ucsf bp ss i e el elst slst lst s tree len q enx ) (vl-load-com) (defun *error* ( m ) (if ucsf (if command-s (command-s "_.UCS" "_P") (vl-cmdf "_.UCS" "_P") ) ) (if command-s (command-s "_.UNDO" "_E") (vl-cmdf "_.UNDO" "_E") ) (if cmd (setvar (quote cmdecho) cmd) ) (if m (prompt m) ) (princ) ) (defun picknode ( e / s ) (if (and e (setq s (ssget "_C" (mapcar (function +) (list -1e-3 -1e-3) (trans (cadadr e) 0 1)) (mapcar (function +) (list 1e-3 1e-3) (trans (cadadr e) 0 1)))) (ssdel (car e) s) (> (sslength s) 0) ) s ) ) (defun process ( s e / ee ) (setq ee (vl-remove-if-not (function (lambda ( x ) (ssmemb (car x) s))) lst)) (setq ee (mapcar (function (lambda ( x ) (list (car x) (if (equal (caadr x) (cadadr e) 1e-6) (list (caadr x) (cadadr x)) (list (cadadr x) (caadr x)))))) ee)) (if (and ee (setq s (picknode (car ee))) ) (progn (setq tree (cons (car ee) tree)) (process s (car ee)) ) (if ee (setq tree (cons (car ee) tree)) ) ) ) (defun processtree nil (setq re (cons (caar tree) re)) (setq tree (cdr tree)) (if (and (setq s (picknode (car tree))) (foreach w re (ssdel w s) ) (> (sslength s) 0) ) (process s (car tree)) (processtree) ) ) (defun maketree ( q ) (setq len (apply (function +) (mapcar (function (lambda ( x ) (vlax-curve-getdistatparam (car x) (vlax-curve-getendparam (car x))))) tree))) (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 10 (polar (cadadr (car tree)) (* -0.5 pi) (if (/= (getvar (quote textsize)) 0.0) (getvar (quote textsize)) (* 10.0 (/ (getvar (quote viewsize)) (cadr (getvar (quote screensize)))))))) (cons 1 (rtos len 2 8)) (cons 40 (if (/= (getvar (quote textsize)) 0.0) (getvar (quote textsize)) (* 10.0 (/ (getvar (quote viewsize)) (cadr (getvar (quote screensize))))))) (cons 50 0.0) (cons 62 q) (list 210 0.0 0.0 1.0) ) ) (setq el (entlast)) (foreach e (mapcar (function car) tree) (vla-copy (vlax-ename->vla-object e)) ) (setq s (ssadd)) (while (setq el (entnext el)) (ssadd el s) ) (setq el (entlast)) (vl-cmdf "_.JOIN" s "") (if (not (eq el (entlast))) (if (assoc 62 (setq enx (entget (entlast)))) (entupd (cdr (assoc -1 (entmod (subst (cons 62 q) (assoc 62 enx) enx))))) (entupd (cdr (assoc -1 (entmod (append enx (list (cons 62 q))))))) ) (if (assoc 62 (setq enx (entget (ssname s 0)))) (entupd (cdr (assoc -1 (entmod (subst (cons 62 q) (assoc 62 enx) enx))))) (entupd (cdr (assoc -1 (entmod (append enx (list (cons 62 q))))))) ) ) ) (setq cmd (getvar (quote cmdecho))) (setvar (quote cmdecho) 0) (if (= 8 (logand 8 (getvar (quote undoctl)))) (vl-cmdf "_.UNDO" "_E") ) (vl-cmdf "_.UNDO" "_G") (if (= 0 (getvar (quote worlducs))) (progn (vl-cmdf "_.UCS" "_W") (setq ucsf t) ) ) (if (setq bp (getpoint "\nPick or specify base point : ")) (progn (setq ss (ssget "_X" (list (cons 0 "*POLYLINE,LINE,ARC,SPLINE,ELLIPSE,HELIX") (cons 410 (if (= (getvar (quote cvport)) 1) (getvar (quote ctab)) "Model"))))) (repeat (setq i (sslength ss)) (setq e (ssname ss (setq i (1- i)))) (setq el (entlast)) (if e (cond ( (wcmatch (cdr (assoc 0 (entget e))) "*POLYLINE") (vl-cmdf "_.EXPLODE" e) (while (setq el (entnext el)) (vl-cmdf "_.PEDIT" el "") (setq elst (cons (if (and el (not (vlax-erased-p el)) (= (cdr (assoc 0 (entget el))) "LWPOLYLINE")) el (entlast)) elst)) ) ) ( (wcmatch (cdr (assoc 0 (entget e))) "LINE,ARC") (vl-cmdf "_.PEDIT" e "") (setq elst (cons (if (and e (not (vlax-erased-p e)) (= (cdr (assoc 0 (entget e))) "LWPOLYLINE")) e (entlast)) elst)) ) ( (wcmatch (cdr (assoc 0 (entget e))) "SPLINE,ELLIPSE,HELIX") (setq slst (cons e slst)) ) ) ) ) (setq lst (append elst slst)) (setq lst (mapcar (function (lambda ( x ) (list x (list (vlax-curve-getstartpoint x) (vlax-curve-getendpoint x))))) lst)) (setq e (car (vl-remove-if (function (lambda ( x ) (not (or (equal (trans bp 1 0) (caadr x) 1e-6) (equal (trans bp 1 0) (cadadr x) 1e-6))))) lst))) (setq e (list (car e) (if (equal (trans bp 1 0) (caadr e) 1e-6) (list (caadr e) (cadadr e)) (list (cadadr e) (caadr e))))) (setq tree (cons e tree)) (if (setq s (picknode e)) (process s e) ) (while (not (equal otree tree 1e-6)) (setq q (if (not q) 1 (1+ q))) (setq otree tree) (processtree) (maketree q) ) ) ) (*error* nil) ) 1 Quote
HOang6893 Posted September 14, 2022 Author Posted September 14, 2022 (edited) 7 hours ago, marko_ribar said: Here is something I cobbled, but if you really need it working, you'll have to debug it further... Regards... (defun c:treelengths ( / *error* picknode process processtree maketree cmd ucsf bp ss i e el elst slst lst s tree len q enx ) (vl-load-com) (defun *error* ( m ) (if ucsf (if command-s (command-s "_.UCS" "_P") (vl-cmdf "_.UCS" "_P") ) ) (if command-s (command-s "_.UNDO" "_E") (vl-cmdf "_.UNDO" "_E") ) (if cmd (setvar (quote cmdecho) cmd) ) (if m (prompt m) ) (princ) ) (defun picknode ( e / s ) (if (and e (setq s (ssget "_C" (mapcar (function +) (list -1e-3 -1e-3) (trans (cadadr e) 0 1)) (mapcar (function +) (list 1e-3 1e-3) (trans (cadadr e) 0 1)))) (ssdel (car e) s) (> (sslength s) 0) ) s ) ) (defun process ( s e / ee ) (setq ee (vl-remove-if-not (function (lambda ( x ) (ssmemb (car x) s))) lst)) (setq ee (mapcar (function (lambda ( x ) (list (car x) (if (equal (caadr x) (cadadr e) 1e-6) (list (caadr x) (cadadr x)) (list (cadadr x) (caadr x)))))) ee)) (if (and ee (setq s (picknode (car ee))) ) (progn (setq tree (cons (car ee) tree)) (process s (car ee)) ) (if ee (setq tree (cons (car ee) tree)) ) ) ) (defun processtree nil (setq re (cons (caar tree) re)) (setq tree (cdr tree)) (if (and (setq s (picknode (car tree))) (foreach w re (ssdel w s) ) (> (sslength s) 0) ) (process s (car tree)) (processtree) ) ) (defun maketree ( q ) (setq len (apply (function +) (mapcar (function (lambda ( x ) (vlax-curve-getdistatparam (car x) (vlax-curve-getendparam (car x))))) tree))) (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 10 (polar (cadadr (car tree)) (* -0.5 pi) (if (/= (getvar (quote textsize)) 0.0) (getvar (quote textsize)) (* 10.0 (/ (getvar (quote viewsize)) (cadr (getvar (quote screensize)))))))) (cons 1 (rtos len 2 8)) (cons 40 (if (/= (getvar (quote textsize)) 0.0) (getvar (quote textsize)) (* 10.0 (/ (getvar (quote viewsize)) (cadr (getvar (quote screensize))))))) (cons 50 0.0) (cons 62 q) (list 210 0.0 0.0 1.0) ) ) (setq el (entlast)) (foreach e (mapcar (function car) tree) (vla-copy (vlax-ename->vla-object e)) ) (setq s (ssadd)) (while (setq el (entnext el)) (ssadd el s) ) (setq el (entlast)) (vl-cmdf "_.JOIN" s "") (if (not (eq el (entlast))) (if (assoc 62 (setq enx (entget (entlast)))) (entupd (cdr (assoc -1 (entmod (subst (cons 62 q) (assoc 62 enx) enx))))) (entupd (cdr (assoc -1 (entmod (append enx (list (cons 62 q))))))) ) (if (assoc 62 (setq enx (entget (ssname s 0)))) (entupd (cdr (assoc -1 (entmod (subst (cons 62 q) (assoc 62 enx) enx))))) (entupd (cdr (assoc -1 (entmod (append enx (list (cons 62 q))))))) ) ) ) (setq cmd (getvar (quote cmdecho))) (setvar (quote cmdecho) 0) (if (= 8 (logand 8 (getvar (quote undoctl)))) (vl-cmdf "_.UNDO" "_E") ) (vl-cmdf "_.UNDO" "_G") (if (= 0 (getvar (quote worlducs))) (progn (vl-cmdf "_.UCS" "_W") (setq ucsf t) ) ) (if (setq bp (getpoint "\nPick or specify base point : ")) (progn (setq ss (ssget "_X" (list (cons 0 "*POLYLINE,LINE,ARC,SPLINE,ELLIPSE,HELIX") (cons 410 (if (= (getvar (quote cvport)) 1) (getvar (quote ctab)) "Model"))))) (repeat (setq i (sslength ss)) (setq e (ssname ss (setq i (1- i)))) (setq el (entlast)) (if e (cond ( (wcmatch (cdr (assoc 0 (entget e))) "*POLYLINE") (vl-cmdf "_.EXPLODE" e) (while (setq el (entnext el)) (vl-cmdf "_.PEDIT" el "") (setq elst (cons (if (and el (not (vlax-erased-p el)) (= (cdr (assoc 0 (entget el))) "LWPOLYLINE")) el (entlast)) elst)) ) ) ( (wcmatch (cdr (assoc 0 (entget e))) "LINE,ARC") (vl-cmdf "_.PEDIT" e "") (setq elst (cons (if (and e (not (vlax-erased-p e)) (= (cdr (assoc 0 (entget e))) "LWPOLYLINE")) e (entlast)) elst)) ) ( (wcmatch (cdr (assoc 0 (entget e))) "SPLINE,ELLIPSE,HELIX") (setq slst (cons e slst)) ) ) ) ) (setq lst (append elst slst)) (setq lst (mapcar (function (lambda ( x ) (list x (list (vlax-curve-getstartpoint x) (vlax-curve-getendpoint x))))) lst)) (setq e (car (vl-remove-if (function (lambda ( x ) (not (or (equal (trans bp 1 0) (caadr x) 1e-6) (equal (trans bp 1 0) (cadadr x) 1e-6))))) lst))) (setq e (list (car e) (if (equal (trans bp 1 0) (caadr e) 1e-6) (list (caadr e) (cadadr e)) (list (cadadr e) (caadr e))))) (setq tree (cons e tree)) (if (setq s (picknode e)) (process s e) ) (while (not (equal otree tree 1e-6)) (setq q (if (not q) 1 (1+ q))) (setq otree tree) (processtree) (maketree q) ) ) ) (*error* nil) ) Thanks marko_ribar. I find that the problem I am facing will have a lot of people also need it to shorten their working process. This LISP can help a lot of people once it is completed. I have studied many programming languages, but unfortunately to get started with the language of LISP I will need some more time to understand and use the programming language fluently. I came up with an algorithm to solve this problem but I can't implement it with LISP language. - Algorithm: 1. Here I will use all lines which are straight line type. 2. I will define each sub-branch on the mainline 3. Check the start and end points of each line to determine how many lines are in the same coordinates (intersection). From there we determine how many branches that intersection point has. 4. Define a unique start and end point, from which we get the start and end of each branch. 5. Duplicate intersection points are defined to find the path for the endpoint and base. 6. Determine the length through the sum of the lengths of the line segments that the polyline passes from the origin to the end. So can you or someone help me to complete this LISP? Thanks you very much. Drawing1.dwg Edited September 14, 2022 by HOang6893 Quote
Tsuky Posted September 14, 2022 Posted September 14, 2022 If you have lines, change before all lines in polylines (PEDIT Multiple), you can try this... PATH_LENGTH.lsp 1 1 Quote
HOang6893 Posted September 14, 2022 Author Posted September 14, 2022 24 minutes ago, Tsuky said: If you have lines, change before all lines in polylines (PEDIT Multiple), you can try this... PATH_LENGTH.lsp 11.21 kB · 1 download Thank you very much Tsuki. Your Lisp works perfectly. I hope others will find this post and find a solution to the problem of length mass statistics on the ground. Your Lisp will definitely help a lot of people. And right now it's me and my colleagues. Thank you !!! Quote
HOang6893 Posted September 14, 2022 Author Posted September 14, 2022 Video_2022-09-14_200735.wmv Video test Quote
marko_ribar Posted September 25, 2022 Posted September 25, 2022 (edited) Hi, here is my newer version for this kind of job... Regards, M.R. IDEA Network Topology-new-reza-all-lengths.dwg lengths_along_pipe_trees-Djikstra.lsp length_along_pipe_trees-Djikstra.lsp lengths_along_pipe_trees.lsp length_along_pipe_trees.lsp Edited October 4, 2022 by marko_ribar 2 Quote
marko_ribar Posted October 3, 2022 Posted October 3, 2022 Hi, @Tsuky This line : (setq lst_pt_ori (mapcar '(lambda (x) (trans x e_name 0)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget e_name))))) Should actually be : (setq lst_pt_ori (mapcar '(lambda (x) (trans (append x (list (cdr (assoc 38 (entget e_name))))) e_name 0)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget e_name))))) Watch this procedure with LWPOLYLINE in 3D random orientation to see where your mistake was... : (setq pl (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget (car (entsel)))))) Select entity: ((309.891999145573 122.498580705648) (264.933323771937 74.1796661002057) (315.368166401738 7.00581219180498) (372.810192377193 30.3384856741801) (512.820513041014 -23.4863237320238)) : (setq ple (mapcar '(lambda (x) (or ex (setq ex (entget (car (entsel))))) (append x (list (cdr (assoc 38 ex))))) pl)) Select entity: ((309.891999145573 122.498580705648 -45.829951430496) (264.933323771937 74.1796661002057 -45.829951430496) (315.368166401738 7.00581219180498 -45.829951430496) (372.810192377193 30.3384856741801 -45.829951430496) (512.820513041014 -23.4863237320238 -45.829951430496)) : (setq st (trans (car ple) (car (entsel)) 0)) Select entity: (274.278206553488 191.937921055429 32.7206009752506) : (vlax-curve-getstartpoint (car (entsel))) Select entity: (274.278206553488 191.937921055429 32.7206009752506) Quote
Tsuky Posted October 3, 2022 Posted October 3, 2022 Hi Marko, You're right, I forgot to address the possible elevation of lightweight polylines. Although I think it does not influence the result on the total length... Anyway I am completely reviewing the code (in my spare time) whether for this request or the iso-distances because I find the subject interesting. Indeed I realized that in a complex network; my code fails. The cause is that I exceed the number of allowed selection sets. So I plan to approach the problem from another angle by avoiding going through selection sets. If I get to my end (I don't know when!) I will follow up on these topics or create a new one. Quote
marko_ribar Posted October 3, 2022 Posted October 3, 2022 (edited) 19 hours ago, Tsuky said: Hi Marko, You're right, I forgot to address the possible elevation of lightweight polylines. Although I think it does not influence the result on the total length... Anyway I am completely reviewing the code (in my spare time) whether for this request or the iso-distances because I find the subject interesting. Indeed I realized that in a complex network; my code fails. The cause is that I exceed the number of allowed selection sets. So I plan to approach the problem from another angle by avoiding going through selection sets. If I get to my end (I don't know when!) I will follow up on these topics or create a new one. Look, there is no need to struggle too much... I've coded for this task and posted my revisions in my previous post... There is normal version and maybe better by using Djikstra algorithm incorporated into my main versions... Edited October 4, 2022 by marko_ribar Quote
christopher8642g Posted November 28 Posted November 28 On 9/14/2022 at 7:27 AM, HOang6893 said: Thanks marko_ribar. I find that the problem I am facing will have a lot of people also need it to shorten their working process. This LISP can help a lot of people once it is completed. I have studied many programming languages, but unfortunately to get started with the language of LISP I will need some more time to understand and use the programming language fluently. I came up with an algorithm to solve this problem but I can't implement it with LISP language. - Algorithm: 1. Here I will use all lines which are straight line type. 2. I will define each sub-branch on the mainline 3. Check the start and end points of each line to determine how many lines are in the same coordinates (intersection). From there we determine how many branches that intersection point has. 4. Define a unique start and end point, from which we get the start and end of each branch. 5. Duplicate intersection points are defined to find the path for the endpoint and base. 6. Determine the length through the sum of the lengths of the line segments that the polyline passes from the origin to the end. So can you or someone help me to complete this LISP drayage solutions company? Thanks you very much. Drawing1.dwg 83 kB · 13 downloads Thanks in advance to share informative topic Quote
BIGAL Posted November 28 Posted November 28 @marko_ribar this solution has existed in road stormwater drainage for years think 1990's I do not know the algorithm but the 1st step is draw the tree downhill. This gives a direction of all linework. The drainage software recognises each branch for design purposes. Quote
Recommended Posts
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.