Jump to content

VBA SetXData to Entity Error


Andresig

Recommended Posts

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( = 1000: xValue( = "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

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...