Beyond Inventor Wizard... The Community!

Autodesk Inventor en AutoCAD Forum

Inventor: Diametersymbool toevoegen aan een bemating in IDW

Public Sub DiaSymbol()

On Error GoTo errorhandler
       
    ' Set a reference to the active drawing document
    Dim oDoc As DrawingDocument
    Set oDoc = ThisApplication.ActiveDocument

    ' Set a reference to the active sheet
    Dim oSheet As Sheet
    Set oSheet = oDoc.ActiveSheet

    Dim oDrawingDim As DrawingDimension
   
    Dim i, j As Integer
    j = 1
    For i = 1 To ThisApplication.ActiveDocument.SelectSet.Count
   
        Set oDrawingDim = ThisApplication.ActiveDocument.SelectSet.Item(j)
        oDrawingDim.Text.FormattedText = "<StyleOverride Font='AIGDT' Bold='false'>n</StyleOverride>" & oDrawingDim.Text.FormattedText
       
      j = j + 1
    Next i
   
Exit Sub

errorhandler:

If Err.Number = 91 Then MsgBox "Er is geen tekening open"
If Err.Number = 13 Then MsgBox "Er is geen IDW open"

End Sub

Aantal maal bekeken: 1256

Bijlagen:

Hierop reageren

Berichten in deze discussie

knap eens uitproberen se :-)

ik had alleen net een topic begonnen en uit we wikipedia haal ik,

dat het juiste diameter teken ø is (Alt +0248)

Of is jouw afbeelding het diameter teken van inventor zelf?

De mijne is de originele die inventor gebruikt.

Je kan ook gewoon gebruik maken van een extra 'dimension style'...

Met multiselect en copy properties kan je dan ook snel wisselen tussen de verschillende stijlen.

Zie: http://youtu.be/a2VwetOn-ds

 

Ik heb van deze macro een update gemaakt omdat niet voor alle geselecteerde bematingen een diametersymbool geplaatst werd.

Public Sub DiaSymbol()

On Error GoTo errorhandler
        
Dim oDoc As DrawingDocument
Set oDoc = ThisApplication.ActiveDocument

Dim oDrawingDim() As DrawingDimension
Dim a, b As Integer

Dim i As Long
For i = 1 To oDoc.SelectSet.Count
            If Not oDoc.SelectSet.Item(i) Is Nothing Then
                   If TypeOf oDoc.SelectSet.Item(i) Is DrawingDimension Then
                   a = a + 1
                   ReDim Preserve oDrawingDim(0 To a)
                   Set oDrawingDim(a) = oDoc.SelectSet.Item(i)
                   End If
          End If
Next

For b = 1 To a
    oDrawingDim(b).Text.FormattedText = "<StyleOverride Font='AIGDT' Bold='false'>n</StyleOverride>" & oDrawingDim(b).Text.FormattedText
Next
    
Exit Sub

errorhandler:


MsgBox Err.Description & " " & Err.Number

End Sub

bedankt voor de update Fréderic, strx eens gebruiken :-)

RSS

Interessante links

Word Fan!

Inventor Wizard Cartoons

Video's

  • Video's toevoegen
  • Alles weergeven

© 2021   Gemaakt door Stefaan Boel.   Verzorgd door

Banners  |  Een probleem rapporteren?  |  Algemene voorwaarden