按线型统计长度,求助
此代码可以在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)
参数太少
把COMMAND换成vl-cmdf ,可以用于高低版本。试试? 自贡黄明儒 发表于 2023-8-29 15:45
把COMMAND换成vl-cmdf ,可以用于高低版本。试试?
改了,不行,“需要数值距离、两点或选项关键字” 代码写的很迷 看不懂... 可能高版本CAD命令发生了改变,自己在高版本中用里面用到的CAD命令操作一遍,再修改一下代码应该就行了 换掉了两个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"))
)
) 飞雪神光 发表于 2023-8-29 19:42
换掉了两个command 我是07 原来的运行起来也不太兼容
可以用了,谢谢 自贡黄明儒 发表于 2023-8-29 15:45
把COMMAND换成vl-cmdf ,可以用于高低版本。试试?
同样感谢 这个运行的不是很快,可以获取每个对象的线型+长度,然后把列表按组区分,相同的合并数值,分类列出即可
页:
[1]