低版本CAD，计算线段总长源码修改
;;对于R14;;所选行的总长度
;;LL将选定图层上所有对象的长度求和。
;;OLL将所选对象的长度求和。
;;两者都将输出打印到命令行，给出不同的长度
;;层以及总数。
(defun C:LL (/)
(setq cmdecho (getvar 'cmdecho))
(setvar 'cmdecho 0)
(LL:OUTPUT "X" "\n在图层上选择对象以总计...")
(setvar 'cmdecho cmdecho)
(princ)
)
(defun C:OLL (/)
(setq cmdecho (getvar 'cmdecho))
(setvar 'cmdecho 0)
(LL:OUTPUT "P" "\n选择对象来总计...")
(setvar 'cmdecho cmdecho)
(princ)
)
(defun LL:OUTPUT (LL:SSTYPE LL:PROMPT /
LL:SS I LL:ENAME
LL:ELIST LL:LAYER LL:LAYERLIST
LL:TOTALLENGTH LL:LAYERLENGTH LL:ARCDELTA
LL:OBJLENGTH LL:SST LL:SSX
)
(setq LL:LAYERLIST NIL)
(if (setq LL:SS
(ssget
'((0 . "ARC,CIRCLE,ELLIPSE,LINE,*POLYLINE,REGION,SPLINE"))
)
)
(progn
(repeat (setq I (sslength LL:SS))
(setq LL:ELIST (entget (ssname LL:SS (setq I (1- I)))))
(if (not (member (setq LL:LAYER (cdr (assoc 8 LL:ELIST)))
LL:LAYERLIST
)
)
(setq LL:LAYERLIST (append LL:LAYERLIST (list LL:LAYER)))
)
)
(setq LL:TOTALLENGTH 0)
(setq LL:SST 0)
(foreach X LL:LAYERLIST
(setq LL:LAYERLENGTH 0)
(setq LL:SS
(ssget
LL:SSTYPE
(list
(cons 0 "ARC,CIRCLE,ELLIPSE,LINE,*POLYLINE,REGION,SPLINE")
(cons 8 X)
)
)
)
(repeat (setq I (sslength LL:SS))
(setq LL:ENAME (ssname LL:SS (setq I (1- I))))
(setq LL:ELIST (entget LL:ENAME))
(cond
((eq (cdr (assoc 0 LL:ELIST)) "ARC")
(if
(> (cdr (assoc 50 LL:ELIST)) (cdr (assoc 51 LL:ELIST)))
(setq LL:ARCDELTA
(+ (abs (- (cdr (assoc 50 LL:ELIST))
(* 2.0 pi)
)
)
(cdr (assoc 51 LL:ELIST))
)
)
(setq LL:ARCDELTA
(- (cdr (assoc 51 LL:ELIST))
(cdr (assoc 50 LL:ELIST))
)
)
)
(setq LL:OBJLENGTH
(* (cdr (assoc 40 LL:ELIST)) LL:ARCDELTA)
)
)
((eq (cdr (assoc 0 LL:ELIST)) "LINE")
(setq LL:OBJLENGTH
(distance (cdr (assoc 10 LL:ELIST))
(cdr (assoc 11 LL:ELIST))
)
)
)
((wcmatch (cdr (assoc 0 LL:ELIST))
"*POLYLINE,CIRCLE,ELLIPSE,REGION,SPLINE"
)
(vl-cmdf "._area" "o" LL:ENAME)
(setq LL:OBJLENGTH (getvar "perimeter"))
)
)
(setq LL:LAYERLENGTH (+ LL:LAYERLENGTH LL:OBJLENGTH))
(setq LL:SSX (rtos (sslength LL:SS) 2 1))
)
(setq LL:PROMPT (strcat"【" X "】""图层中的线总长度: "
(rtos (/ LL:LAYERLENGTH 1e3) 2 3)
"m"
)
)
(prompt (strcat "\n" "【" X "】" "图层中线的数量为: "
LL:SSX
"个"
"\n" LL:PROMPT
)
)
(setq LL:SST (+ LL:SST (atof LL:SSX)))
(prompt "\n\r yuyuyu")
(setq LL:TOTALLENGTH (+ LL:TOTALLENGTH LL:LAYERLENGTH))
(prompt "\n\r ikikik")
)
(setq LL:PROMPT (strcat "所有的线总长度: "
(rtos (/ LL:TOTALLENGTH 1e3) 2 3)
"m"
)
)
(prompt (strcat "\n所有线的数量为: "
(rtos LL:SST 2 1)
"个"
"\n" LL:PROMPT
)
)
)
)
)代码来之明经后修改是用来给低版本CAD，计算线段总长，按图层分类统计，现在oll命令有点问题，只能统计最后选中的一个图层的线段长度
本帖最后由 不一样地设计 于 2023-8-14 15:24 编辑
ssyfeng 发表于 2023-8-14 15:18
简单方法你就把原先的LL:OUTPUT函数改个名称，再放到我这个文件里，用新函数名替换掉LL命令里的LL:OUTPUT函 ...
嗯，我试试，还请教一个问题，代码中调用了area命令，计算有宽度的多段线的时候，怎么屏蔽这个《面积计算中忽略多段线的宽度。》提示 本帖最后由 lee50310 于 2023-8-14 13:19 编辑
線長計算器
https://www.cadtutor.net/forum/t ... -length-calculator/
by lee-mac(李麥克)
該程序將使用可選的過濾器計算直線/多段線/LWPolylines/圓弧/橢圓/圓/樣條線的總長度。 過濾器可用於僅選擇特定圖層上的線，或者可能具有特定線型或顏色的線。
lee50310 发表于 2023-8-14 13:17
線長計算器
https://www.cadtutor.net/forum/t ... -length-calculator/
by lee-mac(李麥克)
感谢大佬提供工具，我这个CAD版本不支持vla函数库，也不支持dcl，只能用低版本的alisp！
补充一下oll命令在多图层时错误的动图
有大佬知道area命令，计算多段线的时候，怎么屏蔽这个《面积计算中忽略多段线的宽度。》提示 上面的代码基本是可以使用，就是计算所选线段为多个图层的时候，不能运行，单一图层可以，或者计算多个图层所有的线段总长也可以 本帖最后由 ssyfeng 于 2023-8-14 15:05 编辑
平果电脑限制比较多，感觉不太适合专业办公用
应该是这个效果：
ssyfeng 发表于 2023-8-14 14:59
平果电脑限制比较多，感觉不太适合专业办公用
应该是这个效果：
是的，就是这个效果，请问是哪里出问题，怎么也改不对 附件上传在7楼，问题出在选择集处理那里。 ssyfeng 发表于 2023-8-14 14:59
平果电脑限制比较多，感觉不太适合专业办公用
应该是这个效果：
是的，系统限制很多，平时画图不多，主要是看看图，核对一下简单工程量