Drawing Automation with VBA

[Anonymous]

Dear,

I got a macro job for creation the drawing for a part. I got a lot of problem.

1/ The first one is move view:

I already create a view (e.g. oIsoView), now I want to move it to the left.

I find the DrawingView.Position method, how can I use this method? I try many time, but it's not successful yet.

Do I need to use the SelectSet method??????

[YuhanZhang]

Try below VBA code:

Sub MoveDrawingView()
    Dim oDoc As DrawingDocument
    Set oDoc = ThisApplication.ActiveDocument
    
    Dim oView As DrawingView
    Set oView = oDoc.Sheets(1).DrawingViews(1)
    
    Dim oPosition As Point2d
    Set oPosition = oView.Position
    
    ' move the drawing view to left
    oPosition.X = oPosition.X - 5
    oView.Position = oPosition
    
End Sub

[Anonymous]

I try your code, it works well. I checked by MsgBox().

However, an problem exists before I move the view, that is:

I can not use the DrawingBreakViewAlignmentCmd command although I read and try the same as Help

        ' I create an section view , this code worked

        Dim oSectionView As SectionDrawingView
        Set oSectionView = oSheet.DrawingViews.AddSectionView(oBaseView, oSectionSketch0, oPoint11_

                                                                                  , kFromBaseDrawingViewStyle, , True, "A", False, True)
        oSectionView.ReverseDirection

        '''''''Break the Alignment of Section View
        oDrawDoc.SelectSet.Clear
        oDrawDoc.SelectSet.Select (oSectionView)

        Dim oCtrlDef As ControlDefinition
        Set oCtrlDef = ThisApplication.CommandManager.ControlDefinitions.Item("DrawingBreakViewAlignmentCmd")
       
        oCtrlDef.Execute

        oDrawDoc.SelectSet.Clear

I don't understand why it can not work in this case.

I create a new drawing, and this can work. What happens here???????

Thank you!

[Anonymous]

I just create the same code in another modules, not my Form as upper.

It works well. Is any thing different here?

Sub BreakAlignment()
    Dim oDoc As DrawingDocument
    Set oDoc = ThisApplication.ActiveDocument

    Dim oSectionView As SectionDrawingView
    Set oSectionView = oDoc.Sheets(1).DrawingViews.Item("4")
    oDoc.SelectSet.Clear
    oDoc.SelectSet.Select oSectionView
   
    Dim oCtrlDef As ControlDefinition
    Set oCtrlDef = ThisApplication.CommandManager.ControlDefinitions.Item("DrawingBreakViewAlignmentCmd")
   
    oCtrlDef.Execute
   
    oDoc.SelectSet.Clear
 
End Sub

I copy this code to my form, but it doesn't work.

I don't understand what happens?

What's different between the Module and Form in this case?

How I can run a module (eg. Module2) from my form??????

Many thanks in advance!

[alewer]

The difference is that in the first case you are using parenthesis:  oDrawDoc.SelectSet.Select (oSectionView)

and none in the second case:  oDoc.SelectSet.Select oSectionView

In any case, it would be easier to break the alignment with:  oSectionView.Aligned = False

[Anonymous]

I got that; it works very well. Thank you, Alewer!

Now is the hardest thing (with me) that is to make dimension for the drawing.

How I can select the edge as a person do? What I need to write for the program in VBA to have a drawing like this:

I find in the Programing Help > Drawnig Dimensions, but I just see something very complex.

DrawingCurveSegment, DrawingCurve, GeometryIntent,Vector2d, etc.

I found something in Mr Brain blog (modthemachine), but I don't understand too

Is it impossible mission for me to make upper drawing by VBA?? Please help!!!!

Is there any materials that simple can be worth for me in this case???

Many thanks in advance!

[Anonymous]

I got another problem with this code. I think something wrong in the Profile or BreakOutOperation.Add, but I cannot find out

                Dim oProfile0 As Profile

                Dim oPoint130 As Point2d
                Dim oBreakOutOper As BreakOutOperation               

                Set oPoint130 = oTG.CreatePoint2d(0,0)
                
                Dim oBreakOutSketch1 As DrawingSketch
                Call oTopView.Sketches.Add
                Set oBreakOutSketch1 = oTopView.Sketches.Item(1)
               
                'open the sketch for edit
                oBreakOutSketch1.Edit
                       
                'drawing a line in sketch for section line
                Dim oCircle1 As SketchCircle
                Set oCircle1 = oBreakOutSketch1.SketchCircles.AddByCenterRadius(oPoint130, 30/ 10)
               
                'exit from editing sketch
                oBreakOutSketch1.ExitEdit
               
                Set oProfile0 = oBreakOutSketch1.Profiles.AddForSolid()
                Set oBreakOutOper = oTopView.BreakOutOperations.Add(oProfile0, GeometryIntent, 100/10)

