TheSwamp

Code Red => VB(A) => Topic started by: David Hall on June 06, 2007, 04:46:50 PM

Title: hatch on UCS not WCS
Post 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"

Code: [Select]
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.
Title: Re: hatch on UCS not WCS
Post by: Bryco on June 06, 2007, 05:51:22 PM
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
Title: Re: hatch on UCS not WCS
Post by: David Hall on June 06, 2007, 06:16:07 PM
I could use either, but I thought that to create a closed poly to add hatch to.
Title: Re: hatch on UCS not WCS
Post by: David Hall on June 06, 2007, 06:29:28 PM
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
Title: Re: hatch on UCS not WCS
Post by: David Hall on June 06, 2007, 06:29:53 PM
It seems to me that the origin property does nothing.
Title: Re: hatch on UCS not WCS
Post by: Bryco on June 06, 2007, 06:47:13 PM
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.