TheSwamp
Code Red => VB(A) => Topic started by: David Hall on June 06, 2007, 04:46:50 PM
-
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.
-
Cmd I haven't time to have a good look at it, but I'm not so sure why you are using a 3dpline instead of an lwpline.
The hatch is a planar item and usually behaves when you match its normal and elevation to the lwpline
-
I could use either, but I thought that to create a closed poly to add hatch to.
-
I did figure out that the elevation property of the hatch is controlling where it goes, but now Im stuck on positive or negative values. How to determine when positive or negative
-
It seems to me that the origin property does nothing.
-
As far as I know the origin is where the hatch pattern starts, not where it visually starts on the drawing. That is, it is like the hatch covers all of modelspace and you clip it where you want it. It is possible to move the origin so a brick pattern will start perfectly on the bottom of a rectangle.