有偿(已付款答谢)求改进LSP脚本

lzh720

以下是线段统计长度的脚本
===============================
(princ "\n程序：duoduanxianqiuhe 命令：duoduanxian")
(defun C:duoduanxian (/ CURVE TLEN SS N SUMLEN)
(vl-load-com)
(setq SUMLEN 0)
(setq SS (ssget '((0 . "CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE,ARC"))))
(setq N 0)
(repeat (sslength SS)
(setq CURVE (vlax-ename->vla-object (ssname SS N)))
(setq TLEN (vlax-curve-getdistatparam CURVE (vlax-curve-getendparam CURVE)))
(setq SUMLEN (+ SUMLEN TLEN))
(setq N (1+ N)))
(setq sumlen(/ sumlen 1000))
(princ (strcat "\n共选择 " (itoa (sslength SS)) " 条线段. 线段总长: " (rtos SUMLEN 2 2)" m"))
(princ) )
==================================
我想让这个脚本里统计的线段长度自动复制到剪贴板里用于复制到EXCEL
需要怎么修改这个脚本？
如果有用的话，我可以微信转账30块答谢(已付款答谢)
=======================
说一下我得软件环境，天正T20V9平台，AutoCAD2013_64

小鸟

2. ;;;以下是线段统计长度的脚本
   
3. ;;;===============================
   
4. (princ "\n程序：duoduanxianqiuhe 命令：duoduanxian")
   
5. (defun C:duoduanxian (/ CURVE TLEN SS N
   
6.           ;SUMLEN
   
7.           )
   
8. (vl-load-com)
   
9. (setq SUMLEN 0)
   
10. (setq SS (ssget '((0 . "CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE,ARC"))))
    
11. (setq N 0)
    
12. (repeat (sslength SS)
    
13. (setq CURVE (vlax-ename->vla-object (ssname SS N)))
    
14. (setq TLEN (vlax-curve-getdistatparam CURVE (vlax-curve-getendparam CURVE)))
    
15. (setq SUMLEN (+ SUMLEN TLEN))
    
16. (setq N (1+ N)))
    
17. (setq sumlen(/ sumlen 1000))
    
18.   (SET-CLIP-STRING (rtos SUMLEN 2 2))
    
19. (princ (strcat "\n共选择 " (itoa (sslength SS)) " 条线段. 线段总长: " (rtos SUMLEN 2 2)" m"))
    
20. (princ) )
    
21. ;;;==================================
    
22. ;;;我想让这个脚本里统计的线段长度自动复制到剪贴板里用于复制到EXCEL
    
23. ;;;需要怎么修改这个脚本？
    
24. ;;;如果有用的话，我可以微信转账30块答谢
    
25. ;;;
    
26. ;;;=======================
    
27. ;;;说一下我得软件环境，天正T20V9平台，AutoCAD2013_64
    
28. 
    
29. ;;;=================================================================*
    
30. ;;;功能：向系统剪贴板写入文字                                       *
    
31. (defun SET-CLIP-STRING (STR / HTML RESULT)
    
32.     (and (= (type STR) 'STR)
    
33.    (setq HTML (vlax-create-object "htmlfile"))
    
34.    (setq RESULT (vlax-invoke
    
35.         (vlax-get (vlax-get HTML 'PARENTWINDOW)
    
36.             'CLIPBOARDDATA
    
37.         )
    
38.         'SETDATA
    
39.         "Text"
    
40.         STR
    
41.           )
    
42.    )
    
43.    (vlax-release-object HTML)
    
44.    (princ "复制到剪贴板")
    
45.     )
    
46. )
    
47. ;;;=================================================================*

;;;以下是线段统计长度的脚本<br /> ;;;===============================<br /> (princ "\n程序：duoduanxianqiuhe 命令：duoduanxian")<br /> (defun C:duoduanxian (/ CURVE TLEN SS N<br />           ;SUMLEN<br />           )<br /> (vl-load-com)<br /> (setq SUMLEN 0)<br /> (setq SS (ssget '((0 . "CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE,ARC"))))<br /> (setq N 0)<br /> (repeat (sslength SS)<br /> (setq CURVE (vlax-ename->vla-object (ssname SS N)))<br /> (setq TLEN (vlax-curve-getdistatparam CURVE (vlax-curve-getendparam CURVE)))<br /> (setq SUMLEN (+ SUMLEN TLEN))<br /> (setq N (1+ N)))<br /> (setq sumlen(/ sumlen 1000))<br />   (SET-CLIP-STRING (rtos SUMLEN 2 2))<br /> (princ (strcat "\n共选择 " (itoa (sslength SS)) " 条线段. 线段总长: " (rtos SUMLEN 2 2)" m"))<br /> (princ) )<br /> ;;;==================================<br /> ;;;我想让这个脚本里统计的线段长度自动复制到剪贴板里用于复制到EXCEL<br /> ;;;需要怎么修改这个脚本？<br /> ;;;如果有用的话，我可以微信转账30块答谢<br /> ;;;<br /> ;;;=======================<br /> ;;;说一下我得软件环境，天正T20V9平台，AutoCAD2013_64<br /> <br /> ;;;=================================================================*<br /> ;;;功能：向系统剪贴板写入文字                                       *<br /> (defun SET-CLIP-STRING (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 />    (princ "复制到剪贴板")<br />     )<br /> )<br /> ;;;=================================================================*

xj6019

lzh720 发表于 2023-7-26 19:40
我原先的脚本用了起码10年，从CAD2007到2023，天正和浩辰都用过，非常稳定可靠，年纪大了，懒得多敲字， ...

你这样试试

(defun C:NM (/ CURVE N SS SUMLEN TLEN zml-clip-setstring)
     (vl-load-com)
        (defun ZML-CLIP-SETSTRING (STR / HTML RESULT);;向系統剪貼板寫入文字
                (setvar "DIMZIN" 8)  ;消除十進制標註中的後續零
                (if(listp STR)
                        (setq str(vl-prin1-to-string STR))
                )
                (and (= (type STR) 'STR)
                        (setq HTML (vlax-create-object "htmlfile"))
                        (setq RESULT (vlax-invoke
                                                                                 (vlax-get        (vlax-get HTML 'PARENTWINDOW)
                                                                                         'CLIPBOARDDATA
                                                                                 )
                                                                                 'SETDATA
                                                                                 "Text"
                                                                                 STR
                                                                         )
                        )
                        (vlax-release-object HTML)
                )
        )
        (ZML-CLIP-SETSTRING "防止出错，占位一下！")   
        (setq SUMLEN 0)
        (setq SS (ssget '((0 . "CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE,ARC"))))
        (setq N 0)
        (repeat (sslength SS)
                (setq CURVE (vlax-ename->vla-object (ssname SS N)))
                (setq TLEN (vlax-curve-getdistatparam CURVE (vlax-curve-getendparam CURVE)))
                (setq SUMLEN (+ SUMLEN TLEN))
                (setq N (1+ N)))
        (setq sumlen(/ sumlen 1000))
        (ZML-CLIP-SETSTRING (rtos SUMLEN 2 2))
        (princ (strcat "\n共选择 " (itoa (sslength SS)) " 条线段. 线段总长: " (rtos SUMLEN 2 2)" m"))
        (princ)        
)

xj6019

运行完  直接去粘贴即可
(defun C:duoduanxian (/ CURVE N SS SUMLEN TLEN zml-clip-setstring)
        (defun ZML-CLIP-SETSTRING (STR / HTML RESULT);;向系統剪貼板寫入文字
                (setvar "DIMZIN" 8)  ;消除十進制標註中的後續零
                (if(listp STR)
                        (setq str(vl-prin1-to-string STR))
                )
                (and (= (type STR) 'STR)
                        (setq HTML (vlax-create-object "htmlfile"))
                        (setq RESULT (vlax-invoke
                                                                                 (vlax-get        (vlax-get HTML 'PARENTWINDOW)
                                                                                         'CLIPBOARDDATA
                                                                                 )
                                                                                 'SETDATA
                                                                                 "Text"
                                                                                 STR
                                                                         )
                        )
                        (vlax-release-object HTML)
                )
        )
        (vl-load-com)
        (setq SUMLEN 0)
        (setq SS (ssget '((0 . "CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE,ARC"))))
        (setq N 0)
        (repeat (sslength SS)
                (setq CURVE (vlax-ename->vla-object (ssname SS N)))
                (setq TLEN (vlax-curve-getdistatparam CURVE (vlax-curve-getendparam CURVE)))
                (setq SUMLEN (+ SUMLEN TLEN))
                (setq N (1+ N)))
        (setq sumlen(/ sumlen 1000))
        (ZML-CLIP-SETSTRING (rtos SUMLEN 2 2))
        (princ (strcat "\n共选择 " (itoa (sslength SS)) " 条线段. 线段总长: " (rtos SUMLEN 2 2)" m"))
        (princ)        
)

ssyfeng

只需要复制长度数字就行了吗？还是连这些文字一起复制

lzh720

ssyfeng 发表于 2023-7-26 18:03
只需要复制长度数字就行了吗？还是连这些文字一起复制

只需要复制长度，不要带那个m的单位，也不能有空格

ssyfeng

(defun C:tt (/ CURVE N SS str SUMLEN TLEN zml-clip-setstring)
        (defun ZML-CLIP-SETSTRING (STR / HTML RESULT)
  (and (= (type STR) 'STR)
       (setq HTML (vlax-create-object "htmlfile"))
       (setq RESULT (vlax-invoke
                      (vlax-get        (vlax-get HTML 'PARENTWINDOW)
                                'CLIPBOARDDATA
                      )
                      'SETDATA
                      "Text"
                      STR
                    )
       )
       (vlax-release-object HTML)
  )
)
(vl-load-com)
(setq SUMLEN 0)
(setq SS (ssget '((0 . "CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE,ARC"))))
(setq N 0)
(repeat (sslength SS)
(setq CURVE (vlax-ename->vla-object (ssname SS N)))
(setq TLEN (vlax-curve-getdistatparam CURVE (vlax-curve-getendparam CURVE)))
(setq SUMLEN (+ SUMLEN TLEN))
(setq N (1+ N)))
(setq sumlen(/ sumlen 1000))
(princ (strcat "\n共选择 " (itoa (sslength SS)) " 条线段. 线段总长: " (setq str (rtos SUMLEN 2 2))" m"))
        (if str (progn (ZML-CLIP-SETSTRING str) (princ (strcat "\n线段总长度：" (setq str (rtos SUMLEN 2 2)) " 已复制到剪切板上。"))))
(princ) )

lzh720

ssyfeng 发表于 2023-7-26 18:07
(defun C:tt (/ CURVE N SS str SUMLEN TLEN zml-clip-setstring)
        (defun ZML-CLIP-SETSTRING (STR / HTM ...

命令是TT吗

ssyfeng

是的，你自己可以改

lzh720

ssyfeng 发表于 2023-7-26 18:07
(defun C:tt (/ CURVE N SS str SUMLEN TLEN zml-clip-setstring)
        (defun ZML-CLIP-SETSTRING (STR / HTM ...

能用但老是报错啊

ssyfeng

可以加我qq269126750，帮你看看

lzh720

ssyfeng 发表于 2023-7-26 18:56
可以加我qq269126750，帮你看看

修改了你的命令，我改回来TT再试试