低版本CAD，计算线段总长源码修改

不一样地设计 · 发表于 2023-8-14 10:36:21

;;对于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
)
)
)
)
)

;;对于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:21:33

本帖最后由不一样地设计于 2023-8-14 15:24 编辑

ssyfeng 发表于 2023-8-14 15:18
简单方法你就把原先的LL:OUTPUT函数改个名称，再放到我这个文件里，用新函数名替换掉LL命令里的LL:OUTPUT函 ...

嗯，我试试，还请教一个问题，代码中调用了area命令，计算有宽度的多段线的时候，怎么屏蔽这个《面积计算中忽略多段线的宽度。》提示

lee50310 · 发表于 2023-8-14 13:17:02

本帖最后由 lee50310 于 2023-8-14 13:19 编辑

線長計算器
https://www.cadtutor.net/forum/t ... -length-calculator/
by lee-mac(李麥克)

該程序將使用可選的過濾器計算直線/多段線/LWPolylines/圓弧/橢圓/圓/樣條線的總長度。

過濾器可用於僅選擇特定圖層上的線，或者可能具有特定線型或顏色的線。

不一样地设计 · 发表于 2023-8-14 13:23:52

lee50310 发表于 2023-8-14 13:17
線長計算器
https://www.cadtutor.net/forum/t ... -length-calculator/
by lee-mac(李麥克)

感谢大佬提供工具，我这个CAD版本不支持vla函数库，也不支持dcl，只能用低版本的alisp！

不一样地设计 · 发表于 2023-8-14 11:18:46

补充一下oll命令在多图层时错误的动图

不一样地设计 · 发表于 2023-8-14 11:23:04

有大佬知道area命令，计算多段线的时候，怎么屏蔽这个《面积计算中忽略多段线的宽度。》提示

不一样地设计 · 发表于 2023-8-14 13:27:27

上面的代码基本是可以使用，就是计算所选线段为多个图层的时候，不能运行，单一图层可以，或者计算多个图层所有的线段总长也可以

ssyfeng · 发表于 2023-8-14 14:59:26

本帖最后由 ssyfeng 于 2023-8-14 15:05 编辑

平果电脑限制比较多，感觉不太适合专业办公用
应该是这个效果：

不一样地设计 · 发表于 2023-8-14 15:03:53

ssyfeng 发表于 2023-8-14 14:59
平果电脑限制比较多，感觉不太适合专业办公用
应该是这个效果：

是的，就是这个效果

，请问是哪里出问题，怎么也改不对

ssyfeng · 发表于 2023-8-14 15:06:33

附件上传在7楼，问题出在选择集处理那里。

不一样地设计 · 发表于 2023-8-14 15:07:53

ssyfeng 发表于 2023-8-14 14:59
平果电脑限制比较多，感觉不太适合专业办公用
应该是这个效果：

是的，系统限制很多，平时画图不多，主要是看看图，核对一下简单工程量

账号		自动登录	找回密码
密码			注册

低版本CAD，计算线段总长源码修改

本帖子中包含更多资源

本帖子中包含更多资源

评分

本帖子中包含更多资源

本帖子中包含更多资源

本帖子中包含更多资源