Set acaddoc=Application.ActiveDocument
请看下面的例子对文件的操作:
Dim dwgname As String
dwgname = "c:\acadr14\sample\campus.dwg"
If Dir(dwgname) <> "" Then
acaddoc.Open dwgname '打开一个CAD文件
Else
acaddoc.new("acad") '以acad.dwt为模板建立一个新
文件
End If
Document对象还提供了两个十分有用的方法——SetVariable 和 GetVariable,通过它们可以得到或改变AutoCad的系统变量。
如:acaddoc.SetVariable "Orthomode", 1 '打开正交模式
dim cadver As String
cadver=acaddoc.Getvariable("Acadver") '获取AutoCad的版本号
3.对图形实体的自动操作(生成、编辑、查询)
图形实体指所有画在屏幕上的物体,如直线(Line)、圆(Circle)、弧(Arc)、多义线(PolyLine)、文字(Text)等,它们包含于ModelSpace和PaperSpace集合对象中,对实体的操作总要从这两个集合开始,向下查找相应实体的方法或属性。ModelSpace与PaperSpace的含义和AutoCad中类似,它们是所有图形实体的集合,要取得图中的某一实体,一般采用遍历或用实体句柄(Handle)查找的方法。用户可以操作AutoCad自动生成、编辑实体或查询实体参数。请看下例:
①生成一个轻量多义线(LightWeight PolyLine)
Dim lwpoly As Object
Dim ptarray(0 To 5) As Double '设坐标变量
ptarray(0) = 2
ptarray(1) = 4
ptarray(2) = 4
ptarray(3) = 2
ptarray(4) = 10
ptarray(5) = 4
Set lwpolyObj = moSpace.AddLightWeightPolyline(ptarray)
‘画多义线(以(2,4,4)(2,10,4)为端点)
②改变一个现有长方体的颜色(假设此实体句柄为"4C")
Dim tobj As object
Set tobj=acaddoc.HandletoObject("4C") '通过Handle来获取
实体
tobj.Color=acRed ‘变颜色为红色
tobj.Update ‘更新状态
③查询当前图形文件中所有实体的实体名、实体句柄、颜色、所在层、线形等参数
Dim ent As Object
Dim msgStr, NL As String
Dim I as Integer
NL = Chr(13) & Chr(10) ‘回车与换行
I=1
For Each ent in mospace '采用迭代遍历模型空间中的实体
msgStr = "第" & Format(I) & "个实体信息" & NL & NL
msgStr = msgStr & "实体名: " & ent.EntityName & NL
msgStr = msgStr & "所在层: " & ent.Layer & NL
msgStr = msgStr & "颜色: " & Str(ent.Color) & NL
msgStr = msgStr & "线形: " & ent.Linetype & NL
msgStr = msgStr & "句柄: " & ent.Handle & NL
MsgBox msgStr
I=I 1
Next
4.与用户交互
Utility对象提供了与用户在命令行交互的途径,可以让用户输入数字、字符串及角度、点坐标等参量。下面说明如何应用Utility交互替代AutoCad命令中的提示:
Dim acadUtil as Object
Dim stPnt, enPnt As Variant
Dim prompt1, prompt2 As String
Set acadUtil=acaddoc.Utility '设置Utility对象
prompt1 = "起始点: " ‘代替From Point
prompt2 = "终止点: " '代替End Point
stPnt = acadUtil.GetPoint(, prompt1)
enPnt = acadUtil.GetPoint(stPnt, prompt2)
'获得用户输入(既可输入坐标值,也可直接在屏幕上选点)
Dim startPoint(0 To 2) As Double
Dim endPoint(0 To 2) As Double
startPoint(0) = stPnt(0)
startPoint(1) = stPnt(1)
startPoint(2) = stPnt(2)
endPoint(0) = enPnt(0)
endPoint(1) = enPnt(1)
endPoint(2) = enPnt(2)
moSpace.AddLine startPoint, endPoint '利用用户输入生成直线
把系统变量设置SetVariable与Utility对象的GetString方法结合,即可向AutoCad的状态行写入内容:
Dim yourname as String
yourname = acadUtil.GetString(0, " 请输入您的姓名: ")
acaddoc.SetVariable "MODEMACRO", yourname & ", 你好!"
5.对非图形对象的操作
非图形对象如层(Layers)、视图(Viewports)、坐标系(UCSs)、块 (Blocks)等与图形实体集合ModelSpace、PaperSpace同是Document对象的子对象,它们本身既是对象,又是对象的集合,如Layers是当前打开的图中所有层的集合,使用Add方法来建立新层,并可以遍历所有层,通过改变其属性达到关闭(Off)、冻结层(Freeze)的目的.
①把层名为"wall"的层冻结,打开层名为"beam"的层,并设为当前层
Dim tlayer as Object
For Each tlayer In acaddoc.Layers
If tlayer.Name = "wall" Then
tlayer.Freeze = acTrue
Else If tlayer.Name="beam" Then
tlayer.LayerOn = acTrue
Set acaddoc.ActiveLayer = tlayer
End If
Next
②创建名为"myview"的新视图
可以通过ActiveX自动实现变换视图角度及缩放全图。
文章整理:西部数码--专业提供域名注册、虚拟主机服务
http://www.west263.com
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息,谢谢!




