[编程申请]：帮忙修改2个命令，改进得更人性化一些。

haojia

各位高手，你们好！在附件里有我下载的两个跟面积有关的命令，的确很好用，但我用的时候总是要加工一下，不够人性化，希望提出一些我觉得有用的方式进行一些细微的修改，我想修改以后能更方便大家的操作，虽然看起来是针对我个人的，但其实真正目的是服务与大家啊，放在论坛里，供大家共同成长，废话少说，正题。

第一个命令是自动标注封闭多意线面积的命令。高手门试用一下就知道，其实编得不完善。我希望进行的修改是：最好能一次性多重选择多个物体，选择确定之后程序可以自动把面积标注在各个多意线物体的正中，标注的面积应该是默认以米为单位（如果想合适所有使用者，在这里可以加一个步骤，就是选择一什么为标注单位，最好默认为米，因为对面积计算，米比较多，但对于我个人来说，这个步骤可以取消，我只用米作单位，其他都不会用上），下一个步骤希望能有一个输入字高的过程，因为每一张图的比例都不一样，自动默认字高对观察者不利，我就很讨厌他原来的命令不能输入字体高度！在程序自动标注面积数字的时候，那些数字最好能自动创建一个图层，所有的数据都标注在自动创建的图层里，就把这个图层名字确定为AREAS吧，这样在用数字求和命令中就方便了许多。
第二个命令是数字求和的命令，其实已经很好用了，但是有时时候制图需要，我的这个命令精确度不够，只精确到小数点一位，我觉得可以修改成精确到小数点后3为，这样就可以适应任何情况了。
希望得到修改的就这些，本人不会编程，只能出点子，希望高手能帮忙。呵呵。小弟先谢谢了！

它山之石

[php]
;;;拾取数字求和
(defun c:szh (/ ss n totn adn)
(prompt "\n拾取数字求和: ")
(setq ss (ssget '((0 . "TEXT")))
n 0
)
(setq totn 0.0)
(while (setq en (ssname ss n))
(setq adn (atof (cdr (assoc 1 (entget en)))))
(setq totn (+ totn adn))
(setq n (1+ n))
)
(princ (strcat "\n数字和: "))
(princ (rtos totn 2 4));;;需要精确到几位就将4改成几
(princ)
)
[/php]

haojia

谢谢，还有前面那个命令呢？一起编了嘛:)





怎么没有跟贴了呢？应该不难吧？以前我在这里找一个超级减切命令，那个那么难都可以，这个应该不难了吧？0324

david96007

简化别人的程序:

2. 
   
3. (defun c:mj (/ pt pt1 en aa bl-bz)
   
4.   (cmdla0)
   
5.   (setq        tht (getreal "\n输入文字高度:")
   
6.         pt
   
7.             (getpoint "\n选取封闭域内一点: ")
   
8.   )
   
9.   (while pt
   
10.     (setq pt1 pt)
    
11.     (mkla "封闭域辅助线" 8)
    
12.     (command "bpoly" pt "")
    
13.     (setq en (entlast))
    
14.     (if        (/= en nil)
    
15.       (progn
    
16.         (command "area" "o" en)
    
17.         (setq aa (getvar "area"))
    
18.         (redraw en 3)
    
19.       )
    
20.     )
    
21.     (entdel en)
    
22.     (mkla "面积标注" 4)
    
23.     (setq aa (rtos (/ aa 1000000.0) 2 4))
    
24.     (command "text" "j" "mc" pt1 tht "0" aa)
    
25.     (setq pt (getpoint "\n选取封闭域内一点: "))
    
26.   )
    
27.   (cmdla1)
    
28. )
    
29. (defun CMDLA0 ()
    
30.   (setq cmdech (getvar "CMDECHO"))
    
31.   (setq oom (getvar "orthomode"))
    
32.   (setq osm (getvar "osmode"))
    
33.   (SETQ LA (getvar "clayer"))
    
34.   (setq rmode (getvar "regenmode"))
    
35.   (setvar "regenmode" 0)
    
36.   (setvar "CMDECHO" 0)
    
37.   (princ)
    
38. )
    
39. 
    
40. ;;;
    
41. (defun CMDLA1 ()
    
42.   (setvar "CMDECHO" cmdech)
    
43.   (setvar "orthomode" oom)
    
44.   (setvar "osmode" osm)
    
45.   (setvar "clayer" LA)
    
46.   (setvar "regenmode" rmode)
    
47.   (princ)
    
48. )
    
