Need a Help with API Code

[mostafamahmoudseddek94]

Hi everyone 

I am new to the API, and I would like to add a dimension to a view based on prenamed edges ( one called Left and the other Called Right)  in the model which is simply an extruded rectangular.

the error occurred during debugging at the last line of the code and I have tried to figure out its causes without finding a solution.

Here is my code 

Sub CreateDimensionModel()
'Reference the file that's open
Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument

'Reference the active Sheet
Dim oSheet As Sheet
Set oSheet = oDrawDoc.ActiveSheet

'Reference the View we want
Dim oView As DrawingView
Set oView = oSheet.DrawingViews.Item(1)

'Reference the Model on that Sheet
Dim oModelDoc As Document
Set oModelDoc = oView.ReferencedDocumentDescriptor.ReferencedDocument

' Create a shortcut to the General dimensions on the sheet
Dim oGeneralDims As GeneralDimensions
Set oGeneralDims = oSheet.DrawingDimensions.GeneralDimensions

'Find edge 1 (Left) on the Model
Dim Edge1 As Edge
Set oObjs = oModelDoc.AttributeManager.FindObjects("*", "*", "Left")
Set Edge1 = oObjs.Item(1)

'Find edge 1 (Right) on the Model
Dim Edge2 As Edge
Set oObjs = oModelDoc.AttributeManager.FindObjects("*", "*", "Right")
Set Edge2 = oObjs.Item(1)

'Promote to an DrawingCurve on the View
Dim OCurves1 As DrawingCurve
Set OViewCurves1 = oView.DrawingCurves(Edge1)
Set OCurves1 = OViewCurves1.Item(1)

Dim OCurves2 As DrawingCurve
Set OViewCurves2 = oView.DrawingCurves(Edge2)
Set OCurves2 = OViewCurves1.Item(1)

'Promote to a geometryintent onthe sheet
Dim GI1 As GeometryIntent
Set GI1 = oSheet.CreateGeometryIntent(OCurves1)

Dim GI2 As GeometryIntent
Set GI2 = oSheet.CreateGeometryIntent(OCurves2)

'Create a point for the text
Dim Textpoint As Point2d
Dim Xpos As Double
Dim Ypos As Double

Xpos = oView.Left + (oView.Width / 2)
Ypos = oView.Top + 3
Set Textpoint = ThisApplication.TransientGeometry.CreatePoint2d(Xpos, Ypos)

'Create the Dimension
Dim oDim1 As GeneralDimension
Set oDim1 = oGeneralDims.AddLinear(Textpoint, GI1, GI2)

End Sub

Thanks for help 

[HideoYamada · Accepted solution]

Hello,

Change this line

Set OCurves2 = OViewCurves1.Item(1)

to

Set OCurves2 = OViewCurves2.Item(1)

and your code will work.

Good luck!

=====

Freeradical

 Hideo Yamada

[mostafamahmoudseddek94]

Thanks a lot, Hideoyamada

the code is now running correctly 

[mostafamahmoudseddek94]

Hi Hideo

when the rule run, it can add more than one dimensions overlapped on each other 

I would like to add an if statement, to delete all the overlapped dimension keeping just one dimension.

what would that edit to the code be? 

thanks in advance 

[HideoYamada]

Hello,

This function checks the dimension that you just adding is already existing.

Private Function ContainsLinearGeneralDimmension(oGDS As GeneralDimensions, oGI1 As GeometryIntent, oGI2 As GeometryIntent)
    Dim oGD As GeneralDimension
    
    For Each oGD In oGDS
        If TypeOf oGD Is LinearGeneralDimension Then
            Dim oLGD As LinearGeneralDimension
            Set oLGD = oGD
            If (oLGD.IntentOne.Geometry Is oGI1.Geometry And oLGD.IntentTwo.Geometry Is oGI2.Geometry) Or _
               (oLGD.IntentOne.Geometry Is oGI2.Geometry And oLGD.IntentTwo.Geometry Is oGI1.Geometry) Then
                ContainsLinearGeneralDimmension = True
                Exit Function
            End If
        End If
    Next oGD
    ContainsLinearGeneralDimmension = False
End Function

I wrote this function, but there may be an easier way.

Add the above function and change at end of your original code as follows.

    'Create the Dimension
    Dim oDim1 As GeneralDimension
    If ContainsLinearGeneralDimmension(oGeneralDims, GI1, GI2) Then
        MsgBox "Dim already exists."
    Else
        Set oDim1 = oGeneralDims.AddLinear(Textpoint, GI1, GI2)
    End If
End Sub

If you want to remove existing dimensions and then create new one, modify ContainsLinearGeneralDimmension().

When you do that, you should delete the line "Exit Function" because more then one dims may exist.

("Exit" cause stop the loop at the first match.)

=====

Freeradical

 Hideo Yamada

[mostafamahmoudseddek94]

 sorry for replying late since I have just moved to Italy yeah,😍

 thank you for your generous help, I appreciated it. 

what should I learn if I would like to advance my self in VBA/API? I tought my self how to navigate the inventor object model. may you suggest for me learning resources on the topic? 

many thanks  

MostafaMahmoud

[HideoYamada]

Hello,

---

what should I learn if I would like to advance my self in VBA/API? I tought my self how to navigate the inventor object model. may you suggest for me learning resources on the topic? 

Watch window of VBA helps to understand the object model.

If you want to know how to manipulate an object, at first you should know what the object type is by selecting an object and watching ThisApplication.ActiveDocument.SelectSet(1).

Once the type is revealed, check it with the API help.

And... DO WRITE CODES!!

Someone in this forum will help you if you ask. I also will help you from Japan if I have enough time.

=====

Freeradical

 Hideo Yamada