Auto Hatch all Circles in a IDW sketch

[Anonymous]

When drawing concrete reinforcement, most of the time a 3d model isn't necessary so we just sketch it in the IDW after creating the structure model. This however can be tedious (still faster than modelling) as sometimes there are 50-60 circles (representing the ends of rebar) that have to be hatched. Given that inventor doesn't allow you to pick multiple points at a time while creating hatches, this takes in inordinate amount of time.

Is there a way, via iLogic, to fill each circle in a sketch with a solid hatch?

TIA - Visceryn

[Anonymous]

Hi Visceryn,

I've created a VBA code which might help you.

Dim oDrawDoc As DrawingDocument
Dim oActiveSheet As Sheet
Dim oSketchCircle As SketchCircle
Dim oLayer As Layer
Dim oSketch As DrawingSketch
    Set oDrawDoc = ThisApplication.ActiveDocument
    Set oActiveSheet = oDrawDoc.ActiveSheet
    Set oSketch = oActiveSheet.Sketches.Add
For Each oDrawingView In oActiveSheet.DrawingViews
    For Each oDrawingSketch In oActiveSheet.Sketches
            For Each oSketchCircle In oDrawingSketch.SketchCircles
                 oSketch.Edit
                 Dim oCollection1 As ObjectCollection
                 Set oCollection1 = ThisApplication.TransientObjects.CreateObjectCollection
                 oCollection1.Add oSketchCircle
                 Dim oProfile1 As Profile
                 Set oProfile1 = oSketch.Profiles.AddForSolid(False, oCollection1)
                 Call oSketch.SketchFillRegions.Add(oProfile1)
                 oSketch.ExitEdit
            Next
     Next
Next

If you find this was helpful for your query please accept it as solution / give a kudos 

Cheers,

SK.

[Anonymous]

Apologies for my ignorance, but I'm not familiar with utilizing VBA. I tried googling it, got into the VBA Editor, created a ApplicationProject Module, then pasted the code that you supplied. The video that I watched on how to use the code, it looked like after doing those thing, I should be able to go back into my file, select the Macros button, specify where I want it to look for a macro (All Application Projects and Active Documents) and run it, however there are no macros showing up.

Is there something missing from the beginning of the code?  Something like this --->  Public Sub SomethingHere ()

Again, apologies for my ignorance, I am a total newbie to VBA and thank you very much for the assistance here!

EDIT* - when using this code, at what point would I run it? Would I go in and edit sketch, then run it? Or does it run from outside the sketch editor?

[Anonymous]

You run the code outside the sketch editor. The code is going to open the sketch edit and going to apply the fill option and again it will come out of the sketch editor.

[Anonymous]

So I added: Sub Main() at the beginning and End Sub at the end of the code... not sure if that's right, but it populated the macros list with HatchBars.Main, which I then hit the Run button. I don't get any error or popup, but it did not hatch the circles.

[Anonymous]

Hope you are in the the drawing document. If yes then it should work can you share the type of error you are getting.

Please copy and paste the code as given ant try it.

Sub Hatch_sketch()
Dim oDrawDoc As DrawingDocument
Dim oActiveSheet As Sheet
Dim oSketchCircle As SketchCircle
Dim oLayer As Layer
Dim oSketch As DrawingSketch
    Set oDrawDoc = ThisApplication.ActiveDocument
    Set oActiveSheet = oDrawDoc.ActiveSheet
    Set oSketch = oActiveSheet.Sketches.Add
For Each oDrawingView In oActiveSheet.DrawingViews
    For Each oDrawingSketch In oActiveSheet.Sketches
            For Each oSketchCircle In oDrawingSketch.SketchCircles
                 oSketch.Edit
                 Dim oCollection1 As ObjectCollection
                 Set oCollection1 = ThisApplication.TransientObjects.CreateObjectCollection
                 oCollection1.Add oSketchCircle
                 Dim oProfile1 As Profile
                 Set oProfile1 = oSketch.Profiles.AddForSurface(False, oCollection1)
                 Call oSketch.SketchFillRegions.Add(oProfile1)
                 oSketch.ExitEdit
            Next
     Next
Next

End Sub

It should be a drawing document needs to be selected before running the code.

[Anonymous]

Yes, just to confirm I am in a drawing document, *.IDW

I copied the newer version you just posted and ran the macro, and it gave me the error shown in the attachment.

[Anonymous]

Try change the following code

Set oProfile1 = oSketch.Profiles.AddForSurface(False, oCollection1)

to

Set oProfile1 = oSketch.Profiles.AddForSolid(False, oCollection1)

[Anonymous]

The error is no longer happening but it is not filling in the circles. It is creating a new sketch however.

For example in the attached you will see there is a sketch within: VIEW43:4x8 GI Base - Base Only.iam

After running the macro, there is a new sketch outside of the view but the circles within the view sketch are not hatched still.

[Anonymous]

Sorry for that happens try change the code from 

For Each oDrawingSketch In oActiveSheet.Sketches


to 


For Each oDrawingSketch In oDrawingSketch.Sketches 

 Modified code

Sub Hatch_sketch()
Dim oDrawDoc As DrawingDocument
Dim oActiveSheet As Sheet
Dim oSketchCircle As SketchCircle
Dim oLayer As Layer
Dim oSketch As DrawingSketch
    Set oDrawDoc = ThisApplication.ActiveDocument
    Set oActiveSheet = oDrawDoc.ActiveSheet
    Set oSketch = oActiveSheet.Sketches.Add
