明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 4539|回复: 10

[讨论] VLISP应用两例源码解析(视口锁定,求多边形形心与面积)

[复制链接]
发表于 2014-4-18 01:54 | 显示全部楼层 |阅读模式
VLISP应用两例源码解析(视口锁定,求多边形形心与面积)
Vlisp入手快,更加形象。在某些属性获取与修改更新方面,比autolisp更为直观。特举例说明。
第一
视口锁定,对于autolisp,根据dxf资料,entities段,VIEWPORT,其视口显示锁定的组码为90,当包括16384 (0x4000) = 启用视口缩放锁定。如果要获取是否设置了该位,需要将90组码值与0x4000进行按位与运算。为1时,设置了锁定。相当繁琐且代码可读性差。
对于vlisp,使用dump操作,取得视口对象的属性方法表。
  1. (defun C:dump(/ ent obj)
  2.   (while (setq ent(entsel "\nSelect entity to get object data:"))
  3.   (setq obj (vlax-ename->vla-object(car ent)))
  4.   (vlax-dump-object obj T)
  5.   (vlax-release-object obj)
  6.     )
  7.   (princ)
  8.   )
得到列表如下:
  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便可完成设置
复制代码
代码如下:
  1. (defun C:VCF( / enobj vallist n lockflag)
  2. ;Designed by 林霄云 2014年4月18日
  3. ;视口显示锁定与解锁循环
  4. (if (and (setq en (entsel "选择视口"))
  5.      (= (get-dxf 0 (setq en (car en))) "VIEWPORT")
  6.      )
  7.      (progn
  8.      (setq enobj (vlax-ename->vla-object en))
  9.      (setq lockflag (vlax-get-property enobj "DisplayLocked"))
  10.      (princ (strcat "所选视口显示锁定状态为"  (vl-princ-to-string lockflag)))
  11.      (if (= lockflag :vlax-true)
  12.      (progn (vlax-put-property enobj "DisplayLocked" :vlax-false) (princ "\n所选视口显示锁定状态修改为:否——视口解锁"  ))
  13.      (progn (vlax-put-property enobj "DisplayLocked" :vlax-true)  (princ "\n所选视口显示锁定状态修改为:是——视口锁定"  ))
  14.      );if
  15.      );progn
  16. );if

  17. (princ)
  18. );defun
第二
获取多边形形心与面积
形心与面积是面域的属性。可以将多边形(封闭可转换成面域的)转换后,读取相应属性即可。
代码如下:
  1. (defun C:xingxin()
  2. (setq en (car(entsel "\n选取闭合曲线:")))
  3. ;(setvar "DELOBJ" 1)
  4. (if ( /= (get-dxf 0 en) "REGION")
  5. (progn
  6. (command "region" en "")
  7. (setq en (entlast))
  8. ));if

  9. (setq   
  10. ENT (vlax-ename->vla-object en)
  11. CEN (vlax-get ENT "centroid")
  12. AREA (vlax-get ENT "AREA"))
  13. (princ (strcat "\narea: " (rtos area 2 3)))
  14. (princ (strcat "\ncentroid: " (vl-princ-to-string cen )))
  15. (command "point" CEN )
  16. (princ)
  17.   )
值得注意的是,该获取的坐标CEN,是UCS坐标系下的,故该程序支持UCS。
附带的get-dxf函数:
  1. ;;get-DXF 实体dxf数据 (get-DXF code ename)
  2. ;;get-dxf code ename, Designed by 林霄云。精简自e派。进行判断的,ename必须ename。
  3. (defun get-DXF (code ename )
  4. (cond ((= (type ename) 'ENAME)
  5.       (if        (= code -3)
  6.       (cdr (assoc code (entget ename '("*"))))
  7.       (cdr (assoc code (entget ename)))
  8.     ))
  9.   );COND
  10. )

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

评分

参与人数 1明经币 +2 金钱 +12 收起 理由
Gu_xl + 2 + 12 赞一个!

查看全部评分

"觉得好,就打赏"
还没有人打赏,支持一下

本帖被以下淘专辑推荐:

  • · excel|主题: 80, 订阅: 2
发表于 2014-4-18 08:09 | 显示全部楼层
不错,适合新手看。
不过,从你的标题看不出你是要做什么。

点评

括号里说明了两个案例的名称,看不出来么?  发表于 2014-4-18 09:22
发表于 2014-4-18 09:07 | 显示全部楼层
非常不错的实例,很有用。
学习了!
发表于 2014-4-18 09:16 | 显示全部楼层
林大哥,代码不是贴出来了,为什么还要贴附件收币
看大哥分析的蛮透彻的,我有个问题想求教
点取多行文字时,只取多行文字内容包括换行符\P, 其它的属性过滤掉,请大哥支招,谢谢!

点评

是不是这个(ssget '((0 . "MTEXT")(1 . "*\\P*")))  发表于 2014-5-4 15:33
不是所有人都来得及看清代码。有时候我反过头看自己的代码的时候,会有惊觉,当时怎么想得这么周到。人慢慢的不在乎代码了,而在乎结果。  发表于 2014-4-18 09:27
 楼主| 发表于 2014-5-4 13:08 | 显示全部楼层
  1. (command "point" CEN )
此句仍应修改为
  1. (command "point" "non" CEN )
发表于 2016-7-27 16:50 | 显示全部楼层
学习学习
发表于 2017-12-29 19:34 | 显示全部楼层
感谢,不错的案例
发表于 2017-12-29 19:54 | 显示全部楼层
不过,尝试没成功
发表于 2018-1-2 09:15 | 显示全部楼层
支持学习一下
发表于 2020-3-7 00:05 来自手机 | 显示全部楼层
好东西哦留存一下
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-5-19 03:52 , Processed in 0.225081 second(s), 34 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表