设为首页收藏本站

晓东CAD家园-论坛

 找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 190|回复: 0

[其他] LISP构建variant array 和 safearray 数组

[复制链接]

已领礼包: 145个

财富等级: 日进斗金

发表于 2021-1-13 02:43:30 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

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

x
Constructing a variant array and safearray in LISP

问题:

Several ActiveX objects require that Arrays be used in LISP, however, I do not
understand how to implement them correctly since they are different from a list.
Is there an example that constructs and deconstructs a variant array ?

解答:

There are several solutions that show how to construct objects via ActiveX that
require the use of variant arrays, look at DevNote TS16152 and DevNote TS57438
for complete examples.

The following code details how to construct a variant array:

  1. ;;;Make the Variant Array:

  2. ; First Create a SafeArray by identifying the Type, and the Array Dimension
  3. ; In this example it's a 2 dimensional array of objects

  4. (setq aSafeArray (vlax-make-safearray vlax-vbobject '(0 . 1)))

  5. ; Add the first object 'lineobj' to the SafeArray
  6. (vlax-safearray-put-element aSafeArray 0 lineobj)
  7. ; Add the second object 'arcobj' to the SafeArray
  8. (vlax-safearray-put-element aSafeArray 1 arcobj)

  9. ; Create a Variant Array from the Safe Array
  10. (setq VariantArrayOfObjects (vlax-make-variant aSafeArray (logior vlax-vbarray
  11. vlax-vbobject)))

  12. ; Next let's Create another Variant
  13. ; First Create an Empty Two Dimensional SafeArray of Integers
  14. (setq nilSafeArray (vlax-make-safearray vlax-vbinteger '(0 . 1)))

  15. ; Create a Variant Array Using That Empty SafeArray
  16. (setq inoutVarArray (vlax-make-variant nilSafeArray (logior vlax-vbarray
  17. vlax-vbinteger)))

  18. ; Populate that Empty Array, and return an Array of Objects with the CopyObjects
  19. Method
  20. (setq retnArray (vla-CopyObjects AcadDocument VariantArrayOfObjects *ModelSpace*
  21. inoutVarArray))
  22. And here's a code that will deconstruct the returned Variant Array:


  23. ;;;Deconstruct the variant array:

  24. ; Convert the Variant Array to SafeArray, and then to a List
  25. (setq varLen (length (setq rtnLst (vlax-safearray->list (vlax-variant-value
  26. retnArray)))))

  27. ; Process the List of Objects

  28. (if (> varlen 0)
  29. (mapcar '(lambda (x)
  30.      (vla-Move x (vlax-3d-point '(1.0 1.0 0.0)) (vlax-3d-point '(5.0 1.0 0.0)))
  31.      (vla-Put-Color x acRed)
  32.      )
  33. rtnLst
  34. )
  35. )
  36. For more information on Variant Data Types see DevNote #53397 and <Solution
  37. 53398>.

  38. The preceding code is not used here in a complete example:


  39. (defun RunCopyTest (/ AcadApplication AcadDocument *ModelSpace* aSafeArray
  40. lineObj arcObj rtn
  41.             VariantArrayOfObjects nilSafeArray inoutVarArray retnArray
  42. varLen rtnLst)
  43.   (vl-load-com)
  44.   (setq AcadApplication (vlax-get-Acad-Object))
  45.   (setq AcadDocument (vla-get-ActiveDocument AcadApplication))
  46.   (setq *ModelSpace*  (vla-get-ModelSpace AcadDocument))
  47. ; Add a Line
  48.   (setq lineObj (vla-AddLine *ModelSpace*  (vlax-3d-point '(1.0 1.0 0.0))
  49. (vlax-3d-point '(5.0 5.0 0.0))))
  50.   (vla-Put-Color lineObj acBlue)
  51. ; Add an Arc
  52.   (setq arcObj (vla-AddArc *ModelSpace* (vlax-3d-point '(5.0 3.0 0.0)) 2.0  0.0
  53. pi))
  54.   (vla-Put-Color arcObj acBlue)
  55.   (vla-ZoomExtents AcadApplication)

  56. (initget "Yes No")
  57. (setq rtn (getkword "\nNow Create the Copy <Y/n>:"))

  58. (if (equal rtn "Yes")
  59.    (progn

  60. ;;;Make the Variant Array:

  61. ; First Create a SafeArray by identifying the Type, and the Array Dimension
  62. ; In this example it's a 2 dimensional array of objects

  63.      (setq aSafeArray (vlax-make-safearray vlax-vbobject '(0 . 1)))

  64. ; Add the first object 'lineobj' to the SafeArray
  65.      (vlax-safearray-put-element aSafeArray 0 lineobj)
  66. ; Add the second object 'arcobj' to the SafeArray
  67.      (vlax-safearray-put-element aSafeArray 1 arcobj)

  68. ;; Important - Create a Variant Array of vlax-vbobjects
  69. ; Create a Variant Array from the Safe Array
  70.      (setq VariantArrayOfObjects (vlax-make-variant aSafeArray (logior
  71. vlax-vbarray vlax-vbobject)))

  72. ; Next let's Create another SafeArray
  73. ; Create an Empty Two Dimensional SafeArray of Integers
  74.      (setq nilSafeArray (vlax-make-safearray vlax-vbinteger '(0 . 1)))

  75. ; Create a Variant Array Using That Empty SafeArray
  76.      (setq inoutVarArray (vlax-make-variant nilSafeArray (logior vlax-vbarray
  77. vlax-vbinteger)))

  78. ; Populate that Empty Array, and return an Array of Objects with the CopyObjects
  79. Method
  80. ;; Now Copy the objects here:
  81.      (setq retnArray (vla-CopyObjects AcadDocument VariantArrayOfObjects
  82. *ModelSpace* inoutVarArray))

  83. ;;;Deconstruct the variant array:

  84. ; Convert the Variant Array to SafeArray, and then to a List
  85.      (setq varLen (length (setq rtnLst (vlax-safearray->list
  86. (vlax-variant-value retnArray)))))

  87. ; Process the List of Objects
  88. ;; Move the new objects, and give them a different color:
  89.      (if (> varlen 0)
  90.        (mapcar
  91.          '(lambda (x)
  92.         (vla-Move x (vlax-3d-point '(1.0 1.0 0.0)) (vlax-3d-point '(7.0
  93. 3.0 0.0)))
  94.         (vla-Put-Color x acYellow)
  95.           )
  96.         rtnLst
  97.        )
  98.      )
  99.      (vla-ZoomExtents AcadApplication)
  100.     )
  101.   )

  102. ;;; Release the Objects
  103. (if arcObj (if (null (vlax-object-released-p arcObj)) (progn
  104. (vlax-release-object arcObj) (setq arcObj nil))) )
  105. (if lineObj (if (null (vlax-object-released-p lineObj)) (progn
  106. (vlax-release-object lineObj) (setq lineObj nil))) )
  107. (if *ModelSpace* (if (null (vlax-object-released-p *ModelSpace*)) (progn
  108. (vlax-release-object *ModelSpace*) (setq *ModelSpace* nil))) )
  109. (if AcadDocument (if (null (vlax-object-released-p AcadDocument)) (progn
  110. (vlax-release-object AcadDocument) (setq AcadDocument nil))) )
  111. (if AcadApplication (if (null (vlax-object-released-p AcadApplication)) (progn
  112. (vlax-release-object AcadApplication) (setq AcadApplication nil))) )

  113. (princ)
  114. )

  115. (princ "\nRunCopyTest loaded, type (RunCopyTest) to run.")
  116. (princ)


论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|小黑屋|手机版|Archiver|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )  

GMT+8, 2021-4-20 01:01 , Processed in 0.333392 second(s), 25 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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