huisguiji 发表于 2023-4-10 12:35:23

请大佬帮忙修改一下代码

本帖最后由 huisguiji 于 2024-8-29 22:29 编辑

这个代码也是在本论坛下载的，现在的问题是 数据 长*宽= 和 数量 是2行文字 我想要的是 数据和数量 成1行文字
以下是代码
(defun qbc (pts / b h)
(setq b (distance (car pts) (cadddr pts)))
(setq h (distance (car pts) (cadr pts)))
(cons (max b h) (min b h))
);结束qbc
(defun c:tg ( / bclst pts ss el bc_new i p2 p3 m x1 x2)
(princ "\n请框选矩形:")
(setq ss (ssget '((0 . "LWPOLYLINE") (90 . 4))))
(setq i 0 bclst nil pts nil)
(repeat (sslength ss)
(setq el (entget (ssname ss i)))
(setq pts nil)
(foreach pt el (if (= (car pt) 10) (setq pts (cons (cdr pt) pts))))      
(setq bclst (cons (qbc pts) bclst))
(setq i (1+ i))
);repeat
(setq bc_new nil)
(while bclst
(setq m (car bclst) x1 (length bclst))
(setq bclst (vl-remove m bclst))
(setq x2 (length bclst))
(setq n (- x1 x2))
(setq bc_new (cons (list m n) bc_new))
)
(setq p2 (getpoint "\起始位置"))
(setq p3 (polar p2 0 400))
(command "_.TEXT" "c" (polar p2 (* pi 0.5) 140) "70" "0" "高*宽=");指定书写标题的位置
(command "_.TEXT" "c" (polar p3 (* pi 0.5) 140) "70" "0" "数量")
(foreach bg bc_new                                                      ;设定重复次数为新表的长度
(command "_.TEXT" "c" p2 "70" "0" (strcat (rtos (car (car bg)) 2)"*" (rtos (cdr (car bg))2)"="))      
(command "_.TEXT" "c" p3 "70" "0" (cadr bg))
(setq p2 (polar p2 (* pi 1.5) 140))
(setq p3 (polar p2 0 400))
)
(princ)
)

杨小五 发表于 2023-4-10 12:35:24

(defun qbc (pts / b h)
(setq b (distance (car pts) (cadddr pts)))
(setq h (distance (car pts) (cadr pts)))
(cons (max b h) (min b h))
);结束qbc
(defun c:tg ( / bclst pts ss el bc_new i p2 p3 m x1 x2)
(princ "\n请框选矩形:")
(setq ss (ssget '((0 . "LWPOLYLINE") (90 . 4))))
(setq i 0 bclst nil pts nil)
(repeat (sslength ss)
(setq el (entget (ssname ss i)))
(setq pts nil)
(foreach pt el (if (= (car pt) 10) (setq pts (cons (cdr pt) pts))))      
(setq bclst (cons (qbc pts) bclst))
(setq i (1+ i))
);repeat
(setq bc_new nil)
(while bclst
(setq m (car bclst) x1 (length bclst))
(setq bclst (vl-remove m bclst))
(setq x2 (length bclst))
(setq n (- x1 x2))
(setq bc_new (cons (list m n) bc_new))
)
(setq p2 (getpoint "\起始位置"))
(setq p3 (polar p2 0 400))
(command "_.TEXT" "c" (polar p2 (* pi 0.5) 140) "70" "0" "高*宽=数量");指定书写标题的位置

(foreach bg bc_new                                                      ;设定重复次数为新表的长度
(command "_.TEXT" "c" p2 "70" "0"
           (strcat (rtos (car (car bg)) 2)"*" (rtos (cdr (car bg)) 2) "=" (itoa (cadr bg))))

(setq p2 (polar p2 (* pi 1.5) 140))
(princ)
)

ssyfeng 发表于 2023-4-13 09:18:00

最好可以上个cad图方便测试

huisguiji 发表于 2024-9-4 11:37:39

有没有大师看到啊:sleepy:

huisguiji 发表于 2024-9-6 12:09:32

杨小五 发表于 2024-9-5 16:24


用不了 提示这个 Application Error: 2 :- 输入的列表有缺陷ADS 请求错误

杨小五 发表于 2024-9-18 13:37:38

huisguiji 发表于 2024-9-6 12:09
用不了 提示这个 Application Error: 2 :- 输入的列表有缺陷ADS 请求错误

好多天没登了，才看到。不知道你解决了没有，刚才把我上传的代码复制出来又试了一下，最后(princ)前面少了半个小括号，你在(princ) 的上一行，加一个   ）   应该就可以了。我这边试用的是没有问题了。
（上传前我试过的，不知道怎么会漏了半个括号:dizzy:）

huisguiji 发表于 2024-9-19 10:40:52

杨小五 发表于 2024-9-18 13:37
好多天没登了，才看到。不知道你解决了没有，刚才把我上传的代码复制出来又试了一下，最后(princ)前面 ...

感谢大佬，可以了。另外还有一个字体大小的问题，如果我的文字样式里大小是设置成70，这个统计清单文字就会显示为0 只能在文字样式里设置成0 这个才会显示文字。能帮我改成随当前的文字样式里的大小吗？

杨小五 发表于 2024-9-25 13:58:26

本帖最后由 杨小五 于 2024-9-25 14:10 编辑

看下一条回复，这条好像撤销不了，删掉了

杨小五 发表于 2024-9-25 14:07:09

本帖最后由 杨小五 于 2024-9-25 14:10 编辑



(defun qbc (pts / b h)
(setq b (distance (car pts) (cadddr pts)))
(setq h (distance (car pts) (cadr pts)))
(cons (max b h) (min b h))
);结束qbc

(defun c:tg ( / bclst pts ss el bc_new i p2 p3 m x1 x2)
(princ "\n请框选矩形:")
(setq ss (ssget '((0 . "LWPOLYLINE") (90 . 4))))
(setq i 0 bclst nil pts nil)
(repeat (sslength ss)
(setq el (entget (ssname ss i)))
(setq pts nil)
(foreach pt el (if (= (car pt) 10) (setq pts (cons (cdr pt) pts))))      
(setq bclst (cons (qbc pts) bclst))
(setq i (1+ i))
);repeat
(setq bc_new nil)
(while bclst
(setq m (car bclst) x1 (length bclst))
(setq bclst (vl-remove m bclst))
(setq x2 (length bclst))
(setq n (- x1 x2))
(setq bc_new (cons (list m n) bc_new))
)
(setq p2 (getpoint "\起始位置"))
(setq p3 (polar p2 0 400))

(setq tstyles (vla-get-textstyles (vla-get-activedocument (vlax-get-acad-object))))
(setq tstyle(vla-item tstyles (getvar "textstyle")))
(setq hh(vla-get-height tstyle))
;;;(if (/= hh 0)(vla-put-height tstyle 0.0))
(if (= hh 0)
(command "_.TEXT" "c" (polar p2 (* pi 0.5) (* 2 (getvar "textsize"))) (getvar "textsize") "0" "高*宽=数量");指定书写标题的位置
(command "_.TEXT" "c" (polar p2 (* pi 0.5) (* 2 hh))"0" "高*宽=数量")
)

(foreach bg bc_new                                                      ;设定重复次数为新表的长度
(if (= hh 0)
(command "_.TEXT" "c" p2 (getvar "textsize") "0"
         (strcat (rtos (car (car bg)) 2)"*" (rtos (cdr (car bg)) 2) "=" (itoa (cadr bg))))
(command "_.TEXT" "c" p2"0"
         (strcat (rtos (car (car bg)) 2)"*" (rtos (cdr (car bg)) 2) "=" (itoa (cadr bg))))
)

(setq p2 (polar p2 (* pi 1.5) (* 2 (getvar "textsize"))))
)
(princ)
)

huisguiji 发表于 2024-9-25 16:58:10

杨小五 发表于 2024-9-25 14:07
(defun qbc (pts / b h)
(setq b (distance (car pts) (cadddr pts)))
(setq h (distance (car pts)...

完美了 :handshake谢谢
页: [1]
查看完整版本: 请大佬帮忙修改一下代码