For Each oDrawingView In oActiveSheet.DrawingViews
    For Each oDrawingSketch In oDrawingView.Sketches
            For Each oSketchCircle In oDrawingSketch.SketchCircles
                 oSketch.Edit
                 Dim oCollection1 As ObjectCollection
                 Set oCollection1 = ThisApplication.TransientObjects.CreateObjectCollection
                 oCollection1.Add oSketchCircle
                 Dim oProfile1 As Profile
                 Set oProfile1 = oSketch.Profiles.AddForSolid(False, oCollection1)
                 Call oSketch.SketchFillRegions.Add(oProfile1)
                 oSketch.ExitEdit
            Next
     Next
Next

End Sub

[Anonymous]

I've attached the error that pops up when I run the macro now.

It is still creating a sketch outside of the view -> Sketch6

[Anonymous]

Sorry, I got ahead of myself... the code is now hatching the circles, but it is doing so in a secondary sketch that is not attached to the view. So, if I move the view, the hatched circles do not move with it.

Is there a way to make it hatch the circles within the view sketch?

[Anonymous]

This code will create a sketch inside the drawing view.Hope this will help you.

Sub Hatch_sketch()
Dim oDrawDoc As DrawingDocument
Dim oActiveSheet As Sheet
Dim oSketchCircle As SketchCircle
Dim oLayer As Layer
Dim oDrawSketch As DrawingSketch
    Set oDrawDoc = ThisApplication.ActiveDocument
    Set oActiveSheet = oDrawDoc.ActiveSheet
For Each oDrawingView In oActiveSheet.DrawingViews

    Set oDrawSketch = oDrawingView.Sketches.Add
    For Each oDrawingSketch In oDrawingView.Sketches
    
            For Each oSketchCircle In oDrawingSketch.SketchCircles
                 oDrawSketch.Edit
                 Dim oCollection As ObjectCollection
                 Set oCollection = ThisApplication.TransientObjects.CreateObjectCollection
                 oCollection.Add oSketchCircle
                 Dim oProfile As Profile
                 Set oProfile = oDrawSketch.Profiles.AddForSolid(False, oCollection)
                 Call oDrawSketch.SketchFillRegions.Add(oProfile)
                 oDrawSketch.ExitEdit
            Next
     Next
Next

End Sub

[Anonymous]

Hmm... it's creating the secondary sketch inside the view now, but now it's not hatching again. There are no errors, so I'm not sure how to determine the problem this time?

[Anonymous · Accepted solution]

That  sounds weird to me. I don't why it happens, It creates  hatch while the sketch was outside the drawing view and it doesn't happen. But actually what happens in my previous code is actually it creates hatch but the scale and position has been changed. So I've modified the code slightly which creates the hatch with same scale and position. Hope this find helpful to you.

Sub Hatch_sketch()
Dim oDrawDoc As DrawingDocument
Dim oActiveSheet As Sheet
Dim oSketchCircle As SketchCircle
Dim oLayer As Layer
Dim oDrawSketch As DrawingSketch
    Set oDrawDoc = ThisApplication.ActiveDocument
    Set oActiveSheet = oDrawDoc.ActiveSheet
For Each oDrawingView In oActiveSheet.DrawingViews
    For Each oDrawingSketch In oDrawingView.Sketches
        Set oDrawSketch = oDrawingView.Sketches.Add
            For Each oSketchCircle In oDrawingSketch.SketchCircles
                 oDrawSketch.Edit
                 Dim oXpoint As Double
                 Dim oYpoint As Double
                 Dim oRadius As Double
                 oXpoint = oSketchCircle.Geometry.Center.X
                 oYpoint = oSketchCircle.Geometry.Center.Y
                 oRadius = oSketchCircle.Geometry.Radius
                 Dim oTG As TransientGeometry
                 Set oTG = ThisApplication.TransientGeometry
                 Dim oCircle As SketchCircle
                 Set oCircle = oDrawSketch.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(oXpoint, oYpoint), oRadius)
                 Dim oCollection As ObjectCollection
                 Set oCollection = ThisApplication.TransientObjects.CreateObjectCollection
                 oCollection.Add oCircle
                 Dim oProfile As Profile
                 Set oProfile = oDrawSketch.Profiles.AddForSolid(False, oCollection)
                 Call oDrawSketch.SketchFillRegions.Add(oProfile)
                 oDrawSketch.ExitEdit
            Next
     Next
Next

End Sub

If you find this was helpful please accept this as solution / Give kudos .

Cheers,

SK.

[Anonymous]

It works! Thank you very much for all your help! Kudos inbound ;D

[YuhanZhang]

Please log in the Beta forum(get the Inventor project) to try the Inventor 2021 Beta build which has the drawing sketch hatch APIs:

    https://feedback.autodesk.com/project/home.html?cap=fb14413735ee42c99624e3793b19a0b2

Please let me if any feedback on the new APIs.

[Anonymous]

Hi @Anonymous 

I'm interested in this topic, my I ask you a question that if we don't use sketch circle, can we use this code to fill solid.

For example, we have a sketch that include rectangular. I try to modify this code but there is an error 

I would like to add the code that create rectangular here

Could you take a look and give me any support? 

Many thanks

Dim oSketchRectangle As SketchEntitiesEnumerator
        oSketchRectangle = oDrawSketch.SketchLines.AddAsTwoPointRectangle(oTG.CreatePoint2d(0.325, 0), oTG.CreatePoint2d(0.625, -0.075))

        Dim oCollection As ObjectCollection
        oCollection = invApp.TransientObjects.CreateObjectCollection
        oCollection.Add(oSketchRectangle)
        Dim oProfile As Profile
        oProfile = oDrawSketch.Profiles.AddForSolid(False, oCollection)
        Call oDrawSketch.SketchFillRegions.Add(oProfile)

[YuhanZhang]

Please try below way to add the rectangle to the ObjectCollection:

Dim i As Long
For i = 1 To oSketchRectangle.Count
    oCollection.Add(oSketchRectangle.Item(i))
Next