VLISP应用两例源码解析（视口锁定，求多边形形心与面积）

林霄云

VLISP应用两例源码解析（视口锁定，求多边形形心与面积）
Vlisp入手快，更加形象。在某些属性获取与修改更新方面，比autolisp更为直观。特举例说明。
第一
视口锁定，对于autolisp，根据dxf资料，entities段，VIEWPORT，其视口显示锁定的组码为90，当包括16384 (0x4000) = 启用视口缩放锁定。如果要获取是否设置了该位，需要将90组码值与0x4000进行按位与运算。为1时，设置了锁定。相当繁琐且代码可读性差。
对于vlisp，使用dump操作，取得视口对象的属性方法表。

2. (defun C:dump(/ ent obj)
   
3.   (while (setq ent(entsel "\nSelect entity to get object data:"))
   
4.   (setq obj (vlax-ename->vla-object(car ent)))
   
5.   (vlax-dump-object obj T)
   
6.   (vlax-release-object obj)
   
7.     )
   
8.   (princ)
   
9.   )

(defun C:dump(/ ent obj)<br />   (while (setq ent(entsel "\nSelect entity to get object data:"))<br />   (setq obj (vlax-ename->vla-object(car ent)))<br />   (vlax-dump-object obj T)<br />   (vlax-release-object obj)<br />     )<br />   (princ)<br />   )

得到列表如下：

1. IAcadPViewport2: IAcadPViewport 接口
   
2. ;特性值:
   
3. ;   Application (RO) = #<VLA-OBJECT IAcadApplication 00eeb450>
   
4. ;   ArcSmoothness = 1000
   
5. ;   Center = (420.5 633.25 0.0)
   
6. ;   Clipped (RO) = 0
   
7. ;   CustomScale = 0.00666667
   
8. ;   Direction = (0.0 0.0 1.0)
   
9. ;   DisplayLocked = -1
   
10. ;   Document (RO) = #<VLA-OBJECT IAcadDocument 0340c954>
    
11. ;   EntityTransparency = "ByLayer"
    
12. ;   GridOn = 0
    
13. ;   Handle (RO) = "17193"
    
14. ;   HasExtensionDictionary (RO) = -1
    
15. ;   HasSheetView (RO) = 0
    
16. ;   Height = 1086.5
    
17. ;   Hyperlinks (RO) = #<VLA-OBJECT IAcadHyperlinks 5097e804>
    
18. ;   LabelBlockId = 0
    
19. ;   Layer = "0"
    
20. ;   LayerPropertyOverrides (RO) = 0
    
21. ;   LensLength = 50.0
    
22. ;   Linetype = "ByLayer"
    
23. ;   LinetypeScale = 1.0
    
24. ;   Lineweight = -1
    
25. ;   Material = "ByLayer"
    
26. ;   ModelView = nil
    
27. ;   ObjectID (RO) = 2127793880
    
28. ;   ObjectName (RO) = "AcDbViewport"
    
29. ;   OwnerID (RO) = 2127654608
    
30. ;   PlotStyleName = "ByLayer"
    
31. ;   ShadePlot = 0
    
32. ;   SheetView = nil
    
33. ;   SnapBasePoint = (0.0 0.0)
    
34. ;   SnapOn = 0
    
35. ;   SnapRotationAngle = 0.0
    
36. ;   StandardScale = 1
    
37. ;   StandardScale2 = 4
    
38. ;   Target = (0.0 0.0 0.0)
    
39. ;   TrueColor = #<VLA-OBJECT IAcadAcCmColor 2c7ec540>
    
40. ;   TwistAngle = 0.0
    
41. ;   UCSIconAtOrigin = -1
    
42. ;   UCSIconOn = -1
    
43. ;   UCSPerViewport = -1
    
44. ;   ViewportOn = -1
    
45. ;   Visible = -1
    
46. ;   VisualStyle = 1
    
47. ;   Width = 821.0
    
48. ;支持的方法:
    
49. ;   ArrayPolar (3)
    
50. ;   ArrayRectangular (6)
    
51. ;   Copy ()
    
52. ;   Delete ()
    
53. ;   Display (1)
    
54. ;   GetBoundingBox (2)
    
55. ;   GetExtensionDictionary ()
    
56. ;   GetGridSpacing (2)
    
57. ;   GetSnapSpacing (2)
    
58. ;   GetXData (3)
    
59. ;   Highlight (1)
    
60. ;   IntersectWith (2)
    
61. ;   Mirror (2)
    
62. ;   Mirror3D (3)
    
63. ;   Move (2)
    
64. ;   Rotate (2)
    
65. ;   Rotate3D (3)
    
66. ;   ScaleEntity (2)
    
67. ;   SetGridSpacing (2)
    
68. ;   SetSnapSpacing (2)
    
69. ;   SetXData (2)
    
70. ;   SyncModelView ()
    
71. ;   TransformBy (1)
    
72. ;   Update ()
    
73. T

复制代码

很容易判断出属性为 DisplayLocked  
使用

1. vlax-get-property与vlax-put-property便可完成设置

复制代码

代码如下：