Many thanks in advance!

[Anonymous]

I got solution by myself again........

        Dim oProfile0 As Profile
        Dim oBreakOutOper0 As BreakOutOperation

        Dim oPoint130 As Point2d

        Set oPoint130 = oTG.CreatePoint2d(50, 50)
       
        Dim oBreakOutSketch0 As DrawingSketch
        Set oBreakOutSketch0 = oBaseView.Sketches.Add
       
        'open the sketch for edit
        oBreakOutSketch0.Edit
               
        'drawing a line in sketch for section line
        Dim oCircle0 As SketchCircle
        Set oCircle0 = oBreakOutSketch0.SketchCircles.AddByCenterRadius(oPoint130, 5)
       
        'Create a collection and add the circle
        Dim oCollection0 As ObjectCollection
        Set oCollection0 = ThisApplication.TransientObjects.CreateObjectCollection
        oCollection0.Add oCircle0
       
        Set oProfile0 = oBreakOutSketch0.Profiles.AddForSolid(False, oCollection0)
       
        'exit from editing sketch
        oBreakOutSketch0.ExitEdit
       

        ' find the left horizontal line
        For Each oCurve0 In oBaseView.DrawingCurves
            If Not oCurve0.StartPoint Is Nothing And Not oCurve0.EndPoint Is Nothing Then
                If (WithinTol(oCurve0.StartPoint.x, oCurve0.EndPoint.x, 0.001) = False) Then
                    If oSelectCurve0 Is Nothing Then
                        Set oSelectCurve0 = oCurve0
                    Else
                        If oCurve0.MidPoint.x < oSelectCurve0.MidPoint.x Then
                            Set oSelectCurve0 = oCurve0
                        End If
                    End If
                End If
            End If
        Next
        

        'create GeometryIntent            
        Dim oGeometryIntentPoint0 As GeometryIntent
        Set oGeometryIntentPoint0 = osheet.CreateGeometryIntent(oSelectCurve0, kMidPointIntent)
       
        Set oBreakOutOper0 = oBaseView.BreakOutOperations.Add(oProfile0, oGeometryIntentPoint0, 0)

Something which is very complex is still waiting for me, that is I want to make the Centerlines for some views, using Centerline Bisector cmd, centerline cmd, and center mark. How to do this??????

After that, how we can choose the centerline and drawing line, I means that it seem to be the DrawingCurve is only use for Curve of Object in view, not the Annotated Line?????????

[Anonymous]

I am trying to dimension my drawing as the aforementioned picture, but there are big problem here.

 I don't understand why sometimes it can get the curve and sometime it cannot?

Everything is just like a chaos here, and I cannot control this.

Sub baseview()
    Dim oDrawDoc As DrawingDocument
    Set oDrawDoc = ThisApplication.ActiveDocument
   
    Dim oSheet As Sheet
    Set oSheet = oDrawDoc.ActiveSheet
   
    Dim oBaseView As DrawingView
    Set oBaseView = oSheet.DrawingViews.Item(1)
   
    Dim oTG As TransientGeometry
    Set oTG = ThisApplication.TransientGeometry
   

'////////////////oBaseView Dimension//////////////////////
    Dim oCurve100 As DrawingCurve
    Dim oSelectCurve100, oSelectCurve101, oSelectCurve102, oSelectCurve103, oSelectCurve104 As DrawingCurve
    Set oSelectCurve100 = Nothing
    Set oSelectCurve101 = Nothing
    Set oSelectCurve102 = Nothing
    Set oSelectCurve103 = Nothing
    Set oSelectCurve104 = Nothing
   

    For Each oCurve100 In oBaseView.DrawingCurves
       If oCurve100.CurveType = kLineSegmentCurve Then
        If Not oCurve100.StartPoint Is Nothing And Not oCurve100.EndPoint Is Nothing Then
            If Round(oCurve100.StartPoint.x - oCurve100.EndPoint.x, 3) = 0 Then
               ' MsgBox (Round(oCurve100.StartPoint.y - oCurve100.EndPoint.y, 3))
