- 积分
- 174
- 明经币
- 个
- 注册时间
- 2011-9-22
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
对AutoCAD VBA 编程是一个初学者,现在正在编辑一个程序,数据库用的是Access,文件名A.MDB,CAD块的文件名B.dwg;块在文件B.dwg已经定义好了,想编辑一个程序把access数据库里对应的”位号坐标“的X/Y坐标撒点到AUTOCAD里,不知道怎么实现,请高手们指点一二,拜谢了!!!
我的编程思路大概是这样:先创建一个选择集程序,设定范围,设定完之后在进行插入块;选择集的程序做好了
Sub Select_Polygon()
Dim SSet As AcadSelectionSet
Dim SSetObj As Object
On Error Resume Next
Dim fType(0 To 1) As Integer
Dim fData(0 To 1) As Variant
If Not IsNull(ThisDrawing.SelectionSets.Item("BlockCount")) Then
Set SSet = ThisDrawing.SelectionSets.Item("BlockCount")
SSet.Delete
End If
Set SSet = ThisDrawing.SelectionSets.Add("BlockCount")
fType(0) = 0: fData(0) = "Insert"
fType(1) = 2: fData(1) = "Text_Block"
Dim pT1(0 To 2) As Double
Dim pT2(0 To 2) As Double
Dim Attr_Tag(0 To 1) As String
Dim Attr_Text(0 To 1) As String
Attr_Tag(0) = "A1": Attr_Tag(1) = "B1"
Attr_Text(0) = "Tag_No": Attr_Text(1) = "FT_x01"
pT1(0) = 0: pT1(1) = 0
pT2(0) = 500: pT2(1) = 500
SSet.Select acSelectionSetWindow, pT1, pT2, fType, fData
Dim EntObj As AcadEntity
Dim BlockRefObj As AcadBlockReference
Dim Mtextobj As AcadBlockReference
For Each EntObj In SSet
If TypeOf EntObj Is AcadBlockReference Then
Set Mtextobj = EntObj
If Mtextobj.TextString = "Here is title" Then
Exit For
Else
Exit Sub
End If
End If
Next
Dim AA As String
For Each EntObj In SSet
If TypeOf EntObj Is AcadBlockReference Then
Set BlockRefObj = EntObj
If BlockRefObj.HasAttributes Then
Attrefs = BlockRefObj.GetAttributes
For i = 0 To UBound(Attrefs)
AA = AA & Attrefs(i).TextString
MsgBox AA
Next
End If
End If
Next
End Sub
但是下来插入块怎么实现
|
本帖子中包含更多资源
您需要 登录 才可以下载或查看,没有账号?注册
x
|