按线型统计长度，求助

aggdqty

此代码可以在07上运行，但是高版本无法运行，哪位帮调整一下，谢谢


反向跟踪:
[0.51] (VL-BT)
[1.47] (*ERROR* "函数已取消")
[2.42] (_call-err-hook #<SUBR @0000023ef6cbe7a0 *ERROR*> "函数已取消")
[3.36] (sys-error "函数已取消")
:ERROR-BREAK.31 nil
[4.28] (sys-rtcan-hook)
[5.24] (ads-cmd "text")
[6.19] (C:MM4)
[7.15] (#<SUBR @0000023edb174f98 -rts_top->)
[8.12] (#<SUBR @0000023ed4588700 veval-str-body> "(C:MM4)" T #<FILE internal>)
:CALLBACK-ENTRY.6 (:CALLBACK-ENTRY)
:ARQ-SUBR-CALLBACK.3 (nil 0)
参数太少

自贡黄明儒

把COMMAND换成vl-cmdf ,可以用于高低版本。试试？

aggdqty

自贡黄明儒 发表于 2023-8-29 15:45
把COMMAND换成vl-cmdf ,可以用于高低版本。试试？

改了，不行，“需要数值距离、两点或选项关键字”

飞雪神光

代码写的很迷 看不懂...

ssyfeng

可能高版本CAD命令发生了改变，自己在高版本中用里面用到的CAD命令操作一遍，再修改一下代码应该就行了

飞雪神光

换掉了两个command 我是07 原来的运行起来也不太兼容

1. (defun c:mm4(/ bf-curve-length jg lm-entmake-text n num1 num2 pt ss ss2 ty xx zc)
   
2.   (defun BF-curve-Length (curve)
   
3.                 (vlax-curve-getDistAtParam
   
4.                         curve
   
5.                         (vlax-curve-getEndParam curve)
   
6.                 )
   
7.         )
   
8.         (defun lm-entmake-text(tdata / pt wz gd co tc)
   
9.                 (mapcar'set '(pt wz gd co tc) tdata)
   
10.                 (or co (setq co 256))
    
11.                 (or tc (setq tc (getvar "clayer")))
    
12.                 (entmake(list '(0 . "text")(cons 8 tc)(cons 62 co)'(50 . 0.0) (cons 10 pt)(cons 11 pt)(cons 1 wz)'(7 . "Standard")(cons 40 gd)'(6 . "Continuous")'(41 . 0.8)'(72 . 1)'(210 0.0 0.0 1.0)'(100 . "AcDbText")'(73 . 2)))
    
13.                 (entlast)
    
14.         )
    
15.         (setq ss (ssget '((0 . "*LINE,CIRCLE,ARC") (-4 . "<NOT") (6 . "bylayer") (-4 . "NOT>") (-4 . "<NOT") ( 6 . "byblock") (-4 . "NOT>"))))
    
16.   (setq pt (getpoint "指定统计结果写入位置："))
    
17.   (setq num1 (sslength ss) num2 0)
    
18.   (while (/= num1 num2)
    
19.     (setq
    
20.                         ty (ssname ss 0)
    
21.                         xx (cdr (assoc 6 (entget ty)))
    
22.                         ss2 (ssget "p" (list (cons 6 xx)))
    
23.                         zc 0
    
24.                         n 0
    
25.                 )
    
26.                 (repeat (sslength ss2)
    
27.                         (setq ty (ssname ss2 n))
    
28.                         (setq zc (+ zc (BF-curve-Length ty)))
    
29.                         (setq n (+ n 1))
    
30.                 )
    
31.                 (setq jg (strcat xx "=" (rtos (/ zc 1000) 2 2) "米"))
    
32.                 (lm-entmake-text (list pt jg 60))
    
33.                 (setq pt (polar pt (* pi 1.5) 120))
    
34.                 (setq num2 (+ num2 (sslength ss2)))
    
35.                 (command "Select" ss "R" ss2 "")
    
36.                 (setq ss (ssget "_P"))
    
37.         )
    
38. )

(defun c:mm4(/ bf-curve-length jg lm-entmake-text n num1 num2 pt ss ss2 ty xx zc)<br />   (defun BF-curve-Length (curve)<br />                 (vlax-curve-getDistAtParam<br />                         curve<br />                         (vlax-curve-getEndParam curve)<br />                 )<br />         )<br />         (defun lm-entmake-text(tdata / pt wz gd co tc)<br />                 (mapcar'set '(pt wz gd co tc) tdata)<br />                 (or co (setq co 256))<br />                 (or tc (setq tc (getvar "clayer")))<br />                 (entmake(list '(0 . "text")(cons 8 tc)(cons 62 co)'(50 . 0.0) (cons 10 pt)(cons 11 pt)(cons 1 wz)'(7 . "Standard")(cons 40 gd)'(6 . "Continuous")'(41 . 0.8)'(72 . 1)'(210 0.0 0.0 1.0)'(100 . "AcDbText")'(73 . 2)))<br />                 (entlast)<br />         )<br />         (setq ss (ssget '((0 . "*LINE,CIRCLE,ARC") (-4 . "<NOT") (6 . "bylayer") (-4 . "NOT>") (-4 . "<NOT") ( 6 . "byblock") (-4 . "NOT>"))))<br />   (setq pt (getpoint "指定统计结果写入位置："))<br />   (setq num1 (sslength ss) num2 0)<br />   (while (/= num1 num2)<br />     (setq <br />                         ty (ssname ss 0)<br />                         xx (cdr (assoc 6 (entget ty)))<br />                         ss2 (ssget "p" (list (cons 6 xx)))<br />                         zc 0<br />                         n 0<br />                 )<br />                 (repeat (sslength ss2)<br />                         (setq ty (ssname ss2 n))<br />                         (setq zc (+ zc (BF-curve-Length ty)))<br />                         (setq n (+ n 1))<br />                 )<br />                 (setq jg (strcat xx "=" (rtos (/ zc 1000) 2 2) "米"))<br />                 (lm-entmake-text (list pt jg 60))<br />                 (setq pt (polar pt (* pi 1.5) 120))<br />                 (setq num2 (+ num2 (sslength ss2)))<br />                 (command "Select" ss "R" ss2 "")<br />                 (setq ss (ssget "_P"))<br />         )<br /> )

aggdqty

飞雪神光 发表于 2023-8-29 19:42
换掉了两个command 我是07 原来的运行起来也不太兼容

可以用了，谢谢

aggdqty

自贡黄明儒 发表于 2023-8-29 15:45
把COMMAND换成vl-cmdf ,可以用于高低版本。试试？

同样感谢                        

花开富贵

这个运行的不是很快，可以获取每个对象的线型+长度，然后把列表按组区分，相同的合并数值，分类列出即可