Topic: Hatch and UCS Origin

[Keith™]

I am trying to manipulate the UCS origin based upon the bounding box of a hatch and then subsequently update the hatch accordingly, but I am not getting anywhere with it.

Maybe I am missing something but this "should" work ..

Code: [Select]

Dim Pnt1 As Variant
Dim Pnt2 As Variant
Dim XAx(2) As Double
Dim YAx(2) As Double

'Get the bounding box
HatchObj.GetBoundingBox Pnt1, Pnt2
'Get the current UCS so we can reset it
Set UCSOrg = ThisDrawing.ActiveUCS
'Set the direction vectors of the temp UCS
XAx(0) = Pnt1(0): XAx(1) = 0#: XAx(2) = 0#
YAx(0) = 0#: YAx(1) = Pnt1(1): YAx(2) = 0#
'Create a new UCS
Set NewUCS = ThisDrawing.UserCoordinateSystems.Add(Pnt1, XAx, YAx, "temp")
'Set it active
ThisDrawing.ActiveUCS = NewUCS
'Evaluate the hatch --- this should reset the hatch based upon the current UCS, but it doesn't
HatchObj.Evaluate
'Update the object
HatchObj.UpDate
'Reset the previous UCS
ThisDrawing.ActiveUCS = UCSOrg
'Remove our temp UCS
ThisDrawing.UserCoordinateSystems.Item("temp").Delete


[Bob Wahr]

So, looking at it, you are making a ucs with an origin at the ll point of the bounding box, rotated 180 degrees from current.  From what you have here, updating the hatch is the only reason for making the changes to the UCS.  If that's the case, why not blow off all of the UCS stuff and just

redim preserve pnt1(0 to 1)
hatchobj.origin = pnt1
hatchobj.patternangle = hatchobj.patternangle + ((PI * 180)/180)

wouldn't that get you the desired result?

[Keith™]

The intent was to mimic hatchedit, for some reason the order of the property changing makes all the difference in the world ... I didn't need the object rotated specifically 180deg (actually it was 90deg .. ) ... the rotation is inconsequential as I an setting it to a random rotation angle .. but I have changed it so that no rotation is made in the UCS and the rotation is applied later ...

Code: [Select]

'Get the hatch
    Set HatchObj = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1)
'and the bounding box
    HatchObj.GetBoundingBox Pnt1, Pnt2
'create new UCS
    Set UCSOrg = ThisDrawing.ActiveUCS
'set the vectors
    XAx(0) = Pnt1(0) + 12: XAx(1) = Pnt1(1): XAx(2) = 0#
    YAx(0) = Pnt1(0): YAx(1) = Pnt1(1) + 12: YAx(2) = 0#
'set the new UCS
    Set NewUCS = ThisDrawing.UserCoordinateSystems.Add(Pnt1, XAx, YAx, "temp")
    ThisDrawing.ActiveUCS = NewUCS
'set a constant scale (we can change this to what is needed)
    HatchObj.PatternScale = 48
'make the pattern angle
    HatchObj.PatternAngle = Int((48 * Rnd) + 1)
'assign the changes
    HatchObj.Evaluate
'update the object
    HatchObj.UpDate
'reset the origin
    ThisDrawing.ActiveUCS = UCSOrg
'delete the temp origin
    ThisDrawing.UserCoordinateSystems.Item("temp").Delete

Now if I can only find a way to reset "World" UCS since it is not a named UCS and the only way it is available seems to be through ActiveUCS only if World is indeed active. Evidently VBA does not have the mathods to do this without sendkeys .. and that is detrimental when operating via event reactors ...

[Bob Wahr]

(actually it was 90deg .. )

90 in plane and -90 from plane if you want to be completely technical

Give this a shot.  Probably want to throw in a boolean if it is world ucs and delete the whirled at the end accordingly.

Code: [Select]

'Get the hatch
    Set HatchObj = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1)
'and the bounding box
    HatchObj.GetBoundingBox Pnt1, Pnt2
'create new UCS
   If ThisDrawing.GetVariable("WORLDUCS") = 1 Then
    With ThisDrawing
    Set UCSOrg = .UserCoordinateSystems.Add( _
    .GetVariable("UCSORG"), _
    .Utility.TranslateCoordinates(.GetVariable("UCSXDIR"), acUCS, acWorld, 0), _
    .Utility.TranslateCoordinates(.GetVariable("UCSYDIR"), acUCS, acWorld, 0), _
    "whirled")
    End With
    Else
    Set UCSOrg = ThisDrawing.ActiveUCS
    End If
'set the vectors
    XAx(0) = Pnt1(0) + 12: XAx(1) = Pnt1(1): XAx(2) = 0#
    YAx(0) = Pnt1(0): YAx(1) = Pnt1(1) + 12: YAx(2) = 0#
'set the new UCS
    Set NewUCS = ThisDrawing.UserCoordinateSystems.Add(Pnt1, XAx, YAx, "temp")
    ThisDrawing.ActiveUCS = NewUCS
'set a constant scale (we can change this to what is needed)
    HatchObj.PatternScale = 48
'make the pattern angle
    HatchObj.PatternAngle = Int((48 * Rnd) + 1)
