Attach SurfaceTextureSymbol to DiameterGeneralDimension

[Anonymous]

Hello Everyone,

   After learning Inventor 2010 VBA over past year, I was able to create almost every macro I need for my work (print/convert all, drawing/part copy, automatic dimensioning etc...), mostly thanks to excellent built-in help in Inventor and plenty of very useful examples on internet.

But one important thing, which I cannot accomplish (or find anywhere) is to automatically create surface texture symbol and ATTACH it to diameter dimension.

   Problem is with defining geometry Intent to attach surface texture symbol to. I am not able to get text extension line data (DiameterGeneralDimension object only has .dimensionline which is linesegment2D inside of hole geometry curve).

   Only way I found, to create surface texture where I want it (under center of text on extension line), is If I create surface texture symbol manually, attach it to this point and then, by using selectset, I can get intent to which surface texture leader(1) is attached to. Then I can use this Intent to create another surface texture on the same spot. (Which is obviously not useful for automation)

So my question is: Is it possible to attach surface texture symbol to dimension text extension line using VBA?  And if so, How?

Bellow is Function I use to create surface texture with ladder near dimension text (best I was able to achieve without error)

Public Function Pridej_drsnost_ke_kote(ByVal oPrumer_Kota  As DrawingDimension)
    Dim oDrawDoc As DrawingDocument
    Set oDrawDoc = ThisApplication.ActiveDocument

    Dim oActiveSheet As sheet
    Set oActiveSheet = oDrawDoc.ActiveSheet

    Dim oTG As TransientGeometry
    Set oTG = ThisApplication.TransientGeometry

    Dim oLeaderPoints As ObjectCollection
    Set oLeaderPoints = ThisApplication.TransientObjects.CreateObjectCollection

     Call oLeaderPoints.Add(oTG.CreatePoint2d(oPrumer_Kota.Text.Origin.x + 0.5,    oPrumer_Kota.Text.Origin.y - 1.5))
     Call oLeaderPoints.Add(oTG.CreatePoint2d(oPrumer_Kota.Text.Origin.x + 0.8, oPrumer_Kota.Text.Origin.y - 1.8))

    Dim oSymbol As SurfaceTextureSymbol
    Set oSymbol = oActiveSheet.SurfaceTextureSymbols.Add(oLeaderPoints, kMaterialRemovalRequiredSurfaceType, False, False, False, "1,6")
    
End Function

 This is the result which I would like to achieve:

Thank you very much

Best Regards

Daniel

[YuhanZhang]

Try below VBA code if it works for you, say you have an active drawing document with a diameter dimension on the active sheet:

Sub AttachSurfaceTextureSymbolToDim()
    Dim oDoc As DrawingDocument
    Set oDoc = ThisApplication.ActiveDocument
    
    Dim oSheet As Sheet
    Set oSheet = oDoc.ActiveSheet
    
    Dim oDim As DiameterGeneralDimension
    Set oDim = oSheet.DrawingDimensions(1)
    
    Dim oGI As GeometryIntent
    Set oGI = oSheet.CreateGeometryIntent(oDim, oDim.Text.RangeBox.MinPoint)
    
    Dim oCol As ObjectCollection
    Set oCol = ThisApplication.TransientObjects.CreateObjectCollection
    
    oCol.Add ThisApplication.TransientGeometry.CreatePoint2d(12, 12)
    oCol.Add oGI
    
    Dim oText As SurfaceTextureSymbol
    Set oText = oSheet.SurfaceTextureSymbols.Add(oCol, kBasicSurfaceType, True, , , "Roughness")
End Sub

[Anonymous]

Thank you for excelent tip Using text.rangebox never came into my mind.

