求助，需要一个多功能的LISP代码

horihons

先说需求：
我需要测量多种线段（CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE,ARC）的长度，输出总根数、总长度，并列出计算式，复制到剪贴板中，同时可以标记到CAD图纸上。
比如：

总共选中：2根线
总长度是：84511.22
计算公式(已复制并标记到图中)：38776.47+45734.75

CAD效果类似如下图：

我找到了部分类似的LSP，不过都是单一功能，比如只能输出总根数总长度列出计算式，但不能复制到剪贴板和标记到CAD上。有的能标记，但却不能输出和复制。我很想靠自己的能力编写一个LSP，但是发现太难了，特别是对于我这个建筑专业的人来说，而且大学英语还是混过来的，根本不懂编程。
因此特来此处求救！还望各位大大帮帮忙！不甚感激！！

liunian0524

论坛也有,搜索即可

75215195

1. (defun C:XCC (/ lst ss i en ent str ll sstr ist tmp len n prtxt pt)
   
2.   (vl-load-com)
   
3.   (setvar "cmdecho" 0)
   
4.   (princ "\n请选取要统计的对象...")
   
5.   (setq        LST '(("LINE" "直线")
   
6.               ("ARC" "圆弧")
   
7.               ("CIRCLE" "圆" )
   
8.               ("LPOLYLINE" "多段线")
   
9.               ("ELLIPSE" "椭圆")
   
10.               ("SPLINE" "样条线")
    
11.              )
    
12.   )
    