49. (Defun MKLA (a b)
    
50.   (If (= (Tblsearch "layer" a) nil)
    
51.     (Command "layer" "m" a "c" b a "")
    
52.     (Command "layer" "t" a "s" a "c" b a "")
    
53.   )
    
54. )

<br /> (defun c:mj (/ pt pt1 en aa bl-bz)<br />   (cmdla0)<br />   (setq        tht (getreal "\n输入文字高度:")<br />         pt<br />             (getpoint "\n选取封闭域内一点: ")<br />   )<br />   (while pt<br />     (setq pt1 pt)<br />     (mkla "封闭域辅助线" 8)<br />     (command "bpoly" pt "")<br />     (setq en (entlast))<br />     (if        (/= en nil)<br />       (progn<br />         (command "area" "o" en)<br />         (setq aa (getvar "area"))<br />         (redraw en 3)<br />       )<br />     )<br />     (entdel en)<br />     (mkla "面积标注" 4)<br />     (setq aa (rtos (/ aa 1000000.0) 2 4))<br />     (command "text" "j" "mc" pt1 tht "0" aa)<br />     (setq pt (getpoint "\n选取封闭域内一点: "))<br />   )<br />   (cmdla1)<br /> )<br /> (defun CMDLA0 ()<br />   (setq cmdech (getvar "CMDECHO"))<br />   (setq oom (getvar "orthomode"))<br />   (setq osm (getvar "osmode"))<br />   (SETQ LA (getvar "clayer"))<br />   (setq rmode (getvar "regenmode"))<br />   (setvar "regenmode" 0)<br />   (setvar "CMDECHO" 0)<br />   (princ)<br /> )<br /> <br /> ;;;<br /> (defun CMDLA1 ()<br />   (setvar "CMDECHO" cmdech)<br />   (setvar "orthomode" oom)<br />   (setvar "osmode" osm)<br />   (setvar "clayer" LA)<br />   (setvar "regenmode" rmode)<br />   (princ)<br /> )<br /> (Defun MKLA (a b)<br />   (If (= (Tblsearch "layer" a) nil)<br />     (Command "layer" "m" a "c" b a "")<br />     (Command "layer" "t" a "s" a "c" b a "")<br />   )<br /> )

haojia

非常好用，太感谢了。人间冷暖，瞬间体现：）大家都用啊，很好用的！

xyp1964

试试签名栏下的“总图面积标注”程序！

小鱼儿

工作中非常实用,很爽啊。。方便很多啊

pglyxq

我把程序完善一下，更加人性化一点。
原来的程序在输入字高的时候，要经过换算字高，这样在出图以后才能得到标准的字高。因此，可不可以把它改为在输入字高的时候就输入出图后所需的字高。比如，图纸上标准的字高是5，打印出图比例是1：100，那么文字在图纸上的真实高度就应该是500高。如果每次都要这样换算的话是不是很麻烦啊。
(defun c:mj (/ pt pt1 en aa bl-bz)
  (cmdla0)
  (setq   tht (getreal "\n输入文字高度:")  ;输入出图后所需的字高
        pt  (getpoint "\n选取封闭域内一点: ")
  )
  (while pt
    (setq pt1 pt)
    (mkla "封闭域辅助线" 8)
    (command "bpoly" pt "")
    (setq en (entlast))
    (if        (/= en nil)
      (progn
        (command "area" "o" en)
        (setq aa (getvar "area"))
        (redraw en 3)
      )
    )
    (entdel en)
    (mkla "面积标注" 4)
    (setq aa (rtos (/ aa 1000000.0) 2 4))
    (command "text" "j" "mc" pt1 (* tht (getvar "dimscale"))  "0" aa) ;换算成真实的字高
    (setq pt (getpoint "\n选取封闭域内一点: "))
  )
  (cmdla1)
)
(defun CMDLA0 ()
  (setq cmdech (getvar "CMDECHO"))
  (setq oom (getvar "orthomode"))
  (setq osm (getvar "osmode"))
  (SETQ LA (getvar "clayer"))
  (setq rmode (getvar "regenmode"))
  (setvar "regenmode" 0)
  (setvar "CMDECHO" 0)
  (princ)
)

;;;
(defun CMDLA1 ()
  (setvar "CMDECHO" cmdech)
  (setvar "orthomode" oom)
  (setvar "osmode" osm)
  (setvar "clayer" LA)
  (setvar "regenmode" rmode)
  (princ)
)
(Defun MKLA (a b)
  (If (= (Tblsearch "layer" a) nil)
    (Command "layer" "m" a "c" b a "")
    (Command "layer" "t" a "s" a "c" b a "")
  )
)