问候
我想知道是否有办法在命令框中列出有多少单独的多段线，按线型分组：)
现在它加起来的长度，但我想计数。
(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)
)
(sslength SS)
返回实体数。所以只是：
(print (sslength SS))
之前
(setq aL '())
这将返回多边形线的名称、计数和总长度。我重新命名了这些变量，以便更好地理解它们所包含的内容。
(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