How to modify this AutoLISP code to count how many polylines are there grouped by the linetype?

user_16288417 0
Viewed 109

Greetings!

I would like to know if there is a way to list in the command box how many separate polylines are there, grouped by their linetype :)

Now it adds up the length but i would like the count.

(defun C:Csőhossz_számoló ( / SS aL i e itm ltp b ) 
 (if
   (setq SS
     (ssget "_:L-I" 
       '((0 . "*POLYLINE")
         (-4 . "<NOT")
         (-4 . "<AND")
         (0 . "POLYLINE")
         (-4 . "&")
         (70 . 80)
         (-4 . "AND>")
         (-4 . "NOT>")
       )
     )
   )
   (progn
     (setq aL '())
     (repeat (setq i (sslength SS))
       (setq e (ssname SS (setq i (1- i))))
       (setq itm
         (cons
           (setq ltp (cond ( (cdr (assoc 6 (entget e))) ) ( "ByLayer" ) ))
           (+ (vlax-curve-getDistAtParam e 
                    (vlax-curve-getEndParam e)) 
              (setq b (cond ( (cdr (assoc ltp aL)) ) (0.))))
         )
       )
       (if (zerop b)
         (setq aL (cons itm aL))
         (setq aL (subst itm (assoc (car itm) aL) aL))
       )
     )
     (princ "\n============\n")
     (foreach x (vl-sort aL ''((a b) (apply '< (mapcar 'car (list a b)))) )
       (princ (car x)) (princ " : ") (princ (rtos (cdr x) 2 4))
       (princ "\n")
     )
     (princ "============")
     (textscr)
   )
 )
 (princ)
)
autocad autolisp grouping lisp
2 Answers
(sslength SS)

returns number of entities. so just:

(print (sslength SS))

before

(setq aL '())
user_57965260

This will return the poly lines' name, count, and total length. I renamed the variables to better understand what they were holding.

(defun C:fcnSolution ( / ;-----------------------------; Inputs
        SelectionSet iItr1 eEntity rLength bTrue ;-----; Miscellaneous
        lDottedPair lLength lAllLengths lLineTypes ;---; Lists 1
        lNewLT lNewLTs lExsistingLT lUpdateLT ;--------; Lists 2
        sHandle sLineType sExsistingLT sLength ;-------; Strings
        );local variables
    (if
        ;; Condition - Collects only poly lines from selected objects
        (setq SelectionSet
            (ssget "_:L-I" 
            '((0 . "*POLYLINE")
                (-4 . "<NOT")
                (-4 . "<AND")
                (0 . "POLYLINE")
                (-4 . "&")
                (70 . 80)
                (-4 . "AND>")
                (-4 . "NOT>")
            );list
            );ssget
        );setq

        ;; Condition True
       (progn ;true
            ;;  Creating list variables
            (setq lAllLengths '())
            (setq lLineTypes (list))

            ;; Each filtered, selected item
            (repeat (setq iItr1 (sslength SelectionSet))
                
                ;; Building dotted pair
                (setq iItr1 (1- iItr1))
                (setq eEntity (ssname SelectionSet iItr1));--------------------------; Entity's unique name
                (setq sLineType (cdr (assoc 0 (entget eEntity))));-------------------; Name of the line type
                (setq sHandle (cond ((cdr (assoc 6 (entget eEntity))) ) (sLineType))); Handle's name
                (setq rLength (cond ((cdr (assoc sHandle lAllLengths))) (0.)));------; Length of the Polyline
                (setq lDottedPair (cons sHandle (+ (vlax-curve-getDistAtParam eEntity (vlax-curve-getEndParam eEntity)) rLength)))
                
                ;; Total length of the combined line types per line type
                (if (zerop rLength)
                    (setq lAllLengths (cons lDottedPair lAllLengths))
                    (setq lAllLengths (subst lDottedPair (assoc (car lDottedPair) lAllLengths) lAllLengths))
                );if

                ;; Counts line types
                (setq bTrue T)
                (setq lNewLTs (list))
                (foreach lExsistingLT lLineTypes
                    (setq sExsistingLT (car lExsistingLT)); Pulls first item from list (string variable)
                    (if (and (= sExsistingLT sLineType) bTrue); Updating exsisting line type
                        ;; True - Updating exsisting line type
                        (progn
                            (setq lUpdateLT (cons sExsistingLT (1+ (cdr lExsistingLT))))
                            (setq lNewLTs (cons lUpdateLT lNewLTs))
                            (setq bTrue nil)
                        );progn
                        ;; False - No change
                        (setq lNewLTs (cons lExsistingLT lNewLTs))
                    );if
                );foreach
                (if bTrue (setq lNewLTs (cons (cons sLineType 1) lLineTypes))); New Line Type
                (setq lLineTypes lNewLTs)
            );repeat

            ;; Printing Line types
            (princ "\n============\n")
            (foreach lExsistingLT lLineTypes
                
                ;; Related length
                (foreach lLength lAllLengths
                    (if (= (car lExsistingLT)(car lLength))
                        (setq sLength (rtos (cdr lLength) 2 4))
                    );if
                );foreach

                ;; Printing Results
                (princ (strcat (car lExsistingLT) " : " (itoa (cdr lExsistingLT))));------; Line type and count
                (princ (strcat " : " sLength))(terpri)
            );foreach
            (princ "\n============\n")
            (textscr)
        );progn - true
    );if
    (princ)
);C:fcnSolution
user_85439480
Related