[日积月累]：2006及以上才能用的Lisp动态面积程序

snoopychen

【学习]2006及以上才能用的Lisp动态面积程序

今天，到rkmcswain的网站http://rkmcswain.blogspot.com/上学习了一招，采用field来标注面积。
对于我这个还很喜欢用R14的老顽固来说，时不时还是得学学新东西，不然就太落伍了。
2007确实是个让人很着迷的版本，至少，它那可以象手绘效果一样的3维视觉模式加上中性色的着色模式让人觉得很舒服。动态的UCS

也是一个吸引人的地方。动态图块和域也是04没有的的功能。
今天，看到的这段程序是www.augi.com（一个不错的论坛）的rkmcswain在他的博客上写的。
虽然并不难，却也显示出Lisp也应该随着cad版本的增强与时俱进一下。虽然autodesk已经好久没有给lisp增加新内容了。

2. 
   
3. (vl-load-com)
   
4. ;;get a reference to model space
   
5. (setq *model-space*
   
6.        (vla-get-ModelSpace
   
7.          (vla-get-ActiveDocument (vlax-get-acad-object))
   
8.        )
   
9. )
   
10. ;;pass this function an entity and a point
    
11. (defun LinkedArea (ent pt / obj objID ip width str)
    
12.   ;;convert the entity to an object
    
13.   (setq obj   (vlax-ename->vla-object ent)
    
14.         ;;get the object ID
    
15.         objID (vla-get-objectid obj)
    
16.         ;;convert the point
    
17.         ip    (vlax-3D-Point pt)
    
18.         ;;set the width for the MTEXT
    
19.         width 0.0
    
20.         ;;set the string - this creates the field
    
21.         str   (strcat
    
22.                 "%<\\AcObjProp.16.2 Object(%<\\_ObjId "
    
23.                 (rtos objID 2 0)
    
24.                 ">%).Area \\f "%lu2%pr2%ps[, Acres]%ct8[2.295684113865932e-005]">%"
    
25.               )
    
26.   )
    
27.    ;;Create the MTEXT entity containing the field.
    
28.   (vla-addMText *model-space* ip width str)
    
29. )
    
30. 
    
31. ;;Then, you can call this function like this:
    
32. (defun c:test(/ a b)
    
33. ;; Set A = the entity and set B = Point for text
    
34. (setq a (car (entsel)) b (getpoint "\n Select Point: "))
    
35. ;;Call the function
    
36. (linkedarea a b)
    
37. )
    

<br /> (vl-load-com)<br /> ;;get a reference to model space<br /> (setq *model-space*<br />        (vla-get-ModelSpace<br />          (vla-get-ActiveDocument (vlax-get-acad-object))<br />        )<br /> )<br /> ;;pass this function an entity and a point<br /> (defun LinkedArea (ent pt / obj objID ip width str)<br />   ;;convert the entity to an object<br />   (setq obj   (vlax-ename->vla-object ent)<br />         ;;get the object ID<br />         objID (vla-get-objectid obj)<br />         ;;convert the point<br />         ip    (vlax-3D-Point pt)<br />         ;;set the width for the MTEXT<br />         width 0.0<br />         ;;set the string - this creates the field<br />         str   (strcat<br />                 "%<\\AcObjProp.16.2 Object(%<\\_ObjId "<br />                 (rtos objID 2 0)<br />                 ">%).Area \\f "%lu2%pr2%ps[, Acres]%ct8[2.295684113865932e-005]">%"<br />               )<br />   )<br />    ;;Create the MTEXT entity containing the field.<br />   (vla-addMText *model-space* ip width str)<br /> )<br /> <br /> ;;Then, you can call this function like this:<br /> (defun c:test(/ a b)<br /> ;; Set A = the entity and set B = Point for text<br /> (setq a (car (entsel)) b (getpoint "\n Select Point: "))<br /> ;;Call the function<br /> (linkedarea a b)<br /> )<br />

比如你可以画一个封闭的多义线图形。运行程序，选物体，点点。就会标示出图形的面积了（用英亩作单位的，可以修改）。当然，field的内容非常丰富，你可以改动一下得到更多的东西。
移动多义线的顶点，根据field的说法，它应该会自动更新，但是你可以发现面积并没有变化，不怕，regen一下就会变化了。
觉得field的底色灰蒙蒙的太难看，FIELDDISPLAY改动一下，变成无遮盖。

e2002

直接在 Text/Arttrib等对象中使用Field 可以完成很多以前只能想象的功能.

个人感觉 Field 的背景的显示还是不要关闭的为好,这样可以直接判断出这是一个 Field 而不与内容的其他部分混淆.实际上这个默认是打印不出来的(也可以改为不透明).

希望 Field/MText的Background 属性还可以强些: 设定透明度,颜色,是否显示外框...
希望 Text 对象能增加 Background 属性,要求同上...

雨箭风刀

有点象是一个集成的反应器，不过要regen不太爽

snoopychen

to e2002
Mtext的颜色倒是可以设置，不过其他确实和field一样都没有选项
Field的灰色底色让人看的不舒服

to刀兄
要regen确实不大象反应器，似乎不大智能。
不过现在看起来确实有些excel的概念了，比如field中的formular。

bridgewind

为什么不能用regen，必须update？

snoopychen

可能是系统变量fieldeval的问题
fieldeval:Controls how fields are updated.
0
Not updated

1
Updated on open

2
Updated on save

4
Updated on plot

8
Updated on use of ETRANSMIT

16
Updated on regeneration

tctabc

请问有办法将两组资料做加减运算吗?

jx2008

2006很膨大，安装运行起来感觉就像是一头大象，慢得很

rainlighter

对2006 我有同感！

laohuang

无语
不过毕竟是新的东西
可以见识见识