Sadly, at least in Inventor 2010, your solution works only if dimension text is in few specific positions. If I compare this example to clock dial, then add surface texture to diameter dimension only works, if text is located in ranges 1 to 3 or 7 to 9 o'clock. In all other position metod SurfaceTextureSymbols.Add failed.

   But this is only minor setback, because it is no problem to move dimension text to where i want it, add surface texture symbol (STS) and finaly move text back to original position. Also if I move text, so its X axis is aligned with drawing X axis then I can simply measure text width and place STS in middle, which is exactly what I wanted.

   Only thing which remain unclear to me is, how to update drawing, that after moving dimension to its original position STS moves with it? (In code below i create another dimension and then delete it, to update drawing).

This code should do exactly what I wanted to achieve in my original post:

Sub AttachSurfaceTextureSymbolToDim()
    Dim oDoc As DrawingDocument
    Set oDoc = ThisApplication.ActiveDocument
    
    Dim oSheet As sheet
    Set oSheet = oDoc.ActiveSheet
    
    Dim oDim As DiameterGeneralDimension
    Set oDim = oSheet.DrawingDimensions(1)
    
    Dim oDimTextPoint As Point2d
    Set oDimTextPoint = oDim.Text.Origin
    
    Dim oDimIntent As GeometryIntent
    Set oDimIntent = oDim.Intent
    
    With ThisApplication.TransientGeometry
        
        oDim.Text.Origin = .CreatePoint2d(oDimIntent.Geometry.CenterPoint.x + 10, oDimIntent.Geometry.CenterPoint.y)
    
        Dim TextCenterPoint As Point2d
        Set TextCenterPoint = .CreatePoint2d(((oDim.Text.RangeBox.MinPoint.x + oDim.Text.RangeBox.MaxPoint.x) / 2) + 0.2, oDim.Text.RangeBox.MinPoint.y)
        
        Dim oGI As GeometryIntent
        Set oGI = oSheet.CreateGeometryIntent(oDim, TextCenterPoint)
        
        Dim oCol As ObjectCollection
        Set oCol = ThisApplication.TransientObjects.CreateObjectCollection
    
        oCol.Add .CreatePoint2d(TextCenterPoint.x, TextCenterPoint.y - 0.1)
        oCol.Add oGI
    
    End With
    
    Dim oText As SurfaceTextureSymbol
    Set oText = oSheet.SurfaceTextureSymbols.Add(oCol, kMaterialRemovalRequiredSurfaceType, False, False, False, "1,6")
    
    oDim.Text.Origin = oDimTextPoint
     
    'I am doing this part below only because I don't know how to update drawing, to move surface texture symbol into right position
    Set oDim = oSheet.DrawingDimensions.GeneralDimensions.AddDiameter(oDimTextPoint, oDimIntent)
    oDim.Delete
     
End Sub

Once more Thank You

Best Regards

[YuhanZhang]

It looks wierd that add a surface texture symbol fails because of dimension text orientation, can you attach data that can reproduce the problem?

To update a drawing document you can call DrawingDocument.Update.

[Anonymous]

It is definitely weird.

I added an example with 18 dimensions in attachment (It is meant for use with your code from post 2, by changing oSheet.DrawingDimensions number from 1 to 18).

From 18 dimensions works on my system only 4 (1,7,13,14), all other failed. I tested it on Inventor Professional 2010 SP2; SP3; SP4 (build 284, relase date 06/23/211) running on Windows 7 Ultimate 64 bit. On all service pack which I tested, I have the same result (except above mentioned 4 dimensions)...

Error: Run-time error '-2147467259 (8004005)': Method 'Add' of object 'Surface TextureSymbols' failed

Also update drawing by using thisdrawing.update (or update2) didn't work, because Surface Texture Symbol didn't move into right position, till I create something new on drawing. (Or move view, or edit TitleBlock, or do something similar). It seems like .update did not affect surface texture symbols.

[YuhanZhang]

Yes, the RangeBox currently could not work for the dimension text which is not vertical/horizontal alignment. And I think we need new property for dimension text to get the box of it for attach a leader to. But for now a workaround might be to change the dimension style to have dimension text alignment to be horizontal/vertical.

If the DrawingDocument.Update does not work, can you try Sheet.Update?