I have a bunch of code written to hatch on a UCS that I have set. However, I can't get the hatch.origin to work. It keeps going to the WCS origin (I think, thats what it looks like) Anyway, can someone look at this and tell me where I'm going wrong. I have tried translating the coordinates of a picked point, but the error says "Incorrect number of elements in SafeArray"
Option Explicit
Public Sub DrawFence()
Dim objPolyline As Acad3DPolyline, objLine As AcadLine
Dim dblVertices(11) As Double, pt1 As Variant, pt2 As Variant, pt3(2) As Double
Dim objUCS As AcadUCS, currUCS As AcadUCS
pt1 = ThisDrawing.Utility.GetPoint(, "Pick first point: ")
pt2 = ThisDrawing.Utility.GetPoint(pt1, "Pick second point: ")
pt3(0) = pt1(0): pt3(1) = pt1(1): pt3(2) = 60
dblVertices(0) = pt1(0): dblVertices(1) = pt1(1): dblVertices(2) = pt1(2)
dblVertices(3) = pt2(0): dblVertices(4) = pt2(1): dblVertices(5) = pt2(2)
dblVertices(6) = pt2(0): dblVertices(7) = pt2(1): dblVertices(8) = 60
dblVertices(9) = pt1(0): dblVertices(10) = pt1(1): dblVertices(11) = 60
Set objPolyline = ThisDrawing.ModelSpace.Add3DPoly(dblVertices)
objPolyline.Closed = True
ThisDrawing.Regen acActiveViewport
If ThisDrawing.GetVariable("UCSNAME") = "" Then
' Current UCS is not saved so get the data and save it
With ThisDrawing
Set currUCS = .UserCoordinateSystems.Add( _
.GetVariable("UCSORG"), _
.Utility.TranslateCoordinates(.GetVariable("UCSXDIR"), acUCS, acWorld, 0), _
.Utility.TranslateCoordinates(.GetVariable("UCSYDIR"), acUCS, acWorld, 0), _
"OriginalUCS")
End With
Else
Set currUCS = ThisDrawing.ActiveUCS 'current UCS is saved
End If
Set objUCS = ThisDrawing.UserCoordinateSystems.Add(pt1, pt2, pt3, "Fence")
ThisDrawing.ActiveUCS = objUCS
objUCS.Origin = pt1
Dim objHatch As AcadHatch, strHatchPatternName As String, lngPatternType As Long, booAssociativity As Boolean, objEnt(0 To 0) As AcadEntity
strHatchPatternName = "NET"
lngPatternType = 1
booAssociativity = True
Set objEnt(0) = objPolyline
Dim ptHatch(0 To 2) As Double, transpt As Variant
transpt = ThisDrawing.Utility.TranslateCoordinates(pt1, acUCS, acWorld, False, 1)
ptHatch(0) = transpt(0): ptHatch(1) = transpt(1): ptHatch(2) = transpt(2)
Set objHatch = ThisDrawing.ModelSpace.AddHatch(lngPatternType, strHatchPatternName, booAssociativity)
objHatch.PatternScale = 16
objHatch.PatternAngle = 45
objHatch.Origin = ptHatch
objHatch.AppendOuterLoop (objEnt)
objHatch.Evaluate
ThisDrawing.Regen acActiveViewport
ThisDrawing.ActiveUCS = currUCS
End Sub
Anyway, I haven't started cleaning up the code yet, so there are Dims in the wrong place, as I put them in on the fly trying to fix this code.