Linear Horizontal Foreshortened dimension using VBA

[Anonymous]

I am working on atomization of idw file presentation using VBA code, I have completed view placement now I am working on dimension, and the problem is while using foreshortened dimension using below VBA code I am always getting dimension in vertical type and my requirement is Horizontal type dimension type, I tried all option but didn't got success in that, if anyone has any idea to how to do that then please advise.

VBA Code:-

 Dim oLinearForeshortenedDim As LinearGeneralDimension

           Set oLinearForeshortenedDim = sheeta.DrawingDimensions.GeneralDimensions.AddLinearForeshortened(TextPosition, intent2, intent1, False)

[chandra.shekar.g]

Hi @Anonymous,

Orientation(Horizontal or vertical) of linear foreshortened dimension is depends on object selection. 

Please try to run the following VBA code to Create linear foreshortened dimension.

Sub CreateLinearForeshortenedDimSample()
    ' Open a drawing document and select two parallel linear curves in same drawing view first.
    Dim oApp As Inventor.Application
    Set oApp = ThisApplication
    
    Dim oDoc As Document
    Set oDoc = oApp.ActiveDocument
    If Not (oDoc Is Nothing) Then
        If Not (oDoc.DocumentType = kDrawingDocumentObject) Then
            MsgBox "Please activate a drawing document for this sample.", vbCritical, "Inventor"
            Exit Sub
        End If
    Else
        MsgBox "Please open a drawing document for this sample.", vbCritical, "Inventor"
        Exit Sub
    End If
    
    If Not (oDoc.SelectSet.Count = 2) Then
        MsgBox "Please select two parallel linear drawing curves from same drawing view for this sample.", vbCritical, "Inventor"
        Exit Sub
    ElseIf (oDoc.SelectSet(1).Type <> kDrawingCurveSegmentObject Or oDoc.SelectSet(1).Type <> kDrawingCurveSegmentObject) Then
        MsgBox "Please select two parallel linear drawing curves from same drawing view for this sample.", vbCritical, "Inventor"
        Exit Sub
    End If
   
    Dim oCurve1 As DrawingCurve, oCurve2 As DrawingCurve
    Set oCurve1 = oDoc.SelectSet(1).Parent
    Set oCurve2 = oDoc.SelectSet(2).Parent
    
    Dim oSheet As Sheet
    Set oSheet = oCurve1.Parent.Parent
    
    ' Create two GeometryIntent based on the selected drawing curve segments.
    Dim oIntent1 As GeometryIntent, oIntent2 As GeometryIntent
    Set oIntent1 = oSheet.CreateGeometryIntent(oCurve1)
    Set oIntent2 = oSheet.CreateGeometryIntent(oCurve2)
    
    Dim oTextPos As Point2d
    Set oTextPos = oApp.TransientGeometry.CreatePoint2d(12, 12)
    
    ' Create the linear foreshortened dimension
    Dim oLinearForeshortenedDim As LinearGeneralDimension
    Set oLinearForeshortenedDim = oSheet.DrawingDimensions.GeneralDimensions.AddLinearForeshortened(oTextPos, oIntent1, oIntent2, True)
    
End Sub

Before running this code, a drawing document should be opened and two lines should be selected (For multiple selection, hold Shift key) 

On successful running, it creates linear foreshortened dimension.

Please feel free to contact if there is any doubt.

If solves problem, click on "Accept as solution" / give a "Kudo".

Thanks and regards,

[Anonymous]

Thanks chandra.shekar For your response, In my case there is no manual selection of line is there, as we are doing automation for dimension, so for doing that we are defining the workpoints in the assembly file and then using this work points we are creating GeometryIntent and using that to give the dimension.

Please find attachment "Inventor Example.GIF" in which I have defined the work points.

Then in "Inventor Example IDW.GIF" idw file it has given the foreshortend dimension but in vertical position, which I don't want, I want that dimension to be in horizontal position.

Below are the code which is working for this case, Please help to get this dimension in horizontal position.

Public Sub L_Foreshortend_Dim()

    Dim oDrawingDocument As Inventor.DrawingDocument
    Set oDrawingDocument = ThisApplication.ActiveDocument
    Dim oSheet As Inventor.Sheet
    Set oSheet = oDrawingDocument.ActiveSheet
    Dim oView As Inventor.DrawingView
    Set oView = oSheet.DrawingViews.Item(1)
    MsgBox (oView.name)
    Dim oAssemblyDoc As Inventor.AssemblyDocument
    Set oAssemblyDoc = oView.ReferencedDocumentDescriptor.ReferencedDocument

    Dim noOfWPoints As Integer
    noOfWPoints = oAssemblyDoc.ComponentDefinition.WorkPoints.Count
    Dim WPName As String
   
    Dim oWP1 As Inventor.WorkPoint
    Dim oWP2 As Inventor.WorkPoint
    Dim oPlacementPoint As Point2d
    Dim aDim As Inventor.GeneralDimension
   
    Set oWP1 = oAssemblyDoc.ComponentDefinition.WorkPoints.Item("WP1")
    Set oWP2 = oAssemblyDoc.ComponentDefinition.WorkPoints.Item("WP3")
   
    Dim sheeta As Inventor.Sheet
    Set sheeta = oView.Parent
   
    Dim marks(1) As Inventor.Centermark
   
    Set marks(0) = sheeta.Centermarks.AddByWorkFeature(oWP1, oView)
    marks(0).Visible = True
       
    Set marks(1) = sheeta.Centermarks.AddByWorkFeature(oWP2, oView)
    marks(1).Visible = True
   
        Dim intent1 As Inventor.GeometryIntent
        Set intent1 = sheeta.CreateGeometryIntent(marks(0))
       
        Dim intent2 As Inventor.GeometryIntent
        Set intent2 = sheeta.CreateGeometryIntent(marks(1))
       
        Dim oTextPos As Point2d
        Set oTextPos = ThisApplication.TransientGeometry.CreatePoint2d(27, 20)
   
        ' Create the linear foreshortened dimension
        Dim oLinearForeshortenedDim As LinearGeneralDimension
        Set oLinearForeshortenedDim = oSheet.DrawingDimensions.GeneralDimensions.AddLinearForeshortened(oTextPos, intent1, intent2, True)
   
End Sub

[chandra.shekar.g]

Hi @Anonymous,

GeneralDimensions.AddLinearForeshortened( TextOrigin As Point2d, IntentOne As GeometryIntent, IntentTwo As GeometryIntent, [HideSecondArrowhead] As Boolean, [DimensionStyle] As Variant, [Layer] As Variant ) As LinearGeneralDimension

Unfortunately, Syntax of AddLinearForeshortened() API does not support to mention orientation of dimension.

Please post this suggestion at idea station using following link.

https://forums.autodesk.com/t5/inventor-ideas/idb-p/v1232/tab/most-recent

Please feel free to contact if there is any doubt.

If solves problem, click on "Accept as solution" / give a "Kudo".

Thanks and regards,