aggdqty 发表于 2023-8-29 14:06:10

按线型统计长度,求助

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


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

自贡黄明儒 发表于 2023-8-29 15:45:04

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

aggdqty 发表于 2023-8-29 16:04:47

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

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

飞雪神光 发表于 2023-8-29 16:16:01

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

ssyfeng 发表于 2023-8-29 16:24:34

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

飞雪神光 发表于 2023-8-29 19:42:25

换掉了两个command 我是07 原来的运行起来也不太兼容
(defun c:mm4(/ bf-curve-length jg lm-entmake-text n num1 num2 pt ss ss2 ty xx zc)
(defun BF-curve-Length (curve)
                (vlax-curve-getDistAtParam
                        curve
                        (vlax-curve-getEndParam curve)
                )
        )
        (defun lm-entmake-text(tdata / pt wz gd co tc)
                (mapcar'set '(pt wz gd co tc) tdata)
                (or co (setq co 256))
                (or tc (setq tc (getvar "clayer")))
                (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)))
                (entlast)
        )
        (setq ss (ssget '((0 . "*LINE,CIRCLE,ARC") (-4 . "<NOT") (6 . "bylayer") (-4 . "NOT>") (-4 . "<NOT") ( 6 . "byblock") (-4 . "NOT>"))))
(setq pt (getpoint "指定统计结果写入位置:"))
(setq num1 (sslength ss) num2 0)
(while (/= num1 num2)
    (setq
                        ty (ssname ss 0)
                        xx (cdr (assoc 6 (entget ty)))
                        ss2 (ssget "p" (list (cons 6 xx)))
                        zc 0
                        n 0
                )
                (repeat (sslength ss2)
                        (setq ty (ssname ss2 n))
                        (setq zc (+ zc (BF-curve-Length ty)))
                        (setq n (+ n 1))
                )
                (setq jg (strcat xx "=" (rtos (/ zc 1000) 2 2) "米"))
                (lm-entmake-text (list pt jg 60))
                (setq pt (polar pt (* pi 1.5) 120))
                (setq num2 (+ num2 (sslength ss2)))
                (command "Select" ss "R" ss2 "")
                (setq ss (ssget "_P"))
        )
)

aggdqty 发表于 2023-8-30 09:11:10

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

可以用了,谢谢

aggdqty 发表于 2023-8-30 09:21:52

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

同样感谢                        

花开富贵 发表于 2023-9-1 13:57:47

这个运行的不是很快,可以获取每个对象的线型+长度,然后把列表按组区分,相同的合并数值,分类列出即可
页: [1]
查看完整版本: 按线型统计长度,求助