请高手编个程

tianyuan

我在实际工作中常常要将CAD图形中的面积单个标注在CAD表格中，然后在利用计算器把图形中标注的单个面积逐一相加，最后再把面积总和标注在表格中的合计栏。这样的话工作起来相当繁琐.我想请高手编个可以通过点击图形中的数字,即可实现相加功能,并能把相加后的和自动标注在图形中的任意位置的程序.

可以吗?

小弟在这里先谢谢大家了!!!!!

citykunan

(defun c:test ( / ss i ent numall num)
  (setq ss (ssget '((0 . "TEXT"))))
  (setq i 0 numall 0.0)
 
  (repeat (sslength ss)
    (setq ent (ssname ss i))
    (setq num (cdr (assoc 1 (entget ent))))
    (setq num (atof num))
    (setq numall (+ numall num))
    (setq i (1+ i))
  )
  numall
)

zhongguola

请问怎样才能使得相加的总和标注在cad的图上??????

ljpnb

用TEXT命令啊

tianyuan

我在该程序的尾部加了text命令但是不行

(defun c:test ( / ss i ent numall num)
  (setq ss (ssget '((0 . "TEXT"))))
  (setq i 0 numall 0.0)
  (setq pt1(getpoing"/n 请输入点))

 (repeat (sslength ss)
    (setq ent (ssname ss i))
    (setq num (cdr (assoc 1 (entget ent))))
    (setq num (atof num))
    (setq numall (+ numall num))
    (setq i (1+ i))
  )
  numall
)

(command "text" "j" "mc" pt1 "0" numall
)

 

 

ljpnb

修改了一下：

2. (defun c:test (/ ss i ent numall num)
3.   (setq ss (ssget '((0 . "TEXT"))))
4.   (setq i 0
5. numall 0.0
6.   )
7.   (setq pt1 (getpoint "\n请输入点"))
8.   (repeat (sslength ss)
9.     (setq ent (ssname ss i))
10.     (setq num (cdr (assoc 1 (entget ent))))
11.     (setq num (atof num))
12.     (setq numall (+ numall num))
13.     (setq i (1+ i))
14.   )
15.   (command "text" "j" "mc" pt1 "" "" (rtos numall))
16.   (princ)
17. )

(defun c:test (/ ss i ent numall num)   (setq ss (ssget '((0 . "TEXT"))))   (setq i 0 numall 0.0   )   (setq pt1 (getpoint "\n请输入点"))   (repeat (sslength ss)     (setq ent (ssname ss i))     (setq num (cdr (assoc 1 (entget ent))))     (setq num (atof num))     (setq numall (+ numall num))     (setq i (1+ i))   )   (command "text" "j" "mc" pt1 "" "" (rtos numall))   (princ) )

xyp1964

2. (defun c:test (/ ss i ent numall num pt1)
3.   (setq ss     (ssget '((0 . "TEXT")))
4. i      -1
5. numall 0.0
6. pt1    (getpoint "\n 请输入点: ")
7.   )
8.   (repeat (sslength ss)
9.     (setq ent (ssname ss (setq i (1+ i))))
10.     (setq num (cdr (assoc 1 (entget ent))))
11.     (if (setq num (atof num))
12.       (setq numall (+ numall num))
13.     )
14.   )
15.   (command "text" "j" "mc" pt1 "300" "0" (rtos numall 2 3))
16.   (princ)
17. )

(defun c:test (/ ss i ent numall num pt1)   (setq ss     (ssget '((0 . "TEXT"))) i      -1 numall 0.0 pt1    (getpoint "\n 请输入点: ")   )   (repeat (sslength ss)     (setq ent (ssname ss (setq i (1+ i))))     (setq num (cdr (assoc 1 (entget ent))))     (if (setq num (atof num))       (setq numall (+ numall num))     )   )   (command "text" "j" "mc" pt1 "300" "0" (rtos numall 2 3))   (princ) )

zhongguola

请问楼上的，假如我把标注的字高不设为300，而是设为任意值，如“<请输入字高：>”，应该怎样改动？？？？

wandong

.........

(setq high (getreal "\n输入字高:"))

  (command "text" "j" "mc" pt1 high "0" (rtos numall 2 3))

(princ)

)
  

xyp1964

2. (load "xyp_lib.vlx") ;版本 V.20060210
3. ;|下载和加载通用函数(可在签名栏直接下载后放到搜索路径下)
4. 利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：
5. ★1·在acad.lsp中增加(load"xyp_lib")
6. ■2·在每个程序内增加(load"xyp_lib")
7. ■3·在command下，输入(load"xyp_lib")
8. ■4·在菜单.mnl中增加(load"xyp_lib")
9. ■5·将xyp_lib.vlx文件直接拽到cad屏幕
10. [COLOR=red] ★通用函数下载地址：[/COLOR]
11. [url]http://bbs.mjtd.com/forum.php?mod=viewthread&tid=37554[/url]
12. |;
13. (defun c:test (/ ss i ent numall num pt1)
14.   (cmdlasc0)
15.   (setq th     (* sc 300.0)
16. ss     (ssget '((0 . "TEXT")))
17. i      -1
18. numall 0.0
19. pt1    (getpoint "\n 请输入点: ")
20.   )
21.   (repeat (sslength ss)
22.     (setq ent (ssname ss (setq i (1+ i))))
23.     (setq num (cdr (assoc 1 (entget ent))))
24.     (if (setq num (atof num))
25.       (setq numall (+ numall num))
26.     )
27.   )
28.   (command "text" "j" "mc" pt1 th "0" (rtos numall 2 3))
29.   (cmdla1)
30. )

(load "xyp_lib.vlx") ;版本 V.20060210 ;|下载和加载通用函数(可在签名栏直接下载后放到搜索路径下) 利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序： ★1·在acad.lsp中增加(load"xyp_lib") ■2·在每个程序内增加(load"xyp_lib") ■3·在command下，输入(load"xyp_lib") ■4·在菜单.mnl中增加(load"xyp_lib") ■5·将xyp_lib.vlx文件直接拽到cad屏幕 [COLOR=red] ★通用函数下载地址：[/COLOR] [url]http://bbs.mjtd.com/forum.php?mod=viewthread&tid=37554[/url] |; (defun c:test (/ ss i ent numall num pt1)   (cmdlasc0)   (setq th     (* sc 300.0) ss     (ssget '((0 . "TEXT"))) i      -1 numall 0.0 pt1    (getpoint "\n 请输入点: ")   )   (repeat (sslength ss)     (setq ent (ssname ss (setq i (1+ i))))     (setq num (cdr (assoc 1 (entget ent))))     (if (setq num (atof num))       (setq numall (+ numall num))     )   )   (command "text" "j" "mc" pt1 th "0" (rtos numall 2 3))   (cmdla1) )