通信人家园

标题: 通信工程-lisp、vba编程与应用：Autolisp翻译VBA:写文字及选择圆变半径  [查看完整版帖子] [打印本页]

---

时间:  2018-10-26 15:29

作者: 水吉空     标题: 通信工程-lisp、vba编程与应用：Autolisp翻译VBA:写文字及选择圆变半径

VBA创建单行文字↓↓↓
Public Sub addtext()
Dim pt As Variant
Dim test As String
Dim higt As Double
pt = ThisDrawing.Utility.GetPoint(, "请选择文字插入点：")
test = "lisp翻译vba"
higt = 3
Dim tess As AcadText
Set tess = ThisDrawing.ModelSpace.addtext(test, pt, higt)
End Sub
autolisp翻译VBA创建单行文字↓↓↓
(defun c:tt (/ pt)
(setq pt (getpoint "请选择文字插入点："))
(Vlax-Invoke-Method (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'ModelSpace) 'AddText "lisp翻译vba" (Vlax-3d-Point pt) 3 )
(princ)   
)
相对于之下lisp写文字比vba写文字更加便捷和简单。用autolisp写文字建议不要用command函数，因为每个版本的text命令流会有所不同，容易出现错误。

--------------------------------------------------------------------

选择圆变半径

Public Sub by()

'选择圆半径变为原来的2倍

On Error Resume Next '出现错误接着往下走，但选择为空时

Dim ent As AcadEntity

Dim pt As Variant

ThisDrawing.Utility.GetEntity ent, pt, "请选择对象" '交互选择返回的对象就是定义的那个变量

If ent.ObjectName = "AcDbCircle" Then '判断选择的是不是圆

ent.Radius = ent.Radius * 2

Else

MsgBox ("您选择的不是圆")

End If

End Sub

(defun c:tt ()

        (vl-load-com)

        (defun *error* (msg)

                (alert "您没有选择到东西哦，请重新选择：")

                (princ msg)

                (princ)

        );错误函数没有继续往下走的功能，只有提示错误功能

        (setq ent (Vlax-Ename->Vla-Object (car (entsel "请选择对象"))))

        (if (= (Vlax-Get ent 'ObjectName ) "AcDbCircle")

                (Vlax-Put-Property ent 'Radius (* (Vlax-Get ent 'Radius ) 2) )

                (alert "你选择的不是圆")

        )

        (princ)

)

附件: QQ截图20181026151518.jpg (2018-10-26 15:28, 31.49 KB) / 下载次数 0
https://www.txrjy.com/forum.php?mod=attachment&aid=Mzc2ODQ4fDJjZDQ3N2UwfDE3NTQxNTcwODl8MHww

---

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

Powered by C114