SolidWorks MakroMania - Maßtexte eintragen

SolidWorks MakroMania ist eine Beispielsammlung einiger Makros, die Ihnen eine Vorstellung davon geben soll, was man auch schon mit Makros in SolidWorks alles anstellen kann. Der Code des Makros sollte so gut dokumentiert sein, dass Sie damit ohne weitere Anleitung verstehen, was gemacht wird.

< voriges
MakroMania
Übersicht


nächstes >

Nummer 07
Maßtexte eintragen

Download
ZIP, 1 KB

Ich übernehme keine Haftung für die korrekte Funktion der Routinen oder irgendwelcher Schäden bei der Anwendung dieser Beispiele. Das gesamte Risiko trägt der Benutzer selbst. - Sorry, muss sein.

Manchmal muss man an vielen Parametern immer wieder dieselben Text eintragen. Dabei kann dieses Makro helfen, in dem die im Makro hart vorgegebenen Texte an allen selektierten Bemaßungen eingetragen werden.

' **********************************************************************
' * Makro trägt an alle selektierten Bemaßungen die verschiedenen
' * zusätzlichen Text an. Einfach alle Maße selektieren, die
' * entsprechend behandelt werden sollen und ausführen.
' *
' * MyAboveDimText
' * MyAboveDimText <DIM> MyPostDimText
' * MyBelowDimText
' *
' * 14.06.2001 Stefan Berlitz (stefan.berlitz@solidworks.cad.de)
' * http://solidworks.cad.de
' * http://swtools.cad.de
' **********************************************************************

Dim swApp As Object
Dim ModelDoc As Object
Dim SelectionMgr As Object
Dim DispDim As Object

Dim i As Long

' Konstanten aus der swconst.bas
Const swDimensionTextPrefix = 1         ' Rrefix
Const swDimensionTextSuffix = 2         ' Suffix
Const swDimensionTextCalloutAbove = 3   ' über dem Maßtext
Const swDimensionTextCalloutBelow = 4   ' unter dem Maßtext

Const swSelDIMENSIONS = 14

' hier bitte die Texte eintragen, der an die selektierten Maße
' eingetragen werden sollen. Bestehende Anhänge werden überschrieben
Const MyPreDimText = ""
Const MyPostDimText = "x45°"
Const MyAboveDimText = ""
Const MyBelowDimText = ""

Sub main()

    Set swApp = CreateObject("SldWorks.Application")
    Set ModelDoc = swApp.ActiveDoc
    Set SelectionMgr = ModelDoc.SelectionManager

    ' dann alle selektierten Objekte durchgehen
    For i = 1 To SelectionMgr.GetSelectedObjectCount
        ' wenn es eine Bemaßung ist
        If SelectionMgr.GetSelectedObjectType(i) = swSelDIMENSIONS Then
            ' an die Bemaßung anklinken
            Set DispDim = SelectionMgr.GetSelectedObject3(i)
            ' und die Texte eintragen
            Call DispDim.SetText(swDimensionTextPrefix, MyPreDimText)
            Call DispDim.SetText(swDimensionTextSuffix, MyPostDimText)
            Call DispDim.SetText(swDimensionTextCalloutAbove, MyAboveDimText)
            Call DispDim.SetText(swDimensionTextCalloutBelow, MyBelowDimText)
        End If
    Next i

    ' und einmal den Bildschirm neu zeichnen lassen
    Call ModelDoc.WindowRedraw

End Sub

Zurück zum Seitenanfang

hr.gif (4491 Byte)

counter Kritik und Anregungen bitte an Stefan Berlitz. Letzte Änderung dieser Seite am Donnerstag, 01. Februar 2007 17:40