PDA

View Full Version : VBA SetXData to Entity Error



Andresig
1st Feb 2010, 10:34 pm
I am trying to Set Xdata to a object in a drawing, but indicates me that the method is failling, I am trying to understand how xdata works, if someone can tell what i am doing wrong...
thanks in advance:thumbsup:

Sub InputXData()
Dim AppNames() As String
Dim ANIsHere As Boolean

Dim Tn As String
Dim i As Integer
ANIsHere = False
For i = 0 To ThisDrawing.RegisteredApplications.Count - 1
ReDim Preserve AppNames(i)
AppNames(i) = ThisDrawing.RegisteredApplications.Item(i).Name
If AppNames(i) = "Panel_Data" Then ANIsHere = True
Next
If ANIsHere = False Then
ThisDrawing.RegisteredApplications.Add ("Panel_Data")
Else
End If
Dim TheObj As AcadObject
Dim xType(20) As Integer
Dim xValue(20) As Variant

Dim ssetObj As AcadSelectionSet
On Error Resume Next
ThisDrawing.SelectionSets("SS01").Clear
ThisDrawing.SelectionSets("SS01").Delete
On Error GoTo 0
Set ssetObj = ThisDrawing.SelectionSets.Add("SS01")
ssetObj.SelectOnScreen
Set TheObj = ssetObj.Item(0)
xType(0) = 1001: xValue(0) = "Panel_Data":
xType(1) = 1000: xValue(1) = "HH42" 'Name
xType(2) = 1050: xValue(2) = "hr4524c" 'Linked to label
xType(3) = 1070: xValue(3) = 3 ' total number of items
xType(4) = 1000: xValue(4) = "hr4524c"
xType(5) = 1070: xValue(5) = 1 ' position
xType(6) = 1000: xValue(6) = "c32r25" ' obj1 handle
xType(7) = 1000: xValue(7) = "No Info" ' obj2 handle
xType(8) = 1000: xValue(8) = "No Info" ' obj3 handle
xType(9) = 1000: xValue(9) = "No Info" ' obj4 handle
xType(10) = 1000: xValue(10) = "No Info" ' obj5 handle
xType(11) = 1000: xValue(11) = "hr4524c" ' Label1 handle
xType(12) = 1000: xValue(12) = "No Info" ' Label2 handle
xType(13) = 1000: xValue(13) = "No Info" ' Label3 handle
xType(14) = 1000: xValue(14) = "No Info" ' Label4 handle
xType(15) = 1000: xValue(15) = "No Info" ' Label5 handle
xType(16) = 1000: xValue(16) = "HH" ' Batch
xType(17) = 1000: xValue(17) = "3L" ' Material
xType(18) = 1000: xValue(18) = "3mm"
xType(19) = 1000: xValue(19) = "white"
xType(20) = 1000: xValue(20) = "C:\Drawings\Example.dwg"

On Error Resume Next
TheObj.SetXData xType, xValue
If Err.Number <> 0 Then
MsgBox Err.Number & vbCr & Err.Description
On Error GoTo 0
End If

ssetObj.Clear
ssetObj.Delete
End Sub

SEANT
1st Feb 2010, 11:59 pm
This line is causing a problem. Should it actually be a 1050 group code?


xType(2) = 1050: xValue(2) = "hr4524c" 'Linked to label

Andresig
2nd Feb 2010, 03:28 pm
That is correct SEANT, it should be :

xType(2) = 1005: xValue(2) = "hr4524c" 'Linked to label
Thank you !