'assign the changes
    HatchObj.Evaluate
'update the object
    HatchObj.UpDate
'reset the origin
    ThisDrawing.ActiveUCS = UCSOrg
'delete the temp origin
    ThisDrawing.UserCoordinateSystems.Item("temp").Delete


[Fatty]

Here is my 2 cents

Code: [Select]

Sub test()
Dim AUcs As AcadUCS
Dim WorldUCS As AcadUCS
Dim NewUCS As AcadUCS
Dim orig(2) As Double
Dim vx(2) As Double
Dim vy(2) As Double
Dim hatchObj As AcadHatch
Dim Pnt1(2) As Double
Dim Pnt2(2) As Double
Set AUcs = ThisDrawing.ActiveUCS
With AUcs
vx(0) = .XVector(0): vx(1) = .XVector(1): vx(2) = .XVector(2)
vy(0) = .YVector(0): vy(1) = .YVector(1): vy(2) = .YVector(2)
orig(0) = .Origin(0): orig(1) = .Origin(1): orig(2) = .Origin(2)
End With
'' just to inform , perhaps extrafluous here
If vx(0) = 1# And vx(1) = 0# And vx(2) = 0# And _
   vy(0) = 0# And vy(1) = 1# And vy(2) = 0# And _
   orig(0) = 0# And orig(1) = 0# And orig(2) = 0# Then
Debug.Print "World UCS"
Set WorldUCS = ThisDrawing.UserCoordinateSystems.Add(orig, vx, vy, "WorldUCS")
Else
orig(0) = 0#: orig(1) = 0#: orig(2) = 0#
vx(0) = 1#: vx(1) = 0#: vx(2) = 0
vy(0) = 0#: vy(1) = 1#: vy(2) = 0#
Set WorldUCS = ThisDrawing.UserCoordinateSystems.Add(orig, vx, vy, "WorldUCS")
End If

''Get the hatch
    Set hatchObj = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1)
''and the bounding box
    hatchObj.GetBoundingBox Pnt1, Pnt2
'create new UCS
    'Set UCSOrg = ThisDrawing.ActiveUCS 'you are already there
'set the vectors
    vx(0) = Pnt1(0) + 12: vx(1) = Pnt1(1): vx(2) = 0#
    vy(0) = Pnt1(0): vy(1) = Pnt1(1) + 12: vy(2) = 0#
'set the new UCS
    Set NewUCS = ThisDrawing.UserCoordinateSystems.Add(Pnt1, vx, vy, "temp")
    ThisDrawing.ActiveUCS = NewUCS
'set a constant scale (we can change this to what is needed)
    hatchObj.PatternScale = 48
'make the pattern angle
    hatchObj.PatternAngle = Int((48 * Rnd) + 1)
'assign the changes
    hatchObj.Evaluate
'update the object
    hatchObj.Update
'reset the origin
    ThisDrawing.ActiveUCS = WorldUCS
'delete the temp origin
    ThisDrawing.UserCoordinateSystems.Item("temp").Delete
End Sub
~'J'~

[Keith™]

Thanks for the help so far ... I have managed to push past the UCS issue. I still hate it that we cannot set to "World" without having to create a named UCS.

Let me give you a little bit of insight into what I am doing .. it may make a bit more sense to you ...

We use hatch for a variety of fill patterns, once upon a time we used "line" at various scales to represent shiplap siding, and board & batten siding, not to mention AR-CONC, AR-B816C etc ... about 2 years ago, I broke down and defined custom hatch patterns for all of our most common fills and some that were not so common to make our life easier, not to mention moving toward BOM also makes it easier as well ... The simplest method to distinguish between an 8" lap and 6" lap was to define the scale when placing the hatch and then retrieve the scale and size of the hatch for BOM .. but this led to people doing math incorrectly (some called out 8" some called out 7 1/2" etc .... ) we now have predefined hatched, the name is all we need now ...

Anyway, the various hatches (by standard) are to be placed on the various layers to which they are associated. We were getting incorrect scales, colors, layers, and the hatch origin would be off making the hatch not look correct. So, enter the reactor ...

The reactor will grab the hatch item and its name, set a UCS at the bottom left of the hatch pattern, set the layer, color, scale and rotation (our stone pattern is done randomly) based on predefined standards, re-evaluate the hatch, update the entity and finally return the UCS to the previous condition.

Now I have one more task ....
We have a hatch pattern for metal roofing that aligns properly on a square roof, but many times we have a triangular section. By default I am using the lower left of the bounding box. It would be better to use the upper right of the bounding box when the triangular section is on the left. So ... I suppose I need to get the outer loop and find the longest vertical plane between any 2 points ...

<goes back to key pounding>

[Keith™]

I have the reactor working properly except occasionally I get errors when evaluating the new properties of the hatch. "Hatch too dense" and "Ambiguous output" seem to be the biggest ones even though the hatch scale has not changed. I'd like to get a better understanding of the methodology so I can resolve this. Any insight would be appreciated.

[Bob Wahr]

Haven't done enough with it to really offer any insight without playing with it and am probably no more likely to come up with anything that you couldn't by playing with it.