请大佬帮忙修改一下代码

huisguiji

这个代码也是在本论坛下载的，现在的问题是 数据 长*宽= 和 数量 是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)
)

杨小五

2. (defun qbc (pts / b h)
   
3. (setq b (distance (car pts) (cadddr pts)))
   
4. (setq h (distance (car pts) (cadr pts)))
   
5. (cons (max b h) (min b h))
   
6. );结束qbc
   
7. (defun c:tg ( / bclst pts ss el bc_new i p2 p3 m x1 x2)
   
8. (princ "\n请框选矩形:")
   
9. (setq ss (ssget '((0 . "LWPOLYLINE") (90 . 4))))
   
10. (setq i 0 bclst nil pts nil)
    
11. (repeat (sslength ss)
    
12.   (setq el (entget (ssname ss i)))
    
13.   (setq pts nil)
    
14.   (foreach pt el (if (= (car pt) 10) (setq pts (cons (cdr pt) pts))))      
    
15.   (setq bclst (cons (qbc pts) bclst))
    
16.   (setq i (1+ i))
    
17. );repeat
    
18. (setq bc_new nil)
    
19. (while bclst
    
20.   (setq m (car bclst) x1 (length bclst))
    
21.   (setq bclst (vl-remove m bclst))
    
22.   (setq x2 (length bclst))
    
23.   (setq n (- x1 x2))
    
24.   (setq bc_new (cons (list m n) bc_new))
    
25. )
    
26. (setq p2 (getpoint "\起始位置"))
    
27. (setq p3 (polar p2 0 400))
    
28. (command "_.TEXT" "c" (polar p2 (* pi 0.5) 140) "70" "0" "高*宽=数量");指定书写标题的位置
    
29. 
    
30. (foreach bg bc_new                                                      ;设定重复次数为新表的长度
    
31.   (command "_.TEXT" "c" p2 "70" "0"
    
32.            (strcat (rtos (car (car bg)) 2)"*" (rtos (cdr (car bg)) 2) "=" (itoa (cadr bg))))
    
33. 
    
34.   (setq p2 (polar p2 (* pi 1.5) 140))
    
35. (princ)
    
36. )

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

ssyfeng

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

huisguiji

有没有大师看到啊

huisguiji

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

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

杨小五

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

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

huisguiji

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

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

杨小五

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

杨小五

(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 14:07
(defun qbc (pts / b h)
(setq b (distance (car pts) (cadddr pts)))
(setq h (distance (car pts)  ...

完美了 谢谢