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自动实现变换视图角度及缩放全图。
Public Sub changeview(ByVal x, ByVal y, ByVal z)
Dim newDirection(0 To 2) As Double
Dim vport As Object
acaddoc.ActiveSpace = acModelSpace ‘使ModelSpace成为活动
　　　　　　　　　　　　　　　　　　 空间
Set vport = acaddoc.Viewports.Add("newview") ‘建立新视图
newDirection(0) = x
newDirection(1) = y
newDirection(2) = z　‘视图的视角方向
vport.Direction = newDirection
acaddoc.ActiveViewport = vport　‘把新视图激活
acaddoc.ActiveViewport.ZoomAll　‘全图显示
End Sub
以上例程是对Layers、Viewports对象的举例，其他非图形对象的引用与此类似。

 2/2   首页 上一页 1 2