通信人家园

 找回密码
 注册

只需一步,快速开始

短信验证,便捷登录

搜索

军衔等级:

  一级军士长

注册:2014-7-1633
跳转到指定楼层
1#
发表于 2018-10-26 15:29:42 |只看该作者 |倒序浏览
QQ截图20181026151518.jpg
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)
)


举报本楼

您需要登录后才可以回帖 登录 | 注册 |

版规|手机版|C114 ( 沪ICP备12002291号-1 )|联系我们 |网站地图  

GMT+8, 2025-8-2 17:34 , Processed in 0.210546 second(s), 20 queries , Gzip On.

Copyright © 1999-2025 C114 All Rights Reserved

Discuz Licensed

回顶部