'            If (WithinTol(oCurve100.StartPoint.x, oCurve100.EndPoint.x, 0.001) = True) Then
                If (Round(Math.Abs(oCurve100.StartPoint.y - oCurve100.EndPoint.y), 3) = 1.28) Then
                    Set oSelectCurve100 = oCurve100
                End If
                If (Round(Math.Abs(oCurve100.StartPoint.y - oCurve100.EndPoint.y), 3) = ((80) * 0.2 / 10)) Then
                    Set oSelectCurve101 = oCurve100
                End If
                If (Round(Math.Abs(oCurve100.StartPoint.y - oCurve100.EndPoint.y), 3) = ((132) * 0.2 / 10)) Then
                    Set oSelectCurve102 = oCurve100
                End If
                If (Round(Math.Abs(oCurve100.StartPoint.y - oCurve100.EndPoint.y), 3) = ((211.5) * 0.2 / 10)) Then
                    Set oSelectCurve103 = oCurve100
                End If
            End If
         End If
      End If
    Next

    Dim oGI100, oGI101, oGI102, oGI103, oGI104, oGI105, oGI106, oGI107, oGI108, oGI109 As GeometryIntent
    Set oGI100 = Nothing
    Set oGI101 = Nothing
    Set oGI102 = Nothing
    Set oGI103 = Nothing
    Set oGI104 = Nothing
    Set oGI105 = Nothing
    Set oGI106 = Nothing
    Set oGI107 = Nothing
    Set oGI108 = Nothing
    Set oGI109 = Nothing
   
    Set oGI100 = oSheet.CreateGeometryIntent(oSelectCurve100, kStartPointIntent)
    Set oGI101 = oSheet.CreateGeometryIntent(oSelectCurve100, kEndPointIntent)
    Set oGI102 = oSheet.CreateGeometryIntent(oSelectCurve101, kStartPointIntent)
    Set oGI103 = oSheet.CreateGeometryIntent(oSelectCurve101, kEndPointIntent)
    Set oGI104 = oSheet.CreateGeometryIntent(oSelectCurve102, kStartPointIntent)
    Set oGI105 = oSheet.CreateGeometryIntent(oSelectCurve102, kEndPointIntent)
    Set oGI106 = oSheet.CreateGeometryIntent(oSelectCurve103, kStartPointIntent)

    Dim oGenDims As GeneralDimensions
    Set oGenDims = oSheet.DrawingDimensions.GeneralDimensions
    Dim oDimPos100, oDimPos101, oDimPos102, oDimPos103, oDimPos104, oDimPos105, oDimPos106, oDimPos107, oDimPos108, oDimPos109 As Point2d
    Set oDimPos100 = Nothing
    Set oDimPos101 = Nothing
    Set oDimPos102 = Nothing
    Set oDimPos103 = Nothing
    Set oDimPos104 = Nothing
    Set oDimPos105 = Nothing
    Set oDimPos106 = Nothing
    Set oDimPos107 = Nothing
    Set oDimPos108 = Nothing
    Set oDimPos109 = Nothing
   
    If Not oSelectCurve100 Is Nothing Then
        Set oDimPos100 = oTG.CreatePoint2d(oSelectCurve100.MidPoint.x - 1, oSelectCurve100.MidPoint.y)
    End If
    If Not oSelectCurve101 Is Nothing Then
        Set oDimPos101 = oTG.CreatePoint2d(oSelectCurve101.MidPoint.x - 1.8 - 85 * 0.2 / 10, oSelectCurve101.MidPoint.y)
    End If
    If Not oSelectCurve102 Is Nothing Then
        Set oDimPos102 = oTG.CreatePoint2d(oSelectCurve102.MidPoint.x - 2.8 - (85 + (76 - 45)) * 0.2 / 10, oSelectCurve102.MidPoint.y)
    End If
    If (Not oSelectCurve100 Is Nothing) And (Not oSelectCurve101 Is Nothing) Then
        Set oDimPos103 = oTG.CreatePoint2d((oSelectCurve100.MidPoint.x + oSelectCurve101.MidPoint.x) / 2, oSelectCurve100.MidPoint.y - 211.5 * 0.2 / 2 / 10 - 1.8)
    End If
    If (Not oSelectCurve101 Is Nothing) And (Not oSelectCurve103 Is Nothing) Then
        Set oDimPos104 = oTG.CreatePoint2d((oSelectCurve101.MidPoint.x + oSelectCurve103.MidPoint.x) / 2, oSelectCurve103.StartPoint.y + 1.8)
    End If
    If (Not oSelectCurve102 Is Nothing) And (Not oSelectCurve103 Is Nothing) Then
        Set oDimPos105 = oTG.CreatePoint2d((oSelectCurve102.MidPoint.x + oSelectCurve103.MidPoint.x) / 2, oSelectCurve103.StartPoint.y + 1)
    End If
    
    Dim oLDim100, oLDim101, oLDim102, oLDim103, oLDim104, oLDim105, oLDim106, oLDim107, oLDim108, oLDim109 As LinearGeneralDimension
    'dim KK
    If Not oDimPos100 Is Nothing Then
        If (Not oGI100 Is Nothing) And (Not oGI101 Is Nothing) Then
            Set oLDim100 = oGenDims.AddLinear(oDimPos100, oGI100, oGI101, kAlignedDimensionType)
        End If
    End If
    'dim MM
    If Not oDimPos101 Is Nothing Then
        If (Not oGI102 Is Nothing) And (Not oGI103 Is Nothing) Then
            Set oLDim101 = oGenDims.AddLinear(oDimPos101, oGI102, oGI103, kAlignedDimensionType)
        End If
    End If
    'dim CD
    If Not oDimPos102 Is Nothing Then
        If (Not oGI104 Is Nothing) And (Not oGI105 Is Nothing) Then
            Set oLDim102 = oGenDims.AddLinear(oDimPos102, oGI104, oGI105, kAlignedDimensionType)
        End If
    End If
    'dim A
    If Not oDimPos103 Is Nothing Then
        If (Not oGI101 Is Nothing) And (Not oGI103 Is Nothing) Then
            Set oLDim103 = oGenDims.AddLinear(oDimPos103, oGI101, oGI103, kAlignedDimensionType)
        End If
    End If
    'dim WF
    If Not oDimPos104 Is Nothing Then
        If (Not oGI102 Is Nothing) And (Not oGI106 Is Nothing) Then
            Set oLDim104 = oGenDims.AddLinear(oDimPos104, oGI102, oGI106, kAlignedDimensionType)
        End If
    End If
    'dim VE
    If Not oDimPos105 Is Nothing Then
        If (Not oGI104 Is Nothing) And (Not oGI106 Is Nothing) Then
            Set oLDim105 = oGenDims.AddLinear(oDimPos105, oGI104, oGI106, kAlignedDimensionType)
        End If
    End If

