youry8007 发表于 2011-10-26 10:54:05

新人请教问题,请高手们帮帮我

本帖最后由 youry8007 于 2011-10-26 11:17 编辑

对AutoCAD VBA 编程是一个初学者,现在正在编辑一个程序,数据库用的是Access,文件名A.MDB,CAD块的文件名B.dwg;块在文件B.dwg已经定义好了,想编辑一个程序把access数据库里对应的”位号坐标“的X/Y坐标撒点到AUTOCAD里,不知道怎么实现,请高手们指点一二,拜谢了!!!

youry8007 发表于 2011-10-26 11:59:49

我的编程思路大概是这样:先创建一个选择集程序,设定范围,设定完之后在进行插入块;选择集的程序做好了
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
但是下来插入块怎么实现

youry8007 发表于 2011-10-26 12:00:57

高手们还有斑竹请帮忙,谢谢了

youry8007 发表于 2011-10-26 12:01:34

高手们还有斑竹请帮忙,谢谢了
页: [1]
查看完整版本: 新人请教问题,请高手们帮帮我