2. (defun C:VCF( / enobj vallist n lockflag)
   
3. ;Designed by 林霄云 2014年4月18日
   
4. ;视口显示锁定与解锁循环
   
5. (if (and (setq en (entsel "选择视口"))
   
6.      (= (get-dxf 0 (setq en (car en))) "VIEWPORT")
   
7.      )
   
8.      (progn
   
9.      (setq enobj (vlax-ename->vla-object en))
   
10.      (setq lockflag (vlax-get-property enobj "DisplayLocked"))
    
11.      (princ (strcat "所选视口显示锁定状态为"  (vl-princ-to-string lockflag)))
    
12.      (if (= lockflag :vlax-true)
    
13.      (progn (vlax-put-property enobj "DisplayLocked" :vlax-false) (princ "\n所选视口显示锁定状态修改为：否——视口解锁"  ))
    
14.      (progn (vlax-put-property enobj "DisplayLocked" :vlax-true)  (princ "\n所选视口显示锁定状态修改为：是——视口锁定"  ))
    
15.      );if
    
16.      );progn
    
17. );if
    
18. 
    
19. (princ)
    
20. );defun
    

(defun C:VCF( / enobj vallist n lockflag)<br /> ;Designed by 林霄云 2014年4月18日 <br /> ;视口显示锁定与解锁循环<br /> (if (and (setq en (entsel "选择视口"))<br />      (= (get-dxf 0 (setq en (car en))) "VIEWPORT")<br />      )<br />      (progn<br />      (setq enobj (vlax-ename->vla-object en))<br />      (setq lockflag (vlax-get-property enobj "DisplayLocked"))<br />      (princ (strcat "所选视口显示锁定状态为"  (vl-princ-to-string lockflag)))<br />      (if (= lockflag :vlax-true)<br />      (progn (vlax-put-property enobj "DisplayLocked" :vlax-false) (princ "\n所选视口显示锁定状态修改为：否——视口解锁"  ))<br />      (progn (vlax-put-property enobj "DisplayLocked" :vlax-true)  (princ "\n所选视口显示锁定状态修改为：是——视口锁定"  ))<br />      );if<br />      );progn<br /> );if<br /> <br /> (princ)<br /> );defun<br />

第二
获取多边形形心与面积
形心与面积是面域的属性。可以将多边形（封闭可转换成面域的）转换后，读取相应属性即可。
代码如下：

2. (defun C:xingxin()
   
3. (setq en (car(entsel "\n选取闭合曲线:")))
   
4. ;(setvar "DELOBJ" 1)
   
5. (if ( /= (get-dxf 0 en) "REGION")
   
6. (progn
   
7. (command "region" en "")
   
8. (setq en (entlast))
   
9. ));if
   
10. 
    
11. (setq   
    
12. ENT (vlax-ename->vla-object en)
    
13. CEN (vlax-get ENT "centroid")
    
14. AREA (vlax-get ENT "AREA"))
    
15. (princ (strcat "\narea: " (rtos area 2 3)))
    
16. (princ (strcat "\ncentroid: " (vl-princ-to-string cen )))
    
17. (command "point" CEN )
    
18. (princ)
    
19.   )

(defun C:xingxin()<br /> (setq en (car(entsel "\n选取闭合曲线:")))<br /> ;(setvar "DELOBJ" 1)<br /> (if ( /= (get-dxf 0 en) "REGION")<br /> (progn<br /> (command "region" en "")<br /> (setq en (entlast))<br /> ));if<br /> <br /> (setq   <br /> ENT (vlax-ename->vla-object en)<br /> CEN (vlax-get ENT "centroid")<br /> AREA (vlax-get ENT "AREA"))<br /> (princ (strcat "\narea: " (rtos area 2 3)))<br /> (princ (strcat "\ncentroid: " (vl-princ-to-string cen )))<br /> (command "point" CEN )<br /> (princ)<br />   )

值得注意的是，该获取的坐标CEN，是UCS坐标系下的，故该程序支持UCS。
附带的get-dxf函数：

2. ;;get-DXF 实体dxf数据 (get-DXF code ename)
   
3. ;;get-dxf code ename， Designed by 林霄云。精简自e派。进行判断的，ename必须ename。
   
4. (defun get-DXF (code ename )
   
5. (cond ((= (type ename) 'ENAME)
   
6.       (if        (= code -3)
   
7.       (cdr (assoc code (entget ename '("*"))))
   
8.       (cdr (assoc code (entget ename)))
   
9.     ))
   
10.   );COND
    
11. )

;;get-DXF 实体dxf数据 (get-DXF code ename)<br /> ;;get-dxf code ename， Designed by 林霄云。精简自e派。进行判断的，ename必须ename。<br /> (defun get-DXF (code ename )<br /> (cond ((= (type ename) 'ENAME)<br />       (if        (= code -3)<br />       (cdr (assoc code (entget ename '("*"))))<br />       (cdr (assoc code (entget ename)))<br />     ))<br />   );COND<br /> )

zyhandw

不错，适合新手看。
不过，从你的标题看不出你是要做什么。

Student

非常不错的实例，很有用。
学习了！

liuhaixin88

林大哥，代码不是贴出来了，为什么还要贴附件收币
看大哥分析的蛮透彻的，我有个问题想求教
点取多行文字时，只取多行文字内容包括换行符\P, 其它的属性过滤掉，请大哥支招，谢谢！

林霄云

2. (command "point" CEN )

(command "point" CEN )

此句仍应修改为

2. (command "point" "non" CEN )

(command "point" "non" CEN )

峰云于雾

学习学习

305341043

感谢，不错的案例

305341043

不过，尝试没成功

LIULISHENG

支持学习一下

qq1254582201

好东西哦留存一下