End Sub
Private Function WithinTol(Value1 As Double, Value2 As Double, Tol As Double) As Boolean
    Math.Abs (Value1 - Value2) < Tol
End Function

Why I cannot get the vertical linear curve have length 1.28 cm in my drawing, I go wrong from the first curve???????????

I feel my proficiency improved a lot with the current project, more than 1700 lines of code now.

But when I do dimensions for drawing, it's is just like impossible thing??????

Someone who already make dimension for a difficult drawing, please answer this question: "Normal or Hard or Very Hard or Impossible??????"

I've waited for few days, but it seem no Autodesk guys stop by.................so sad!

[Anonymous]

I got something currently to solve this problem.........but I wonder how to add the Ø symbol

    oDDim100.Text.FormattedText = "Ø" & oDDim100.Text.FormattedText

and the result is

How can I put the symbol Ø into the dimension text?

[YuhanZhang]

You can use AIGDT font to the FormattedText to show symbols:

<StyleOverride Font='AIGDT' Bold='False'>n</StyleOverride>

[Anonymous]

Amazing!

Could you please give me the materials for some special symbol in Format Text? I cannot find out where I can read them.

For instance: DimensionValue, SectionViewName, etc........

I got a problem in dimension that is I cannot use GeneralDimensions.AddLinear to dimension between a centerline and a line curve

'oCLine100 is the center line, oLCurve100 is the line curve. Two lines is parallel. oDimPos is the point 2d

Dim oGI100, oGI101 As GeometryIntent

Set oGI100 = oSheet.CreateGeometryIntent(oLCurve100)

Set oGI101 = oSheet.CreateGeometryIntent(oCLine100)