13.   (if (setq SS (ssget '((0 . "LINE,ARC,CIRCLE,LPOLYLINE,ELLIPSE,SPLINE"))))
    
14.     (progn
    
15.       (setq I 0)
    
16.       (repeat (sslength SS)
    
17.         (setq EN  (ssname SS I)
    
18.               ENT (entget EN)
    
19.               STR (cdr (assoc 0 ENT))
    
20.               pt  (cdr (assoc 10 ENT))
    
21.               pt  (mapcar '+ pt '(+1 +2 0))
    
22.         )
    
23.         (if (setq TMP (assoc STR LST))
    
24.           (setq        LEN (vlax-curve-getdistatparam
    
25.                       EN
    
26.                       (vlax-curve-getendparam EN)
    
27.                     )
    
28.                 LST (subst (append TMP (list LEN)) TMP LST)
    
29.           )
    
30.         )
    
31.         (cond
    
32.           ((= str "LINE")
    
33.            (command "TEXT" PT 5 0 (cadar lst)))
    
34.           ((= str "ARC")
    
35.            (command "TEXT" PT 5 0 (cadadr lst)))
    
36.           ((= str "CIRCLE")
    
37.            (command "TEXT" PT 5 0 (cadr (nth 2 lst))))
    
38.           ((= str "LPOLYLINE")
    
39.            (command "TEXT" PT 5 0 (cadr (nth 3 lst))))
    
40.           ((= str "ELLIPSE")
    
41.            (command "TEXT" PT 5 0 (cadr (nth 4 lst))))
    
42.           ((= str "SPLINE")
    
43.            (command "TEXT" PT 5 0 (cadr (nth 5 lst))))
    
44.           )
    
45.         (setq I (1+ I))
    
46.       )
    
47.       ;;2.显示
    
48.       (setq PRTXT
    
49.              "线条长度分类统计如下:\n\n类型\t根数\t长度\n---------------------------"
    
50.       )
    
51.       (foreach N LST
    
52.         (if (> (length N) 2)
    
53.           (progn
    
54.           (setq        LEN (apply '+ (cddr N)))
    
55.           (setq        sstr "")
    
56.           (setq        ist (cddr N))
    
57.           (setq        ll (length IST))
    
58.           (repeat (1- ll)
    
59.                 (setq txt (rtos (car ist) 2 3))
    
60.                 (setq sstr (strcat txt "+" sstr))
    
61.                 (setq ist (cdr ist))
    
62.            )
    
63.           (setq PRTXT (strcat PRTXT
    
64.                               "\n"
    
65.                               (cadr N)
    
66.                               "\t"
    
67.                               (itoa (- (length N) 2))
    
68.                               "\t"
    
69.                               (rtos LEN 2 3)
    
70.                               "  计算公式: "
    
71.                               sstr
    
72.                               (rtos (last ist) 2 3)
    
73.                       )
    
74.           )
    
75.           (prin1)
    
76.         )
    
77.           )
    
78.       )
    
79.       (setq
    
80.         PRTXT
    
81.          (strcat
    
82.            PRTXT
    
83.            "\n\n总数:"
    
84.            (itoa (- (length (apply 'append LST))
    
85.                     (* 2 (length LST))
    
86.                  )
    
87.            )
    
88.            "  总长度:"
    
89.            (rtos (apply        '+
    
90.                         (apply 'append (mapcar 'cddr LST))
    
91.                  )
    
92.                  2
    
93.                  3
    
94.            )
    
95.          )
    
96.       )
    
97.       (copy->Clipboard prtxt)
    
98.       (command "_pasteclip" PAUSE)
    
99.       (command "_.EXPLODE" (entlast))
    
100.     )
     
101.   )
     
102.   (PRINC)
     
103. )
     
104. (defun copy->Clipboard (STR / HTML RESULT)
     
105.   (and (= (type STR) 'STR)
     
106.        (setq HTML (vlax-create-object "htmlfile"))
     
107.        (setq RESULT (vlax-invoke
     
108.                       (vlax-get        (vlax-get HTML 'PARENTWINDOW)
     
109.                                 'CLIPBOARDDATA
     
110.                       )
     
111.                       'SETDATA
     
112.                       "Text"
     
113.                       STR
     
114.                     )
     
115.        )
     
116.        (vlax-release-object HTML)
     
117.   )
     
118. )
     
119. 
     

(defun C:XCC (/ lst ss i en ent str ll sstr ist tmp len n prtxt pt)<br />   (vl-load-com)<br />   (setvar "cmdecho" 0)<br />   (princ "\n请选取要统计的对象...")<br />   (setq        LST '(("LINE" "直线")<br />               ("ARC" "圆弧")<br />               ("CIRCLE" "圆" )<br />               ("LPOLYLINE" "多段线")<br />               ("ELLIPSE" "椭圆")<br />               ("SPLINE" "样条线")<br />              )<br />   )<br />   (if (setq SS (ssget '((0 . "LINE,ARC,CIRCLE,LPOLYLINE,ELLIPSE,SPLINE"))))<br />     (progn<br />       (setq I 0)<br />       (repeat (sslength SS)<br />         (setq EN  (ssname SS I)<br />               ENT (entget EN)<br />               STR (cdr (assoc 0 ENT))<br />               pt  (cdr (assoc 10 ENT))<br />               pt  (mapcar '+ pt '(+1 +2 0))<br />         )<br />         (if (setq TMP (assoc STR LST))<br />           (setq        LEN (vlax-curve-getdistatparam<br />                       EN<br />                       (vlax-curve-getendparam EN)<br />                     )<br />                 LST (subst (append TMP (list LEN)) TMP LST)<br />           )<br />         )<br />         (cond<br />           ((= str "LINE")<br />            (command "TEXT" PT 5 0 (cadar lst)))<br />           ((= str "ARC")<br />            (command "TEXT" PT 5 0 (cadadr lst)))<br />           ((= str "CIRCLE")<br />            (command "TEXT" PT 5 0 (cadr (nth 2 lst))))<br />           ((= str "LPOLYLINE")<br />            (command "TEXT" PT 5 0 (cadr (nth 3 lst))))<br />           ((= str "ELLIPSE")<br />            (command "TEXT" PT 5 0 (cadr (nth 4 lst))))<br />           ((= str "SPLINE")<br />            (command "TEXT" PT 5 0 (cadr (nth 5 lst))))<br />           )<br />         (setq I (1+ I))<br />       )<br />       ;;2.显示<br />       (setq PRTXT<br />              "线条长度分类统计如下:\n\n类型\t根数\t长度\n---------------------------"<br />       )<br />       (foreach N LST<br />         (if (> (length N) 2)<br />           (progn<br />           (setq        LEN (apply '+ (cddr N)))<br />           (setq        sstr "")<br />           (setq        ist (cddr N))<br />           (setq        ll (length IST))<br />           (repeat (1- ll)<br />                 (setq txt (rtos (car ist) 2 3))<br />                 (setq sstr (strcat txt "+" sstr))<br />                 (setq ist (cdr ist))<br />            )<br />           (setq PRTXT (strcat PRTXT<br />                               "\n"<br />                               (cadr N)<br />                               "\t"<br />                               (itoa (- (length N) 2))<br />                               "\t"<br />                               (rtos LEN 2 3)<br />                               "  计算公式: "<br />                               sstr<br />                               (rtos (last ist) 2 3)<br />                       )<br />           )<br />           (prin1)<br />         )<br />           )<br />       )<br />       (setq<br />         PRTXT<br />          (strcat<br />            PRTXT<br />            "\n\n总数:"<br />            (itoa (- (length (apply 'append LST))<br />                     (* 2 (length LST))<br />                  )<br />            )<br />            "  总长度:"<br />            (rtos (apply        '+<br />                         (apply 'append (mapcar 'cddr LST))<br />                  )<br />                  2<br />                  3<br />            )<br />          )<br />       )<br />       (copy->Clipboard prtxt)<br />       (command "_pasteclip" PAUSE)<br />       (command "_.EXPLODE" (entlast))<br />     )<br />   )<br />   (PRINC)<br /> )<br /> (defun copy->Clipboard (STR / HTML RESULT)<br />   (and (= (type STR) 'STR)<br />        (setq HTML (vlax-create-object "htmlfile"))<br />        (setq RESULT (vlax-invoke<br />                       (vlax-get        (vlax-get HTML 'PARENTWINDOW)<br />                                 'CLIPBOARDDATA<br />                       )<br />                       'SETDATA<br />                       "Text"<br />                       STR<br />                     )<br />        )<br />        (vlax-release-object HTML)<br />   )<br /> )<br /> <br />

你参考参考，自己修改。

horihons

75215195 发表于 2017-9-27 19:02

看效果就感觉很棒！！我先试试！！

horihons

75215195 发表于 2017-9-27 19:02

大神您好！

我测试了一下。
在纯CAD（系统只安装了CAD未安装天正）情况下，是可以正常使用的，但多段线（多段线是指用PLINE命令画出来的线。我试着将代码中的LPOLYLINE替换成PLINE也不行）无法测量，也无法选中。


另外，在系统安装了天正，打开天正之后，无法正常使用，具体表现为：可以选取线，但不能统计，不能标记到图上，标记到图上的时候，会把剪贴板上的内容标记上，比如我复制了一段文字“世界人民”，那么在选取线、标记到图上，会把“世界人民”标记到图上。如果剪贴板上没有内容（我清空了之后），在选取线、标记到图上，没有标记任何内容。
提示栏是这样的内容：

命令: XCC
请选取要统计的对象...
选择对象: 指定对角点: 找到 7 个
选择对象:

而在系统装了天正，但不用天正打开CAD，纯粹使用CAD打开，也是和上面一样的不能统计和标记。

不知道我说得够不够清楚，如果不清楚，能否麻烦大神加个扣扣？好解决些。。拜托了！！

另外，还想加个功能，想把矩形和多边形也纳入统计，对于圆形、椭圆、矩形、多边形的统计内容为周长和面积。
而显示出来的效果和我原来预想的要好看许多！！不过细节部分有些差别，包括复制公式。大神做出来的效果很好，按照大神做出来的效果，结合我的想法，我希望标记的是这样的效果：

线条长度分类统计如下:
类型        根数         长度
---------------------------
直线        4          5710.871  计算公式: 715.8274+1406.9687+1813.9152+1774.1597
圆弧        1          807.497  计算公式: 807.4969
圆        1          1152.436  计算公式: 1152.4363
样条线        1           1177.162  计算公式: 1177.1619
矩形    1   周长：1653.9766     面积：170856.3108
圆形    1   周长：175.2689      面积：2444.5545
测量根数:8  
---------------------------
合计长度:10677.2116
计算过程:
715.8274+1406.9687+1813.9152+1774.1597+807.4969+1152.4363+1177.1619+1653.9766+175.2689
---------------------------
合计面积：173300.8653
计算过程：
170856.3108+2444.5545

而我想复制到剪贴板的就只是长度的计算过程，比如上面效果中的“715.8274+1406.9687+1813.9152+1774.1597+807.4969+1152.4363+1177.1619+1653.9766+175.2689”这一计算式。
之所以把“计算过程:”和计算式分两行显示，是方便后面如果需要重新复制我可以直接编辑然后复制，如果“计算过程”和计算式同一行显示，点了编辑之后还要把“计算过程：”去掉才行。

大神！！拜托了！！

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:效果.txt 
下载次数:1  文件大小:605 Bytes 
下载权限: 不限 以上  [免费赚D豆]

horihons

75215195 发表于 2017-9-27 19:02

补充一下：之所以要用天正，是因为在建筑行业很多图纸是用天正画的，如果不用天正，很多图形、字体会显示不出来，图纸显示不完整。

horihons

75215195 发表于 2017-9-27 19:02

还是不会修改。。。麻烦大神帮忙修改下可以吗？圆形、矩形、多边形的面积不纳入统计了，

sicky111

计算线长。

75215195

horihons 发表于 2017-9-29 10:57

没有用过天正，不懂。

horihons

75215195 发表于 2017-9-30 23:05

我也好郁闷啊！！为什么天正不行，一定是天正屏蔽了vlax。

大神，要不先不考虑天正了，大不了我以后的图都用天正导出来再用CAD来算。

能不能按我上面的回复，帮我改一下？拜托了！！

放假期间就不麻烦了，节后有空的话帮忙弄一下可以吗？