通信人家园

标题: AUTOlisp开发CAD转战VBA开发CAD第二天 [查看完整版帖子] [打印本页]

时间: 2018-10-16 17:28

作者: 水吉空 标题: AUTOlisp开发CAD转战VBA开发CAD第二天

本帖最后由水吉空于 2018-10-17 13:01 编辑

用VBA创建矩形 lisp翻译VBA创建矩形
QQ截图20181016170434.jpg

'自定义函数，求出4点的坐标（用数组表示）
Public Function rec(pt1 As Variant, pt2 As Variant) As AcadLWPolyline 'AcadLWPolyline优化多段线
Dim ptarr(7) As Double '定义一个数组
ptarr(0) = pt1(0): ptarr(1) = pt1(1)
ptarr(2) = pt1(0): ptarr(3) = pt2(1)
ptarr(4) = pt2(0): ptarr(5) = pt2(1)
ptarr(6) = pt2(0): ptarr(7) = pt1(1)
Dim recc As AcadLWPolyline
Set recc = ThisDrawing.ModelSpace.AddLightWeightPolyline(ptarr) '数组AddLightWeightPolyline由顶点列表创建优化多段线。
recc.Closed = True
End Function
创建矩形
Public Sub reccc()
Dim pt1 As Variant
Dim pt2 As Variant
pt1 = ThisDrawing.Utility.GetPoint(, "请选择第一个点：")
pt2 = ThisDrawing.Utility.GetCorner(pt1, "请选择对角点：")
rec pt1, pt2
End Sub

AUTOLISP翻译VBA↓↓↓

;求出4点的坐标
(defun c:tt (/ lstt pt0 pt0_1 pt1 pt2 pt3 pt4 recc safe safe_lstt var_safe)
(vl-load-com)
(setq pt0 (getpoint "请选择第一个点：")
pt0_1 (getcorner pt0 "请选择对角点：")
pt1 (list (car pt0) (cadr pt0))
pt2 (list (car pt0_1) (cadr pt0_1))
pt3 (list (car pt0) (cadr pt0_1))
pt4 (list (car pt0_1) (cadr pt0)))
;画矩形，VBA调用AddLightWeightPolyline方法后面必须是Variant[变体] (双精度数组)
;所以关键是需要在lisp中先创建双精度数组，然后把点表放进数组里，最后转化为数组型变体,调用AddLightWeightPolyline方法就能成功。
(setq lstt (append pt1 pt3 pt2 pt4))
(setq safe (vlax-make-safearray vlax-vbDouble '(0 . 7)));创建一个Double类型的维数组
(setq safe_lstt(vlax-safearray-fill safe lstt));把值表加入安全数组。
(setq var_safe (vlax-make-variant safe_lstt));构建一个安全数组的变体
(setq recc (Vlax-Invoke-Method (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'ModelSpace) 'AddLightWeightPolyline var_safe));调用AddLightWeightPolyline方法
(Vlax-Put-Property recc 'Closed -1)
(princ)
)

====================水吉空出品===================

附件: QQ截图20181016170434.jpg (2018-10-16 17:27, 31.22 KB) / 下载次数 0
https://www.txrjy.com/forum.php?mod=attachment&aid=Mzc1Njk3fDE2MmMxYWM4fDE3NTMxMjgxMjB8MHww

附件: 通信工程与CAD.jpg (2018-10-16 17:28, 8.29 KB) / 下载次数 0
https://www.txrjy.com/forum.php?mod=attachment&aid=Mzc1Njk4fDVjODkzZTk5fDE3NTMxMjgxMjB8MHww

时间: 2018-11-9 10:45

作者: zhaoruishengnmg

大牛！

通信人家园 (https://www.txrjy.com/)