Dim oLDim100 As LinearGeneralDimension

Set oLDim100 = oSheet.DrawingDimensions.GeneralDimensions.AddLinear(oDimPos100, oGI100, oGI101, kDiametricDimensionType)

Please help me to figure out what goes wrong in the code????

This GeneralDimensions.AddLinear() is really terrible. It make my Inventor crash down more than 15 time per day........... although I use "On Error Resume Next" before the code line or not.

[Anonymous]

Sometimes, the problem shows out like this following figure:

But sometimes, Inventor crash down like this

For average 30 minutes for one crash like this. If I use the GeneralDimensions.AddLinear 3 or 4 times, it crash down immediately.

Autodesk men, please check out, I am tired of crash and reopen Inventor and crash and reopen..................................so annoyed

If you can find out the solution, please make the hot-fix for it!!!!!!!!!!!

[YuhanZhang]

In API help, you can search the topic titled "XML Tags for FormattedText" to understand more details about FomattedText.

Can you attach a data to reproduce the failure for adding the diametric linear dimension?

[Anonymous]

Sorry, but it is the company properties, I don't have the permission to attach.......

But I really DO NOT understand why.

First,

I change the code to dimension for two line segment curves, which is only different in Y position, every else is same.

Then I create the Center Line by two kStartPoint of two lines, it worked

This means that these two GeometryIntent are right. Then the AddLinear() not work with these two GeometryIntent

If I don't create CenterLine AddLinear also didn't work!!!!!!! Run two or three time, Inventor crashs down........

---> Unbelievable

Then, I change to the most simple case. I get two geometry intent that is the StartPoint and EndPoint of a line curve.

AddLinear didn't work too. What happens??????????

Do you believe this?????

In two case, I change the color and weight of curves, and it work well---> this means that the curves is not nothing and they are right!

So, assuming that I don't understand and I write wrong code?????? Why Inventor crashes??????????? Today, I got more than 20 crashes, it is really irritated.

I know that this sounds stupid, but it was. Now I will try to make a sample to test and send for you........

[Anonymous]

I just create a simple test, it can work, and the List of Properties/Methods can work also

In my macro, even I press Ctrl+J, it not work??????

Or the wrong thing happens because my code is too long???????????????

About 3000 lines and will be 5000 lines if I can use AddLinear to dimension the drawing..................

How I can solve this problem???? Please help!!!!

[YuhanZhang · Accepted solution]

If the data is protected, can you create another simple sample  to reproduce the issue which you think is safe to attach? Or you can try to select a line segment curve on a drawing, and then run below VBA code to check if it works:

Sub CreateLinearDiametricDim()
    Dim oDoc As DrawingDocument
    Set oDoc = ThisApplication.ActiveDocument
    
    Dim oCurve As DrawingCurve
    Set oCurve = oDoc.SelectSet(1).Parent
     
    Dim oIntent1 As GeometryIntent, oIntent2 As GeometryIntent
    Set oIntent1 = oDoc.ActiveSheet.CreateGeometryIntent(oCurve, kStartPointIntent)
    Set oIntent2 = oDoc.ActiveSheet.CreateGeometryIntent(oCurve, kEndPointIntent)
    
    Dim oDim As LinearGeneralDimension
    Dim oPt As Point2d
    Set oPt = ThisApplication.TransientGeometry.CreatePoint2d(12, 12)
    Set oDim = oDoc.ActiveSheet.DrawingDimensions.GeneralDimensions.AddLinear(oPt, oIntent1, oIntent2, kDiametricDimensionType)
End Sub

As the issue for display the List of Properties/Methods, can you check if there are two subs which have the same name in the module/class?

[Anonymous]

I just think to new solution that doesn't need to dimension automatic by VBA anymore.

Maybe in my next project, we will discuss more. Thank you so much!

I have a question about DrawingView:

How I can Delete the oBaseView but still exist the oIsoView????

If we do this manually, we can choose No when a prompt appear and ask us to Delete Projected Views or not

But I don't see any option in DrawingView.Delete() method.

[Anonymous]

Sorry for me,

I just try and only the obaseview is deleted; the isoview still be there. It's no need to do anything else, thanks IV for this!

[Anonymous]

Hi nttoan8187

I'm not really good with ilogic, maybe you can help me?

I just want to create a automatique isoview of my base you with ilogic, do you have a idea for the rule?

Thanks for your help 🙂