|
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 |
Nummer 28 Setze Textbreite Zeilenumbruch |
|
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.
Dieses Makro setzt die Breite für selektierte Texte. Dies ist für Texte notwendig, die einen automatischen Zeilenumbruch bei einer bestimmten Breite durchführen soll; es ist nicht möglich, solche Eigenschaften "normalen" Texten interaktiv mitzugeben.
ACHTUNG: der Text verliert die "Benutze Dokumenten Schriftart" Eigenschaft
|
' ********************************************************************** |
 mehrsprachiges Dialogfeld (wird automatisch erkannt und
|
In der Userform ist alles untergebracht, was für die Funktionen benötigt wird. Hier der Codeteil:
Dim msgtext(10) As String
Const swDocDrawing = 3
Const swSelNOTES = 15
Public Enum swLengthUnit_e
swMM = 0
swCM = 1
swMETER = 2
swINCHES = 3
swFEET = 4
swFEETINCHES = 5
swANGSTROM = 6
swNANOMETER = 7
swMICRON = 8
swMIL = 9
swUIN = 10
End Enum
Dim SwApp As Object
Dim DrawingDoc As Object
Sub SetTextWidth()
Dim SelMgr As Object
Dim SelCount As Long
Dim Note As Object
Dim Annotation As Object
Dim TextFormat As Object
Dim i, ac As Long
Dim conv As Double
' conversion factor ; SolidWorks always uses Meters
Select Case cmbUnits.List(cmbUnits.ListIndex)
Case "mm"
conv = 0.001
Case "cm"
conv = 0.01
Case "m"
conv = 1
Case "inch"
conv = 0.0254
Case "ft"
conv = 0.3048
End Select
' die selektierten Objekte abklappern
Set SelMgr = DrawingDoc.SelectionManager
' wenn überhaupt was selektiert ist
SelCount = SelMgr.GetSelectedObjectCount
' nothing selected
If SelCount = 0 Then MsgBox msgtext(0)
For i = 1 To SelCount
' wenn nix selektiert war wird die Schleife gar nicht durchlaufen
' ansonsten ein Objekt nach dem anderen holen und
' schauen, ob es eine Bemaßung ist
' die genutzte Funktion gibt es erst ab der SW2003 SP1, für
' ältere Versionen gibt es leider nicht diesen einfachen Weg
' an die DisplayDimensions zu kommen
' wrong type selected
If SelMgr.GetSelectedObjectType2(i) = swSelNOTES Then
Set Note = SelMgr.GetSelectedObject4(i)
Set Annotation = Note.GetAnnotation
For ac = 0 To Annotation.GetTextFormatCount - 1
Set TextFormat = Annotation.GetTextFormat(ac)
' Change text linelength to 25mm
TextFormat.LineLength = txtTextWidth.Text * conv
Debug.Print Annotation.SetTextFormat(ac, False, TextFormat)
Next ac
End If
Next i
' ER Wayne Tiffany: reset Focus and select all text to rapidly change
' values with the numeric keypad until I get the correct one
txtTextWidth.SetFocus
txtTextWidth.SelStart = 0
txtTextWidth.SelLength = Len(txtTextWidth.Text)
End Sub
Private Sub cmdExit_Click()
End
End Sub
Private Sub cmdSetTextWidth_Click()
SetTextWidth
End Sub
Private Sub Label1_Click()
End Sub
Private Sub UserForm_Initialize()
' check which language to apply. To make another language
' copy one of Subs called XyzString and make your changes
'
' Hier ausgucken welche Sprache benutzt wird. Um weitere
' Sprachen zu unterstützen unten einer der Subs kopieren
' Anpassungen machen und aufrufen
Set SwApp = CreateObject("SldWorks.Application")
Select Case SwApp.GetCurrentLanguage
Case "german"
GermanString
Case "english"
EnglishString
' Case "spanish"
' Case "french"
' Case "italian"
' Case "japanese"
Case Else
EnglishString
End Select
' on first initialisation get pointer to active dicument
' beim ersten Aufruf Pointer auf aktives Dokument holen
Set DrawingDoc = SwApp.ActiveDoc
If DrawingDoc Is Nothing Then
MsgBox msgtext(8)
End
End If
' default values
' Vorgabewerte
' einheiten
cmbUnits.AddItem "mm"
cmbUnits.AddItem "cm"
cmbUnits.AddItem "m"
cmbUnits.AddItem "inch"
cmbUnits.AddItem "ft"
Select Case DrawingDoc.LengthUnit
Case swMM
cmbUnits.ListIndex = 0
Case swCM
cmbUnits.ListIndex = 1
Case swMETER
cmbUnits.ListIndex = 2
Case swINCHES
cmbUnits.ListIndex = 3
Case swFEET
cmbUnits.ListIndex = 4
Case swFEETINCHES
cmbUnits.ListIndex = 4
'Case swANGSTROM
'Case swNANOMETER
'Case swMICRON
'Case swMIL
'Case swUIN
End Select
txtTextWidth.SetFocus
txtTextWidth.Text = 100
txtTextWidth.SelStart = 0
txtTextWidth.SelLength = Len(txtTextWidth.Text)
End Sub
Private Sub GermanString()
' used Strings in German
' benutzte Zeichenketten in Deutsch
UserForm1.Caption = "Setze Textbreite"
lblTop.Caption = "In SolidWorks können Texte nicht mit automatischen Wortumbruch eingegeben werden. Mit diesem Makro können Sie für die ausgewählten Texte eine Breite vorgeben und der Text wird dann umgebrochen." & vbCrLf & "Nur Beschriftungen möglich"
lblTextWidth.Caption = "Textbreite und Einheit setzen"
cmdSetTextWidth.Caption = "Setze Textbreite"
cmdExit.Caption = "Beenden"
' ein paar Texte, üblicherweise Warnungen und Fehler
msgtext(0) = "Bitte Text selektieren"
msgtext(1) = ""
msgtext(2) = ""
msgtext(3) = ""
msgtext(4) = ""
msgtext(5) = ""
msgtext(6) = ""
msgtext(7) = ""
msgtext(8) = "Kein aktives Dokument"
msgtext(9) = "Keine Zeichnung aktiv"
msgtext(10) = ""
End Sub
Private Sub EnglishString()
' used Strings in english
UserForm1.Caption = "Set textwidth"
lblTop.Caption = "SolidWorks texts don't make an automatic word wrap. With this macro you can set the textwidth and the text will wrap. " & vbCrLf & "Only notes allowed"
lblTextWidth.Caption = "Enter textwidth and unit"
cmdSetTextWidth.Caption = "Set text width"
cmdExit.Caption = "Exit"
' some text, usually warning or error messages
msgtext(0) = "Please select text first"
msgtext(1) = ""
msgtext(2) = ""
msgtext(3) = ""
msgtext(4) = ""
msgtext(5) = ""
msgtext(6) = ""
msgtext(7) = ""
msgtext(8) = "No active document"
msgtext(9) = "No drawing active"
msgtext(10) = ""
End Sub
| Kritik und Anregungen bitte an Stefan Berlitz. Letzte Änderung dieser Seite am Donnerstag, 01. Februar 2007 17:40 |