|
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 11 Mittelkreuze erstellen |
|
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.
Mittelkreuze in Bohrungen zu erstellen ist in SolidWorks sehr einfach: Mittelkreuze aktivieren und Bohrung anklicken. Lästig wird es, wenn man Hunderte Bohrungen z.B. in einer Bohrplatte hat. Um dies zu vereinfachen dient dieses Makro, das auf der Grundlage vom Centermark-Utilitie von Kevin Silbert entstanden ist. Schauen Sie sich regelmäßig auf den Seiten von Trimech (www.trimech.com) um, dort gibt es z.B. eine Seite voll frei verfügbarer Utilities.
Da der Code ziemlich anspruchsvoll ist habe ich an vielen Stellen versucht
das Ganze detailliert zu kommentieren, aber es funktioniert auch, wenn Sie
einfach eine Fläche mit ihren Bohrungen in der Zeichnung auswählen und dann das
Makro laufen lassen ohne zu verstehen, wie es arbeitet
.
Update für SolidWorks 2005 - da in der SolidWorks 2005 die Methode der Selektion geändert wurde und jetzt zusätzlich auch die Ansicht selektiert ist, wenn eine Fläche gewählt wurde gibt es jetzt zwei Makros zum runterladen.
Und jetzt das Makro:
Option Explicit
' **********************************************************************
' * Makro erzeugt für alle Kreise einer ausgewählten Fläche in einer
' * Zeichenansicht die dazugehörenden Mittelkreuze. Die Idee und der
' * größte Teil des Codes stammt von Kevin Silbert (www.trimech.com),
' * hier erweitert und in deutsch kommentiert
' *
' * Bitte erst eine Fläche in einer Zeichenansicht wählen und dann
' * das Makro starten. Es kann bei zu dicht liegenden Kanten passieren,
' * dass einzelne Bohrungen nicht korrekt gekennzeichnet werden. Noch
' * gibt es kein Mittel dagegen.
' *
' * 07.12.2001 Stefan Berlitz (stefan.berlitz@solidworks.cad.de)
' * http://solidworks.cad.de
' * http://swtools.cad.de
' *
' * Idee und Codegrundlagen von Kevin Silbert
' * http://www.trimech.com
' **********************************************************************
' allgemeine Objekte
Dim swApp As Object
Dim DrawingDoc As Object
Dim SelectionMgr As Object
Dim MathUtil As Object
Dim FaceObj As Object
Dim View As Object
Dim EdgeObj As Object
Dim EdgeCount As Long
Dim EdgeList As Variant
Dim EdgeParams As Variant
Dim Curve As Object
Dim CurveType As Long
' für die mathematischen Transformationen und Umwandlungen von Feldern
' in Variants und umgekehrt brauchen wir ein paar Variablen
Dim Location(3) As Double
Dim dLoc(2) As Double
Dim vLoc As Variant
Dim oLoc As Object
Dim oLocXformed As Object
Dim vLocXformed As Variant
Dim ViewXform As Variant
Dim oViewXform As Object
Dim Radius As Double
Dim vSelPt As Variant
Dim SelectedObj As Object
' und noch ein paar Standardvariablen
Dim i As Long
Dim retval As Boolean
' zum Schluß die Konstantendefinitionen aus der swconst.bas (nur damit
' der Download nicht zu groß wird, man kann logischerweise auch das
' Modul mit ins Projekt aufnehmen)
Const CIRCLE_TYPE As Integer = 3002
Sub main()
' wie gehabt erst mal an das laufende SolidWorks anklinken
Set swApp = CreateObject("SldWorks.Application")
Set DrawingDoc = swApp.ActiveDoc
Set MathUtil = swApp.GetMathUtility
' damit wir nicht jedes bischen Fehler abfangen müssen machen wir
' es uns einfach und verzweigen einfach bei jedem Fehler zum Ende,
' wo eine kurze Erklärung kommt was man tun soll.
' DAS MUSS ZUM TESTEN AUSKOMMENTIERT WERDEN, DAMIT MAN SIEHT,
' WO FEHLER AUSGELÖST WERDEN
On Error GoTo ErrorTrap
' um an die Selektierungen zu kommen an den SelMgr anklinken
Set SelectionMgr = DrawingDoc.SelectionManager
' dann holen wir uns die ausgewählte Fläche
Set FaceObj = SelectionMgr.GetSelectedObject3(1)
' und den passenden View dazu holen wir uns selbst. Dazu selektieren
' wir einfach eine View an den zuletzt benutzten Selektionskoordinaten,
' dass muss ja der Klick des Benutzers gewesen sein um die Fläche
' auszuwählen.
vSelPt = SelectionMgr.GetSelectionPoint(1)
retval = DrawingDoc.SelectByID("", "DRAWINGVIEW", vSelPt(0), vSelPt(1), vSelPt(2))
Set View = SelectionMgr.GetSelectedObject3(1)
' dann holen wir uns die Transformationsmatrix der Zeichenansicht.
' Da GetViewXForm ein Feld von 13 Double zurückliefert, wir für die
' Transformationsberechnung das Standardmatrizenformat (Objekt)
' brauchen wird erst das Feld erweitert (auf behalten der Werte achten)
' und dann in eine gültige Transformationsmatrix überführt.
ViewXform = View.GetViewXform
ReDim Preserve ViewXform(15)
Set oViewXform = MathUtil.CreateTransform((ViewXform))
' Dann können wir uns der eigentlichen Aufgabe zuwenden.
' Wir holen uns die Anzahl und die Objektzeiger auf alle
' Kanten in der ausgewählten Fläche
EdgeCount = FaceObj.GetEdgeCount
EdgeList = FaceObj.GetEdges()
' dann untersuchen wir alle die Kanten
For i = 0 To (EdgeCount - 1)
' dazu jeweils die nächste Kante holen ...
Set EdgeObj = EdgeList(i)
' ... die dazu gehörende Kurve ...
Set Curve = EdgeObj.GetCurve
' ... und den Type des Kurvenzuges
CurveType = Curve.Identity()
' wenn es sich beim Typ um einen Kreistyp handelt
If CurveType = CIRCLE_TYPE Then
' die ganzen folgenden Aktionen sind nur aus einem Grund nötig:
' um mit AddCenterMark ein Mittelkreuz zu machen muss VORHER die
' Kurve selektiert werden. Leider gibt es bisher keine Möglichkeit
' die Kurve zu selektieren, auch wenn man das Objekt hat, da ein
' Entitie.Select die Kurve des Modells (!) auswählt, nicht die in
' der Zeichenansicht.
' Aus diesem Grund muss man relativ umständlich (und möglicherweise
' auch fehlerbehaftet) virtuell genau auf den Kreis klicken; dazu
' müssen wir aber genau die Koordinaten haben, und dafür jetzt der
' ganze Wahn!
' Also los geht's: erst die Werte des Kreises ...
EdgeParams = Curve.CircleParams
' ... die Koordinaten des Mittelpunktes in eine Feld aus Double ...
dLoc(0) = EdgeParams(0)
dLoc(1) = EdgeParams(1)
dLoc(2) = EdgeParams(2)
' und den Radius merken wir uns auch noch
Radius = EdgeParams(6)
' ... dann das "Umformatieren" des Double-Feldes in ein Variant
vLoc = dLoc
' und mit diesen Koordinaten einen "mathematischen Punkt"
' (Objekt) erzeugen.
' Achtung auf die Doppelklammern (Übergabe Safearray aus Variant)
Set oLoc = MathUtil.CreatePoint((vLoc))
' Diesen math. Punkt jetzt in unsere Zeichenansicht transformieren
' dazu diesen mit der Transformmatrix verktoriell multiplizieren
Set oLocXformed = oLoc.MultiplyTransform(oViewXform)
' ... und diese Werte holen wir uns wieder in ein "normales"
' Double-Feld (über die Variant-Übergabe). Jetzt haben wir die
' Koordinaten des Mittelpunkts der aktuellen Kante in Bezug
' auf die Zeichenansicht
vLocXformed = oLocXformed.ArrayData
' nun ist die Selektion nur noch ein kleiner Schritt. Dazu "klicken"
' wir virtuell auf den Punkt genau auf 3 Uhr auf dem Kreisbogen. Dazu
' in X-Richtung zum Mittelpunkt noch den Radius dazurechnen und dabei
' nicht den eventuell vorhandenen Maßstab vergessen.
retval = DrawingDoc.SelectByID("", "EDGE", _
vLocXformed(0) + Radius * ViewXform(12), _
vLocXformed(1), _
vLocXformed(2))
' GESCHAFFT! Kante ist in der View selektiert, jetzt nur noch
' das Mittelkreuz erzeugen (Überstand 2.5 mm, aber das haben Sie
' doch sicher in den Dokumentoptionen eh hinterlegt)
retval = DrawingDoc.AddCenterMark(0.0025, True)
' um den Fehler brauchen wir uns nicht kümmern, das aufgrund eines
' Bugs in der API von AddCenterMark IMMER TRUE (also geglückt)
' zurückgegeben wird
' (SPR 119537 - "DrawingDoc::AddCenterMark always returns TRUE")
End If
Next i
' zum Schluß heben wir die Selektion noch auf und lassen einmal den
' Bildschirm neu zeichnen, damit alles schön aussieht :-))
DrawingDoc.ClearSelection
DrawingDoc.WindowRedraw
' wenn alles geklappt hat können wir das ja wieder verlassen
Exit Sub
ErrorTrap:
' jetzt ist irgendein Fehler passiert; üblicherweise wurde irgendetwas
' nicht richtig selektiert also geben wir mal einfach eine Erklärungsbox
' aus. Sollte etwas anderes nicht okay gewesen sein oben die Verzweigung
' auf die Fehlerfalle auskommentieren, dann kommen die richtigen
' Fehlermeldungen
Call MsgBox("Ups, Probleme. Bitte vorher eine Fläche in einer Zeichenansicht auswählen", _
vbCritical, "Mittelkreuz Makro")
End Sub
| Kritik und Anregungen bitte an Stefan Berlitz. Letzte Änderung dieser Seite am Donnerstag, 01. Februar 2007 17:40 |