[综合讨论] 将表链接到属性

Sub markdupfromxl()
Dim xlApp As Object
Dim xlFileName As String
Dim getval(), getval1() As String
Dim obj, entRef As AcadBlockReference
Dim instPt() As Double
Dim a, b As Integer
xlFileName = "C:\Documents and Settings\divekark\Desktop\test duplicates.xls"
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
Set xlbook = xlApp.workbooks.Open(xlFileName)
Set xlSheet = xlbook.Sheets(1)
a = xlSheet.UsedRange.Rows.Count
ReDim getval(a), getval1(a)
For b = 0 To a - 2
Set myrng = xlSheet.Range("A1")
getval(b) = myrng.Offset(b + 1, 0).Value
getval1(b) = myrng.Offset(b + 1, 1).Value
Set obj = ThisDrawing.HandleToObject(getval(b))
instPt = obj.InsertionPoint
Set entRef = ThisDrawing.ModelSpace.InsertBlock(instPt, "flage2", 1#, 1#, 1#, 0)
   If entRef.HasAttributes Then
       Dim AttList As Variant
       ' Build a list of attributes for the current block.
       AttList = entRef.GetAttributes
       ' Cycle throught the list of attributes.
       For j = LBound(AttList) To UBound(AttList)
           If AttList(j).TagString = "FLAGTEST" Then
               AttList(j).TextString = getval1(b)
           End If
       Next
   End If
Next
xlbook.Close
xlApp.Quit
Set xlbook = Nothing
Set xlSheet = Nothing
ThisDrawing.Activate
End Sub