Topic: advanced challenge!

[Keith™]

ThisDrawing code

Code: [Select]


Private Sub AcadDocument_BeginDoubleClick(ByVal PickPoint As Variant)
 Dim AcadObj As AcadEntity
 Dim AcadDim As AcadDimension
 Dim SelSet As AcadSelectionSet
 
 PickPoint = ThisDrawing.Utility.TranslateCoordinates(PickPoint, acWorld, acUCS, False)
 
 On Error GoTo ClearOut
 Set SelSet = ThisDrawing.SelectionSets.Add("ClickReactor")
 SelSet.SelectAtPoint PickPoint
 For Each AcadObj In SelSet
  If AcadObj.ObjectName = "AcDbLine" Then
   Module1.UpDate AcadObj
  End If
 Next AcadObj
ClearOut:
ThisDrawing.SelectionSets.Item("ClickReactor").Delete
End Sub





Module1 Code

Code: [Select]


Sub ChallengeLine()
 Dim Point1 As AcadPoint
 Dim Point2 As AcadPoint
 Dim MyLine As AcadEntity
 Dim IPoint(2) As Double
 Dim BlockExists As Boolean
 Dim XDType(0 To 2) As Integer
 Dim XDValue(0 To 2) As Variant
 
 XDType(0) = 1001
 XDType(1) = 1005
 XDType(2) = 1005
 
 XDValue(0) = "ChallengeLine"
 PT1 = ThisDrawing.Utility.GetPoint
 PT2 = ThisDrawing.Utility.GetPoint
 
 Set MyLine = ThisDrawing.ModelSpace.AddLine(PT1, PT2)
 Set Point1 = ThisDrawing.ModelSpace.AddPoint(PT1)
 Set Point2 = ThisDrawing.ModelSpace.AddPoint(PT2)
 
 XDValue(1) = Point1.Handle
 XDValue(2) = Point2.Handle
 MyLine.SetXData XDType, XDValue
 
 XDValue(1) = MyLine.Handle
 XDValue(2) = "00"
 Point1.SetXData XDType, XDValue
 Point2.SetXData XDType, XDValue
End Sub

Function UpDate(Object As AcadLine)
 Dim XDType As Variant
 Dim XDValue As Variant
 Dim MaxAmt As Integer
 Dim Point1 As AcadPoint
 Dim Point2 As AcadPoint
 Dim EndOffSet As Variant
 
 MaxAmt = -1
 
 Object.GetXData "ChallengeLine", XDType, XDValue
 
 On Error GoTo Skip
 MaxAmt = UBound(XDType)
Skip:
 If MaxAmt > -1 Then
 For X = 0 To UBound(XDType) - 1
  If XDType(X) = 1005 Then
   Set Point1 = ThisDrawing.HandleToObject(XDValue(X))
   Set Point2 = ThisDrawing.HandleToObject(XDValue(X + 1))
  End If
 Next X
 
 EndOffSet = Interaction.InputBox("Enter endpoint offset distance", "Challenge Line")
 Object.StartPoint = ThisDrawing.Utility.PolarPoint(Point1.Coordinates, Object.Angle, -EndOffSet)
 Object.EndPoint = ThisDrawing.Utility.PolarPoint(Point2.Coordinates, Object.Angle, EndOffSet)

 End If
 
End Function




Enjoy

[Ron Heigh]

Very nice Keith.
Is that XData?

[Keith™]

Yep ... It took me about 15 minutes to put it together ...

[Ron Heigh]

Now I really want to learn XData.
Pretty cool stuff.

[Ron Heigh]

wow, 200 posts.
why am I still a newt?

[Ron Heigh]

never mind.  Bull Frogs rule.
ribbit.

[Keith™]

XData is simply the means by which you can store specific information in the entity itself. In this program example, it is the handles of the attached points. I was thinking of making the line and the points work in conjunction with one another, for example, if you grab a point and move it, the line follows, or if you extend a line, the point follows, maintaining the extension of the line as defined by the xdata