---

Hallo Experten,

ich habe eine Baugruppe mit einem Sack voller Teile und Zeichnungen aus USA bekommen, die ich nun hierzulande nachfertigen soll.

Nun hab' ich zwar irgendwo hier im Forum mal ein Macro gefunden, das mir zöllige Maße in metrische umstellt.

Schön wäre aber, wenn es auch noch die Bemaßungsnorm von ANSI auf DIN umstellen würde. Per Macrorecorder hab' ich das nicht hinbekommen - ich hab' selber halt keine Ahnung von Macros  .

Der Code zum Umstellen von Zoll auf metrisch lautet in schlichter Einfachheit:
------------------------------------------------------------------------------

' ******************************************************************************
' c:\temp\swx1236\Macro1.swb - macro recorded on 05/28/03 by Oberparleiter
' ******************************************************************************
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long
Dim Annotation As Object
Dim Gtol As Object
Dim DatumTag As Object
Dim FeatureData As Object
Dim Feature As Object
Dim Component As Object
Dim Model As Object
Dim wertinteger As Integer

Const swDocNONE = 0              ' Kein Typ
Const swDocPART = 1              ' Type Part
Const swDocASSEMBLY = 2          ' Type Baugruppe
Const swDocDrawing = 3            ' Type Zeichnung
Const swUnitsLinear = 47          ' Einheiten
Sub main()

' an SolidWorks und das aktuelle Dokument anklinken
    Set swApp = CreateObject("SldWorks.Application")
    Set Model = swApp.ActiveDoc
    If Model Is Nothing Then
        MsgBox ("Kein aktives Dokument")
        End
    End If

    ' ausserdem funktioniert das so nur mit Parts, also sollte das aktive
    ' Dokument auch ein Part sein
    'If Model.GetType() <> 1 Then
    '    MsgBox ("falscher Dokumententyp")
    '    Exit Sub
    'End If
   
    wertinteger = 0 ' 0=Millimeter; 3= Zoll/Inches
    boolstatus = Model.SetUserPreferenceIntegerValue(47, wertinteger) ' Wert setzen
    Model.EditRebuild ' noch'n Neuaufbau

End Sub
-----------------------------------------------------------------------------------

Was ich aufgezeichnet habe, um die Bemaßungsnorm umzustellen, macht mir leider nur die zuhörige Dialogbox auf:
-----------------------------------------------------------------------------------
' ******************************************************************************
' C:\Users\Stehling\AppData\Local\Temp\swx5124\Macro1.swb - macro recorded on 04/09/11 by Stehling
' ******************************************************************************
Dim swApp As Object

Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()

Set swApp = _
Application.SldWorks

Set Part = swApp.ActiveDoc
boolstatus = Part.Extension.SelectByID2("131c-012_sst_tape_exit_guide_lt.SLDDRW", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
Part.DimPreferences
End Sub
-----------------------------------------------------------------------------------

Was muß ich denn tun, damit die Bemaßungsnorm auch wunschgemäß umgestellt wird und kann ich das der Einfachheit halber nicht in das obere Macro einbauen?

Gruß

Ron

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

---

Hallo Ron

Ich würde einfach in Dokueigenschaften von Zoll auf metrisch umschalten.

Sonti

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

---

Hi Ron,

ich hatte letztens eine ähnliche Aufgabe, da kam so ein Code dabei raus. Der Aufruf wie bei vielen meiner Makros gilt natürlich auch hier auf freiwilliger Basis, deine örtliche Tafel wird es dir danken 

Code:

---

' **********************************************************************
' * Makro ändert die Entwurfsnorm der aktiven Zeichnung auf DIN
' *
' * 11.04.2011 Stefan Berlitz
' * http://solidworks.cad.de
' * http://swtools.cad.de
' *
' **********************************************************************

Dim swApp        As Object
Dim ModelDoc2    As Object
Dim ModelDocExt  As Object

Public Const swDocNONE = 0
Public Const swDocPART = 1
Public Const swDocASSEMBLY = 2
Public Const swDocDRAWING = 3

Public Const swDetailingDimensionStandard = 13

Public Const swDetailingStandardANSI = 1
Public Const swDetailingStandardISO = 2
Public Const swDetailingStandardDIN = 3
Public Const swDetailingStandardJIS = 4
Public Const swDetailingStandardBS = 5
Public Const swDetailingStandardGOST = 6
Public Const swDetailingStandardGB = 7
Public Const swDetailingStandardUserDefined = 8

Public Const swDetailingNoOptionSpecified = 0

Sub main()
    ' an SolidWorks anhängen, aktives Dokument suchen
    Set swApp = Application.SldWorks
    Set ModelDoc2 = swApp.ActiveDoc

    If ModelDoc2 Is Nothing Then
        ' dann war gar kein Dokument geöffnet, wie soll da was funktionieren
        MsgBox "Kein Dokument geöffnet"
        Exit Sub
    End If
    If (ModelDoc2.GetType <> swDocDRAWING) Then
        ' wenn keine Zeichnung aktiv ist wird das Makro wieder beendet
        MsgBox "Nur für Zeichnungen geeignet"
        Exit Sub
    End If

    ' den Extensionmanager dieses Dokuments ansprechen
    Set ModelDocExt = ModelDoc2.Extension
    If Not ModelDocExt.SetUserPreferenceInteger( _
                              swDetailingDimensionStandard, _
                              swDetailingNoOptionSpecified, _
                              swDetailingStandardDIN) Then
       
        MsgBox "Fehler beim Setzen der Entwurfsnorm"
       
    End If

End Sub

---

Ciao,
Stefan

------------------
Inoffizielle deutsche SolidWorks Hilfeseite    http://solidworks.cad.de
Stefans SolidWorks Blog

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

---

Zitat:

---

Original erstellt von StefanBerlitz:
[B]Hi Ron,

ich hatte letztens eine ähnliche Aufgabe, da kam so ein Code dabei raus. Der Aufruf wie bei vielen meiner Makros gilt natürlich auch hier auf freiwilliger Basis, deine örtliche Tafel wird es dir danken  

---

Hallo Stefan,

vielen herzlichen Dank für das Makro. Ich hatte zwar mein konkretes Problem (rund 50 Zeichnungen) schon zu Fuß gelöst, aber der nächste Sack voller amerikanischer Zeichnungen steht schon wieder in der Warteschlange.

Das Makro hab' ich in einem kleinen Detail geändert:

Zitat:

---

'If (ModelDoc2.GetType <> swDocDRAWING) Then
        ' wenn keine Zeichnung aktiv ist wird das Makro wieder beendet
'      MsgBox "Nur für Zeichnungen geeignet"
'      Exit Sub
'  End If

---

Es funktioniert nämlich nicht nur wie gewünscht bei Zeichnungen, sondern auch bei Teilen und Baugruppen - und es gibt durchaus Veranlassung, es auch da anzuwenden.

Deine Anregung mit den Tafeln greif' ich gerne auf.

Gruß

Ron

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