有def。连续的线条，我用我的自定义线型也试过了，但没有成功
抱歉，忘了提一下，这在设置为BYLAYER的行上不起作用-需要更多编码
但很快就打败了比尔 对于此项目，我的线将替代为特定线型。通常情况并非如此，但我的公司已经没有颜色了，我不得不修改一些新的颜色和笔设置，并获得上级的许可来更改所有这些。 对不起，我没有评论它的功能。我必须在这个周末或星期一去上班，这一天就快结束了。
(defun c:lte (/ drac ltype ltlst xlSheets leng pline row ss sumlen total x xlApp xlBook xlBooks xlCells xlSheet)
(vl-load-com)
(setq xlApp (vlax-get-or-create-object "Excel.Application")
xlBooks(vlax-get-property xlApp "Workbooks")
xlBook (vlax-invoke-method xlBooks "Add")
xlSheets (vlax-get-property xlBook "Sheets")
xlSheet (vlax-get-property xlSheets "Item" 1)
xlCells (vlax-get-property xlSheet "Cells")
)
(vla-put-visible xlApp :vlax-true)
(vlax-put-property xlCells "Item" 1 1 "Linetype")
(vlax-put-property xlCells "Item" 1 2 "Length")
(setq ltlst (list (cdr (assoc 2 (tblnext "Ltype" t)))))
(while (setq ltynm (tblnext "Ltype"))
(setq ltlst (append (list (cdr (assoc 2 ltynm)))ltlst))
)
(setq row 2
total 0)
(repeat (length ltlst)
(setq ltype (car ltlst))
(if (setq ss (ssget "_X" (list (cons 0 "*LINE")(cons 6 ltype))))
(progn
(setq drac -1 sumlen 0)
(repeat (sslength ss)
(setq pline (vlax-ename->vla-object (ssname ss (setq drac (1+ drac)))))
(setq leng(vlax-curve-getdistatparam pline
(vlax-curve-getendparam pline)))
(setq sumlen (+ sumlen leng)))
(vlax-put-property xlCells "Item" row 1 ltype)
(vlax-put-property xlCells "Item" row 2 (rtos sumlen 2 3))
(setq total (+ total sumlen))
(setq ltlst (cdr ltlst))
(setq row (+ row 1))
)))
(setq row (+ row 1))
(vlax-put-property xlCells "Item" row 1 "Total:")
(vlax-put-property xlCells "Item" row 2 (rtos total 2 3))
(mapcar (function (lambda(x)
(vl-catch-all-apply
(function (lambda()
(progn
(vlax-release-object x)
(setq x nil)))))))
(list xlCells xlSheet xlSheets xlBook xlBooks xlApp)
)
(alert "Close Excel file manually")
(gc)(gc)
(princ)
)
我也没有做我的，所以它会得到'bylayer'的线型
哈哈，你真的赢了我。。。一旦我看到你的，我改变了我的编码很多，所以它是不一样的。。。（我拿出地图车） 比尔，你的只处理未设置为BYLAYER的行是吗？
此外，它将拾取所有*多段线和直线-我不确定OP是否只需要直线。。
无论如何，这应该处理设置为BYLAYER的*行：
{Some funky ss filter…}
(defun c:ltlen (/ ldef lt tdef ss len laylst)
(vl-load-com)
(setq laylst "")
(setq ldef (cdr (assoc 2 (tblnext "LTYPE" T))))
(while
(progn
(setq lt
(getstring t
(strcat "\nSpecify Linetype <" ldef ">: ")))
(cond ((eq "" lt) (setq lt (strcase ldef)) nil)
((not (snvalid lt))
(princ "\n** Linetype Name Not Valid **"))
((not (tblsearch "LTYPE" lt))
(princ "\n** Linetype Not Found in Drawing **"))
(t (setq lt (strcase lt)) nil))))
(while (setq tdef (tblnext "LAYER" (not tdef)))
(if (eq lt (strcase (cdr (assoc 6 tdef))))
(setq laylst
(strcat (cdr (assoc 2 tdef)) (chr 44) laylst))))
(setq laylst (vl-string-right-trim (chr 44) laylst))
(if (setq ss (ssget "_X" (list (cons 0 "*LINE")
(cons -4 "<OR")(cons 6 lt) (cons -4 "<AND")
(cons -4 "<NOT") (cons 6 "*") (cons -4 "NOT>")
(cons 8 laylst) (cons -4 "AND>") (cons -4 "OR>"))))
(progn
(setq len
(apply '+
(mapcar
(function
(lambda (x)
(vla-get-Length x)))
(mapcar 'vlax-ename->vla-object
(mapcar 'cadr (ssnamex ss))))))
(princ (strcat "\n<< Total Length of " (rtos (sslength ss) 2 0)
" Lines is: " (rtos len 2 2))))
(princ (strcat "\n<< No Lines Found With Linetype " lt " >>")))
(princ))
啊，这不公平。。我不知道如何使用（缺点4）尚未。。。你的代码对我来说太快了。如果有机会的话，我会在这个周末的某个时候超过你的 哦，说到哪一个（缺点4）上有好帖子？ 这些太棒了！他们都做得很好
我知道我之前说过我希望它在excel中，但有没有办法把它也放在autocad的表格中？在对这个问题进行更多思考之后，最终这将变得更容易。李如果你把几种线型的值放在一个表中，那将是绝对完美的。我想很多人都可以用它来节省很多时间。
再次感谢你们的辛勤工作，他们真的很棒！！！ ss过滤器中的-4代码实际上并不难掌握tbh，即使你应该也能理解
简单地说，它就像过滤器中的条件一样工作：
因此：
(list (cons 0 "CIRCLE")
(cons -4 "<OR") (cons 40 5) (cons 8 "0") (cons -4 "OR>"))
表示层“0”上的所有圆或半径为5的所有圆（或两者都包含在内，使用异或表示非包含性）。
只需将术语附在“-4个列表中，如图所示。
页:
1
[2]