---

Hallo zusammen,

ich möchte in der Zeichnungsableitung per VBA die Funktion "Bemaßung" aufrufen und dabei den verwendeten Stil ändern.

Der Stil soll der Bemaßung ein "Ø" als Präfix hinzufügen.

Das Auswählen der Bemaßungsfunktion ist mir bekannt, bloß wie kann ich hierzu simultan den Stil ändern?

Prinzipiell muss ich auf der Ebene *.Sheets.Application.ActiveDocument.ActiveSheet.DrawingDimensions etwas einstellen oder?

Vielen herzlichen Dank im Voraus für Eure Bemühungen.

Grüße

MB-Ing.

    ' Definition eines Objekts des Typs CoammandManger.
    Dim oCommandMgr As CommandManager
    Set oCommandMgr = ThisApplication.CommandManager
   
    ' Aufrufen der Funktion "Bemaßung".
    Dim oControlDef As ControlDefinition
    Set oControlDef = oCommandMgr.ControlDefinitions.Item("DrawingGeneralDimensionCmd")
    Call oControlDef.Execute

------------------
Wissen ist Macht. Nichts wissen macht auch nichts 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo zusammen,

habe gerade diesen Beitrag gefunden...
http://ww3.cad.de/foren/ubb/Forum258/HTML/001433.shtml

Grüße

MB-Ing.

------------------
Wissen ist Macht. Nichts wissen macht auch nichts 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo zusammen,

ist zwar nicht das Gelbe vom Ei, aber wenn man eine entsprechende Schleife einbindet ggf. brauchbar.

Public Sub SetDiameter()

' MB-Ing. 2014.03.18

  ' Beenden der Funktion, wenn kein Dokument geöffnet ist
  If ThisApplication.Documents.Count = 0 Then Exit Sub
 
  ' Beenden der Funktion, wenn das Dokument keine Zeichnung (*.idw) ist
  If ThisApplication.ActiveDocument.DocumentType <> kDrawingDocumentObject Then Exit Sub
 
  ' Aktiviert das geöffnete Dokument
  Dim oIdw As DrawingDocument
  Set oIdw = ThisApplication.ActiveEditDocument
 
  ' Auswahl der gewünschten Bemaßungen
  Dim oDim As LinearGeneralDimension
  Set oDim = ThisApplication.CommandManager.Pick(kDrawingDimensionFilter, "Bemaßung auswählen")
 
  If oDim Is Nothing Then Exit Sub
  On Error Resume Next
 
  ' Hinzufügen des Durchmesserzeichens vor den Bemaßungswert
  oDim.Text.FormattedText = "<StyleOverride Font='AIGDT'>n</StyleOverride><DimensionValue/>"
 
  oIdw.Update
       
End Sub

------------------
Wissen ist Macht. Nichts wissen macht auch nichts 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

ACHTUNG! Sie antworten auf einen Beitrag der älter als 1 Jahr ist!

Hallo,

ich habe ein Problem bei diesem Macro, welches vermutlich aus diesem Beitrag entstanden ist:

Code:

---

Public Sub SetDiameterDIM()
    ' MB-Ing. 2014.03.18
    ' Beenden der Funktion, wenn kein Dokument geöffnet ist
    If ThisApplication.Documents.Count = 0 Then Exit Sub
 
    ' Beenden der Funktion, wenn das Dokument keine Zeichnung (*.idw) ist
    If ThisApplication.ActiveDocument.DocumentType <> kDrawingDocumentObject Then Exit Sub
 
    ' Aktiviert das geöffnete Dokument
    Dim oIdw As DrawingDocument
    Set oIdw = ThisApplication.ActiveEditDocument
 
    ' Auswahl der gewünschten Bemaßungen
    Dim oDim As LinearGeneralDimension
    Set oDim = ThisApplication.CommandManager.Pick(kDrawingDimensionFilter, "Bemaßung auswählen")
 
    If oDim Is Nothing Then Exit Sub
    'On Error Resume Next
 
    ' Hinzufügen des Durchmesserzeichens vor den Bemaßungswert
    'oDim.Text.FormattedText = "<StyleOverride Font='AIGDT'>n</StyleOverride><DimensionValue/>"
    oDim.Text.FormattedText = "Ø<DimensionValue/>"
    oIdw.Update
End Sub

---

In der idw sieht alles super aus. Die Textfarbe ist in den Eigenschaften "VonLayer".

Nach dem Export in eine DWG-Datei sind alle Maße, welche mit diesem Macro bearbeitet sind anders. Die Schriftfarbe ist nicht nach "VonLayer" sondern die Nummer 18?!

Kennt jemand dieses Problem und eine Lösung hierfür?

Gruß
SKYSURFER

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Nachtrag:
Stellt man nun für den Text eine andere Farbe als "Nach Layer" ein wird das Maß mit der Überschreibung korrekt im AutoCAD angezeigt.

Stellt man nun den Ursprung mit "Nach Layer" ein (entfernt somit die Überschreibung), passt auch hier die Darstellung im AutoCAD mit "Von Layer".

Ist dies nun ein Bug von Inventor 2016 oder liegt dies am Macro?

Gruß
SKYSURFER

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

SetDiameterDIM_Fehler_Auswahl.JPG

Hallo,

nun hat sich ein neues Problem ergeben. Ich möchte, dass die Funktion nur bei:
- linearer Bemaßung
- Durchmesserbemaßung
ausgeführt wird.

Hierzu folgender Code:

Code:

---

    Dim oDim As DrawingDimension
    Set oDim = ThisApplication.CommandManager.Pick(kDrawingDimensionFilter, "Bemaßung auswählen")
   
    '??? ESC-Abbruch abfangen
    On Error Resume Next
   
    If oDim.Type <> kLinearGeneralDimensionObject Or oDim.Type <> kDiameterGeneralDimensionObject Then
'    If oDim.Type <> kDiameterGeneralDimensionObject Then
       
        MsgBox "Funktion nur bei linearer Bemaßung gültig!"
       
        Exit Sub
       
    End If
   
    If oDim Is Nothing Then Exit Sub
 

---

Es erscheint die Fehlermeldung, obwohl die Durchmesserbemaßung durch das OR ebenfalls gültig ist. Das verstehe ich nicht.

Hat jemand eine Idee für mich?
Verwende ich das richtige Objekt(VBA) zum Bemaßungsobjekt(IDW)?

Gruß
SKYSURFER

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP