Leaderboard

Take a few minutes and look on that page http://www.lee-mac.com Click on GENERAL in the left margin, then look for POINT MANAGER.

Assuming a MULTILEADER, query DXF group 2 of the DXF data associated with the last DXF group 342 entity, e.g.: (cdr (assoc 2 (entget (cdr (assoc 342 (reverse (entget <leader>)))))))

Sorting is inefficient when only an extremum is required. You may find existing functions covering this operation here and a function specific to finding the minimum/maximum Z-coordinate here.

Try this. I've altered the lisp slightly as your didn't need to store everything as a list of lists, just a list. The list is built using the cons function not append as this is quicker but means you have to reverse the final list to end up with the correct order. As a single list it also makes it easier to sort and extract the max & min length. (defun c:Test (/ T_Entity T_Object T_Start T_End T_SegmentLengths T_Count) (if (and (setq T_Entity (car (entsel "\nSelect polyline: "))) (= (vla-get-ObjectName (setq T_Object (vlax-ename->vla-object T_Entity))) "AcDbPolyline") ) (progn (setq T_Start (vlax-curve-getStartParam T_Object)) (setq T_End (vlax-curve-getEndParam T_Object)) (while (< T_Start T_End) (setq T_SegmentLengths (cons (- (vlax-curve-getDistAtParam T_Object (setq T_Start (1+ T_Start))) (vlax-curve-getDistAtParam T_Object (1- T_Start))) T_SegmentLengths)) ) (setq T_Count 0) (foreach T_Item (reverse T_SegmentLengths) (princ (strcat "\nSegment " (itoa (setq T_Count (1+ T_Count))) ": " (rtos T_Item (getvar "LUNITS") 6))) ) (princ (strcat "\n\n ** Minimum Segment length is " (rtos (car (vl-sort T_SegmentLengths '<)) (getvar "LUNITS") 6))) (princ (strcat "\n\n ** Maximum Segment length is " (rtos (car (vl-sort T_SegmentLengths '>)) (getvar "LUNITS") 6))) (princ (strcat "\n\n ** Average Segment length is " (rtos (/ (vla-get-Length T_Object) T_Count) (getvar "LUNITS") 6))) (princ (strcat "\n\n ** Total polyline length is " (rtos (vla-get-Length T_Object) (getvar "LUNITS") 6))) ) (princ "\n ** Nothing selected or not a polyline.") ) (princ) )

It's not a block. It's a solid. It's more or less (type in Autocad): SOLID => 0,0 =>1,0 => 0.5,3 => Enter

You can sort a list on the z value caddr. look at 1st entry and last ;sort on x (setq lst (vl-sort co-ordsxy (function (lambda (e1 e2) (< (car e1) (car e2))) ) ) ) ;sort on z (setq lst (vl-sort co-ordsxy (function (lambda (e1 e2) (< (caddr e1) (caddr e2))) ) ) ) (setq minz (nth 0 lst)) (setq maxz (nth (- (length lst) 1) lst))

Try This (defun c:test (/ sel int ent str end hcol ss) (while t (setq ss (ssget "_:L" (list '(0 . "TEXT")))) (progn (setq idx 0) (repeat (sslength ss) (setq ent (ssname ss idx)) (setq hcol (cdr (assoc 62 (entget ent)))) (if (setq int -1 sel (ssget "_:S" '((0 . "LINE"))) ) ;_ end of setq (while (setq ent (ssname sel (setq int (1+ int)))) (setq str (cdr (assoc 10 (entget ent))) end (cdr (assoc 11 (entget ent))) ) ;_ end of setq (entmake (list '(0 . "CIRCLE") (cons 10 (mapcar '(lambda (q p) (* (+ q p) 0.5)) str end)) (cons 40 (/ (distance str end) 2.)) (cons 62 hcol) ) ;_ end of list ) ;_ end of entmake ) ;_ end of while ) ;_ end of if (setq idx (1+ idx)) ) ;_ end of repeat ) ;_ end of progn ) ;_ end of While (princ) ) ;_ end of defun ;|«Visual LISP© Format Options» (100 1 2 2 T "end of " 100 9 1 1 1 T T nil T) ;*** DO NOT add text below the comment! ***|;

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