© Dipl.-Wirtschaftsing. (FH) Franz Ertl Am Sportplatz 9 83365 Nußdorf Internet www.ertls.de Mailto: franz@ertls.de

Auszug aus dem VBA-Buch (Entwurfsphase)

Fehlerbehandlung

· Welche Fehlerarten gibt es

· Wie wird eine Fehlerbehandlungsroutine eingesetzt

· Wie fragt man Fehlernummern ab

Es gibt verschiedene Fehlerarten.

· Laufzeitfehler

· Syntaxfehler

Laufzeitfehler

Laufzeitfehler sind durchnumeriert. Mit der folgenden Fehlerbehandlungsroutine wird die Fehlernummer und die Fehlerbeschreibung als MsgBox ausgegeben.

Es gibt viele Ursachen für Laufzeitfehler, einige sind unten beschrieben.

Fehler 6: Überlauf

Fehler 6 wird verursacht, wenn Sie einer Variablen einen zu großen Wert zuweisen. Z.B. Sie weisen der Variablen bytZahl mit dem Datentyp Byte einen Zahlenwert kleiner 0 oder größer 255 zu.

Fehler 11: Division durch Null

Der Fehler wird verursacht, wenn durch eine Variable geteilt wird, die keinen Wert enthält.

Fehler 13: Tyen unverträglich

Der Fehler wird durch Verwendung eines falschen Datentyps verursacht, z.B. wenn Sie eine Zahl durch einen Text teilen.

Fehlerbehandlungsroutine

Die Anweisung On Error goto FehlerRoutine geht zur Sprungmarke FehlerRoutine:, sobald ein Fehler auftritt.

Vor dieser Sprungmarke befindet sich der Programmcode und die Anweisung

Exit Sub, damit nach Durchlaufen des Programmcodes nicht automatisch die Fehlerroutine durchlaufen wird.

Sub FehlerBehandlung()

Dim intZahl As Integer

Dim intErgebnis As Integer

On Error GoTo FehlerRoutine

'Programmcode

intZahl = 10

intErgebnis = intZahl / 0

Exit Sub

FehlerRoutine:

MsgBox Err.Number

MsgBox Err.Description

End Sub

Syntaxfehler

Syntaxfehler sind vergleichbar mit Rechtschreibfehlern bzw. Grammatikfehlern. Eine Funktion wurde falsch geschrieben.

Viele Fehler sind durch Fehlernummern sofort erkennbar. Z.B. der Fehler 429 besagt, daß das angesprochene Objekt nicht geöffnet ist.

Taucht der Fehler auf, kann er durch eine Bedingung abgefangen und das Objekt geöffnet werden.

Damit das Programm aber nicht unterbrochen wird, muß der Begriff RESUME NEXT eingegeben werden.

Anweisung	Beschreibung
On Error Resume next	Setze in der dem Fehler folgenden Zeile fort
On Error Goto FehlerBehandlungszeile	Springt zur Zeile FehlerBehandlungsroutine: und führt den nachfolgenden Code aus.

Fehler 429: Objekterstellung nicht möglich

Zum Starten von externen Anwendungen, um Daten zu übertragen (z.B. MS-Excel, MS Access...), ist es nötig, die CreateObject-Anweisung zu verwenden. Die Anwendung erstellt eine neue Instanz eines Programms. Führen Sie den Programmcode mehrmals aus, so wird auch mehrmals das entsprechende Programm gestartet.

Die GetObject-Anweisung geht davon aus, daß das externe Programm schon läuft, falls es nicht läuft, wird der Fehler 429 verursacht. Die Fehlerbehandlung prüft, ob die Fehlernummer 429 lautet, wenn das zutrifft, wird das Programm gestartet.

Das folgende Beispiel zeigt den Ablauf mit MS-Excel:

Function ExcelStarten()

'Objektvariable definieren

Dim Excel97 as Excel.Application

On Error GoTo ExcelStarten_Error

Set Excel97 = GetObject(, "excel.Application")

Excel97.Visible = True

'Neue Arbeitsmappe erstellen

Excel97.Workbooks.Add

Exit Function

ExcelStarten_Error:

If Err.Number = 429 Then

Set Excel97 = CreateObject("excel.Application")

Resume Next

End If

End Function

Zeichnungsobjekte

· Welche Zeichenbereiche gibt es

· Wie werden Zeichnungsobjekte erstellt

· Zeichenbefehle

· Erzeugen von 3D-Objekten

Zeichnungsobjekte sind alle grafischen Objekte in AutoCAD. VBA kann bestimmte Zeichnungsroutinen erheblich vereinfachen.

Erstellen von Objekten

Das Erstellen der Objekte erfolgt im Regelfall im Modellbereich.

Zeichenbefehle

Linie

Linien sind grundlegende Objekte einer Zeichnung. Sie werden definiert durch den Startpunkt und den Endpunkt. Der Rückgabewert des Befehls RetVal ist ein Linienobjekt.

Die Anweisung, um eine Linie zu erzeugen sieht folgendermaßen aus.

Beim Schreiben der Anweisung wird die Quickinfo eingeblendet, sobald Sie nach der Anweisung "Addline" die Leertaste betätigen. Sie zeigt Ihnen, welche Argumente als nächstes erfoderlich sind.

Public Sub Beispiel_Linie()

Dim varStart As Variant

Dim varEnd As Variant

On Error Resume Next

With ThisDrawing.Utility

varStart = .GetPoint(, "Startpunkt zeigen:")

varEnd = .GetPoint(, "Endpunkt zeigen:")

End With

ThisDrawing.ModelSpace.AddLine varStart, varEnd

End Sub

Kreis

Das folgende Beispiel zeichnet einen Kreis mit fest vorgegebenenKoordinaten
(x = 100, Y = 100, Z = 0) im Modellbereich.

Function ZeichnenKreis() As AcadCircle

Dim dblZentrum(0 To 2) As Double

Dim dblRadius As Double

'Koordinaten fest definiert

dblZentrum(0) = 100: dblZentrum(1) = 100: dblZentrum(2) = 0

dblRadius = 30

'Zeichnen des Kreises

Set ZeichnenKreis = Thisdrawing.ModelSpace.AddCircle(dblZentrum, dblRadius)

End Function

Bogen

Im folgenden Beispiel wird ein Bogen im Modellbereich erzeugt. Die Bogenparameter sind in AutoCAD einzugeben.

Public Sub Beispiel_Bogen()

Dim varZentrum As Variant, dblRadius As Double

Dim dblStWinkel As Double, dblEndWinkel As Double

On Error Resume Next

With ThisDrawing.Utility

varZentrum = .GetPoint(, "Zentrum zeigen:")

dblRadius = .GetDistance(, "Abstand:")

dblStWinkel = .GetAngle(, "Winkel eingeben:")

dblEndWinkel = .GetAngle(, "Winkel eingeben:")

End With

ThisDrawing.ModelSpace.AddArc varZentrum, dblRadius, dblStWinkel, dblEndWinkel

End Sub

Ellipse

Public Sub Beispiel_Ellipse()

Dim objEll As AcadEllipse

Dim dblHauptAchse As Variant

Dim dblZentrum As Variant

Dim dblVerhaeltnis As Double

On Error Resume Next

With ThisDrawing.Utility

dblZentrum = .GetPoint(, "Zentrum zeigen:")

dblHauptAchse = .GetPoint(, "Hauptachse zeigen:")

dblVerhaeltnis = .GetReal("Verhältnis angeben:")

End With

ThisDrawing.ModelSpace.AddEllipse dblZentrum, dblHauptAchse, dblVerhaeltnis

End Sub

Multilinie

Das Multilinienobjekt zeichnet gleichzeitig bis zu 16 Linien nebeneinander. Die einzelnen Linien können unterschiedliche Farben und Linientypen verwenden. Zum Ändern von Multilinien gibt es in AutoCAD den Befehl MLEDIT, mit welchem Sie relativ einfach Wandanschlüsse zeichnen können. Sollen Multilinienobjekte versetzt oder gestutzt werden, zerlegen Sie das Objekt in den Ursprung. Der MLEDIT-Befehl funktioniert dann nicht mehr.

Sub Beispiel_AddMLine()

Dim objMline As AcadMLine

Dim dblPListe(0 To 17) As Double

dblPListe(0) = 50: dblPListe(1) = 70: dblPListe(2) = 0

dblPListe(3) = 50: dblPListe(4) = 70: dblPListe(5) = 0

dblPListe(6) = 60: dblPListe(7) = 70: dblPListe(8) = 0

dblPListe(9) = 40: dblPListe(10) = 60: dblPListe(11) = 0

dblPListe(12) = 50: dblPListe(13) = 60: dblPListe(14) = 0

dblPListe(15) = 60: dblPListe(16) = 60: dblPListe(17) = 60

Set objMline = ThisDrawing.ModelSpace.AddMLine(dblPListe)

ThisDrawing.Application.ZoomAll

End Sub

Polylinie

Zeichnen Sie einen Linienzug mit dem Befehl LINIE, können die einzelnen Bestandteile des Linienzuges nach belieben gelöscht oder verschoben werden kann. Wurde der Linienzug mit dem Befehl PLINIE erzeugt, handelt es sich um ein einzelnes Objekt. Ein klassisches Beispiel ist das RECHTECK.

Sub ZeichnenPolyline()

Dim objPline As AcadPolyline

Dim dblPListe(0 To 14) As Double

dblPListe(0) = 1: dblPListe(1) = 1: dblPListe(2) = 0

dblPListe(3) = 1: dblPListe(4) = 2: dblPListe(5) = 0

dblPListe(6) = 2: dblPListe(7) = 2: dblPListe(8) = 0

dblPListe(9) = 3: dblPListe(10) = 2: dblPListe(11) = 0

dblPListe(12) = 4: dblPListe(13) = 4: dblPListe(14) = 0

' Create a light weight Polyline object in model space

Set objPline = ThisDrawing.ModelSpace.AddPolyline(dblPListe)

ZoomAll

End Sub

Um Bögen in Polylinien zu erzeugen, zeichnen Sie zuerst die Polyline. Setzen Sie dann den BULGE an den gewünschten Vertex-Punkten mit der Methode SetBulge.

Verwenden Sie zum Erzeugen von Polylinien besser die Methode AddLightweightPolyline. Dieses Objekt spart Speicherplatz.

Konstruktionslinie

Konstruktionslinien sind Linien ohne Start- und Endpunkt. Sie beginnen im Unendlichen und enden im Unendlichen. Sie können gestutzt werden und als Linien in die Konstruktion eingebaut werden.

Public Sub Beispiel_Klinie()

Dim varStart As Variant

Dim varDurch As Variant

With ThisDrawing

varStart = .Utility.GetPoint(, "Startpunkt zeigen:")

varDurch = .Utility.GetPoint(, "2. Punkt zeigen:")

.ModelSpace.AddXline varStart, varDurch

End With

End Sub

Strahl

Der Strahl hat einen definierten Startpunkt, aber keinen Endpunkt.

Public Sub Beispiel_Ray()

Dim varStart As Variant

Dim varDurch As Variant

With ThisDrawing

varStart = .Utility.GetPoint(, "Startpunkt zeigen:")

varDurch = .Utility.GetPoint(, "2. Punkt zeigen:")

.ModelSpace.AddRay varStart, varDurch

End With

End Sub

Spline

Schraffur

Die Schraffur wird als einzelnes Objekt gespeichert. Wenn die Schraffur in den Ursprung zerlegt wird, ist das Schraffurobjekt zerstört. Übrig bleiben einzelne Objekte – wie Linien.

Text

Zum Beschriften von Zeichnungen wird das Text-Objekt verwendet. Es gibt eine Reihe von Parametern, um die Positionierung bzw. den Drehwinkel zu verändern.

Public Sub Beispiel_Text()

Dim varPunkt As Variant

Dim dblHoehe As Double

dblHoehe = 2.5

With ThisDrawing

varPunkt = .Utility.GetPoint(, "Punkt zeigen")

.ModelSpace.AddText "Das ist ein Text", varPunkt, dblHoehe

End with

End Sub

MText

Das MText-Objekt bietet die Möglichkeit, umfangreichere Texte einzufügen. Der Vorteil liegt darin, daß das MTextobjekt, obwohl es mehrere Zeilen umfaßt ein Objekt ist. Wird der Multitext in den Ursprung zerlegt, bleiben einzelne Zeilen als Text-Objekte übrig.

Public Sub Beispiel_MText()

Dim varPunkt As Variant

Dim dblBreite As Double

dblBreite = 50

With ThisDrawing

varPunkt = .Utility.GetPoint(, "Punkt zeigen")

.ModelSpace.AddMText varPunkt, dblBreite, "Das ist ein Text"

End With

End Sub

Punkt

Punkt werden beim Befehl Teilen oder Messen angeordnet. Die Form der Punkte ist über die Systemvariable PdMode einzustellen.

Im folgenden Beispiel wird eine Parabel gezeichnet. Stellen Sie nach dem Durchlauf der Funktion die Systemvariable PDMODE auf z.B. auf 33, um die Parabel zu sehen.

Public Sub Beispiel_Punkt()

Dim varPunkt(0 To 2) As Double

Dim dblXWert As Double

Dim dblYWert As Double

For dblXWert = -10 To 10 Step 0.2

dblYWert = dblXWert * dblXWert

varPunkt(0) = dblXWert

varPunkt(1) = dblYWert

varPunkt(2) = 0

ThisDrawing.ModelSpace.AddPoint (varPunkt)

Next

End Sub

Region

Auf Regionen können die Änderungsbefehle von 3D-Objekten z.B. DIFFERENZ, VEREINIG oder SCHNITTMENGE angewendet werden. Regionen sind Volumenkörper ohne Höhe.

Public Function RegionErzeugen() As Variant

Dim objUmgrenzung(0 To 1) As AcadEntity

Dim dblZentrum(0 To 2) As Double

Dim dblRadius As Double

Dim dblStartWinkel As Double

Dim dblEndWinkel As Double

Dim varRegion As Variant

'Bogen zeichnen

dblZentrum(0) = 50: dblZentrum(1) = 50: dblZentrum(2) = 0

dblRadius = 20

dblStartWinkel = 0

dblEndWinkel = 3.141592

Set objUmgrenzung(0) = ThisDrawing.ModelSpace.AddArc(dblZentrum, dblRadius, dblStartWinkel, dblEndWinkel)

' Linie zeichnen

Set objUmgrenzung(1) = ThisDrawing.ModelSpace.AddLine(objUmgrenzung(0).startPoint, objUmgrenzung(0).endPoint)

RegionErzeugen = ThisDrawing.ModelSpace.AddRegion(objUmgrenzung)

End Function

Solid

Solids sind gefüllte Flächen.

Public Sub Beispiel_Solid()

Dim varPunkt1(0 To 2) As Double

Dim varPunkt2(0 To 2) As Double

Dim varPunkt3(0 To 2) As Double

Dim varPunkt4(0 To 2) As Double

varPunkt1(0) = 20: varPunkt1(1) = 30: varPunkt1(2) = 0

varPunkt2(0) = 100: varPunkt2(1) = 30: varPunkt2(2) = 0

varPunkt3(0) = 60: varPunkt3(1) = 80: varPunkt3(2) = 0

varPunkt4(0) = 80: varPunkt4(1) = 80: varPunkt4(2) = 0

ThisDrawing.ModelSpace.AddSolid varPunkt1, varPunkt2, varPunkt3, varPunkt4

End Sub

Erzeugen von 3D-Objekten

Der Vorteil von 3D-Zeichnungen liegt hauptsächlich in der Möglichkeit, mit SOLZEICH und SOLANS verschiedene Ansichten und Schnitte daraus abzuleiten. Mit dem Befehl MASSEIG können Schwerpunkt und Trägheitsmomente ausgegeben werden. Die perspektivische Darstellung erleichtert es, einen Eindruck der fertigen Konstruktion zu erhalten.

Extrudieren

Die Methode Extrudieren weist dem Objekt eine Höhe zu, wodurch ein messbares Volumen entsteht. Mit der Option, entlang eines Pfades zu extrudieren, können Simse oder Rohrleitungen in 3D gezeichnet werden.

Sub Beispiel_Extrusion()

Dim objUmgrenzung(0 To 1) As AcadEntity

Dim dblZentrum(0 To 2) As Double

Dim dblRadius As Double

Dim dblStWinkel As Double

Dim dblEndWinkel As Double

'Bogen zeichnen

dblZentrum(0) = 50: dblZentrum(1) = 50: dblZentrum(2) = 0

dblRadius = 20

dblStWinkel = 0

dblEndWinkel = 3.141592

Set objUmgrenzung(0) = ThisDrawing.ModelSpace.AddArc(dblZentrum, dblRadius, dblStWinkel, dblEndWinkel)

' Linie zeichnen

Set objUmgrenzung(1) = ThisDrawing.ModelSpace.AddLine(objUmgrenzung(0).startPoint, objUmgrenzung(0).endPoint)

' Region erzeugen

Dim varRegion As Variant

varRegion = ThisDrawing.ModelSpace.AddRegion(objUmgrenzung)

' Extrusionsparameter

Dim dblHoehe As Double

Dim dblVWinkel As Double

dblHoehe = 50

dblVWinkel = 0

' Solid erzeugen

Dim objSolid As Acad3DSolid

Set objSolid = ThisDrawing.ModelSpace.AddExtrudedSolid(varRegion(0), dblHoehe, dblVWinkel)

' Ansichtspunkt

Dim dblAnsicht(0 To 2) As Double

dblAnsicht(0) = -1: dblAnsicht(1) = -1: dblAnsicht(2) = 1

ThisDrawing.ActiveViewport.Direction = dblAnsicht

ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport

End Sub

Extrusion entlang eines Pfades

Rotation

Der Befehl Rotation kann eine Region, eine geschlossene Polylinie oder einen Kreis, um eine Achse rotieren, wodurch ein Volumenkörper entsteht.

Sub Beispiel_AddRevolvedSolid()

Dim varRegion As Variant

'Ruft die Funktion RegionErzeugen auf und weist das Ergebenis

'der Variablen varRegion zu

varRegion = RegionErzeugen

'Festlegen der Rotationsachse

Dim dblPunkt1(0 To 2) As Double

Dim dblPunkt2(0 To 2) As Double

Dim dblWinkel As Double

dblPunkt1(0) = 7: dblPunkt1(1) = 2.5: dblPunkt1(2) = 0

dblPunkt2(0) = 11: dblPunkt2(1) = 1: dblPunkt2(2) = 3

dblWinkel = 6.28

' Solid erzeugen

Dim objSolid As Acad3DSolid

Set objSolid = ThisDrawing.ModelSpace.AddRevolvedSolid(varRegion(0), dblPunkt1, dblPunkt2, dblWinkel)

objSolid.Color = acRed

ZoomAll

' Ansichtspunkt

Dim dblAnsicht(0 To 2) As Double

dblAnsicht(0) = -1: dblAnsicht(1) = -1: dblAnsicht(2) = 1

ThisDrawing.ActiveViewport.Direction = dblAnsicht

ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport

End Sub

Ändern von Objekten

· Verschiedene Änderungsbefehle

· Ändern der Objekteigenschaften

· Ändern von 3D-Objekten

Ein Vorteil von CAD-Zeichnungen gegenüber dem manuellen Zeichnen liegt in der leichten Änderbarkeit.

Kopieren

Mit der Methode Kopieren können Sie eine Kopie von ausgewählte Objekte erzeugen.

Public Sub Beispiel_Kopieren()

Dim objKreis As AcadCircle

Set objKreis = KreisZeichnen 'hier wird die Funktio KreisZeichnen aufgerufen

'Kopieren

Dim copyobjKreis As AcadCircle

Set copyobjKreis = objKreis.Copy()

' Verschiebevektor

Dim dblPunkt1(0 To 2) As Double

Dim dblPunkt2(0 To 2) As Double

dblPunkt1(0) = 50: dblPunkt1(1) = 50: dblPunkt1(2) = 0

dblPunkt2(0) = 70: dblPunkt2(1) = 70: dblPunkt2(2) = 0

' Schieben und umfärben

copyobjKreis.Move dblPunkt1, dblPunkt2

copyobjKreis.Color = acRed

ZoomAll

End Sub

Löschen

Die Lösch-Methode löscht ausgewählte Objekte.

Das nachfolgende Beispiel markiert nacheinander alle Kreise und fragt, ob der markierte Kreis gelöscht werden soll.

Public Sub ObjLoeschen()

Dim objEnt As AcadEntity

Call KreisZeichnen

For Each objEnt In ThisDrawing.ModelSpace

If objEnt.ObjectName = "AcDbCircle" Then

objEnt.Highlight True

If MsgBox("Soll der Kreis gelöscht werden?", vbYesNo) = vbYes Then

objEnt.Delete

End If

End If

Next

End Sub

Auflösen

Mit der Methode Auflösen zerlegen Sie Polylinien, Blöcke, 3D-Körper usw. in den Ursprung. Vorsicht, z.B. bei Schraffuren und 3D-Körpern ist der Prozess nicht umkehrbar.

Die nachfolgende Routine ruft die Funktion PolylinieZeichnen (nächste Seite) auf. Danch wird die Polylinie in den Ursprung zerlegt und die Einzelteile werden hervorgehoben und mit einer Zählerschleife werden die einzelnen Objekte in unterschiedlichen Farben dargestellt. Beim ersten Schlefendurchlauf erhält das erste Objekt die Farbe 1, beim zweiten Durchlauf das zweite Objekt die Farbe 2 usw.

Sub Beispiel_Ursprung()

Dim objPline As AcadLWPolyline

Dim intI As Integer

Set objPline = PolylinieZeichnen

' Ursprung

Dim varObjekte As Variant

varObjekte = objPline.Explode

'Einzelobjekte durchlaufen

For intI = 0 To UBound(varObjekte)

varObjekte(intI).Highlight True

MsgBox "Ein Teil der ursprünglichen Polylinie"

varObjekte(intI).Color = intI

varObjekte(intI).Update

Next

End Sub

Die nachfolgende Funktion zeichnet eine Polylinie.

Public Function PolylinieZeichnen() As AcadLWPolyline

Dim dblpunkte(0 To 11) As Double

' Punkte für Polylinie

dblpunkte(0) = 10: dblpunkte(1) = 10

dblpunkte(2) = 10: dblpunkte(3) = 20

dblpunkte(4) = 20: dblpunkte(5) = 20

dblpunkte(6) = 30: dblpunkte(7) = 20

dblpunkte(8) = 40: dblpunkte(9) = 40

dblpunkte(10) = 40: dblpunkte(11) = 10

Set PolylinieZeichnen = ThisDrawing.ModelSpace.AddLightWeightPolyline(dblpunkte)

' Kreisbogen am Punkt 3

PolylinieZeichnen.SetBulge 3, -0.2

End Function

Hervorheben

Mit der Methode Hervorheben können Objekte gestrichelt angezeigt werden. Die Systemvariable HIGHLIGTH steuert, ob ausgewählte Objekte in AutoCAD gestrichelt dargestellt werden.

Public Sub ObjHighlight()

Dim objEnt As AcadEntity

For Each objEnt In ThisDrawing.ModelSpace

objEnt.Highlight True

MsgBox "Es handelt sich um ein Objekt vom Typ " & objEnt.ObjectName

Next

End Sub

Spiegeln

Die Methode Spiegeln erstellt ein gespiegeltes Abbild der Auswahl. Sie haben die Möglichkeit, die Auswahl zu löschen und nur das Spiegelbild zu erhalten oder beide Objekte zu behalten.

Sub Beispiel_Spiegeln()

Dim objPline As AcadLWPolyline

Set objPline = PolylinieZeichnen

plineObj.Closed = True

'Spiegelachse festlegen

Dim point1(0 To 2) As Double

Dim point2(0 To 2) As Double

point1(0) = 0: point1(1) = 4.25: point1(2) = 0

point2(0) = 4: point2(1) = 4.25: point2(2) = 0

'Spiegelung durchführen

Dim objSpiegeln As AcadLWPolyline

Set objSpiegeln = plineObj.Mirror(point1, point2)

objSpiegeln.Color = acRed

ZoomAll

End Sub

Mirrtext

Die Systemvariable MirrText steuert, ob der Text mitgespiegelt wird oder nicht. Mirrtext = 1 spiegelt den Text.

Schieben

Die ausgewählten Objekte werden an eine Position verschoben.

Public Sub Beispiel_Schieben()

Dim objKreis As AcadCircle

Dim dblpunkt1(0 To 2) As Double

Dim dblpunkt2(0 To 2) As Double

Set objKreis = KreisZeichnen

' Punkte definieren

dblpunkt1(0) = 0: dblpunkt1(1) = 0: dblpunkt1(2) = 0

dblpunkt2(0) = 2: dblpunkt2(1) = 0: dblpunkt2(2) = 0

MsgBox "Der Kreis wird um " _

& dblpunkt2(0) - dblpunkt1(0) & " in X-Richtung und um " _

& dblpunkt2(1) - dblpunkt1(1) & " in Y-Richtung verschoben"

' Verschiebung

objKreis.Move dblpunkt1, dblpunkt2

ZoomAll

End Sub

Versetzen

Gewählte Objekte werden kopiert und um einen bestimmten Abstand von einem Originalobjekt weggeschoben. Wenn Kreise versetzt werden, erhalten Sie konzentrische Kreise.

Bei Polylinien werden die Objekte nicht nur kopiert, sondern die Linienlängen angepaßt, so daß die Proportionen erhalten bleiben.

Die Beispielprozedur ruft eine Funktion auf, die ein LightWeight-Polylinien-Objekt zurückgibt. Anschließend wird das Polylinienobjekt um 5 Einheiten versetzt. Die versetzte Polylinie wird rot gezeichnet.

Public Sub Beispiel_Versetzen()

Dim objPolylinie As AcadLWPolyline

'Aufruf der Funktion ZeichnenLwPolylinie

Set objPolylinie = ZeichnenLwPolylinie

objPolylinie.Closed = True

' Versetzen

Dim objVersetzen As Variant

objVersetzen = objPolylinie.Offset(5)

objVersetzen(0).Color = acRed

End Sub

Die Funktion ZeichnenPolylinie:

Function ZeichnenLwPolylinie() As AcadLWPolyline

Dim dblPunkte(0 To 15) As Double

'2D-Punkte für Polylinie definieren

dblPunkte(0) = 100: dblPunkte(1) = 100

dblPunkte(2) = 100: dblPunkte(3) = 150

dblPunkte(4) = 125: dblPunkte(5) = 150

dblPunkte(6) = 125: dblPunkte(7) = 175

dblPunkte(8) = 175: dblPunkte(9) = 175

dblPunkte(10) = 175: dblPunkte(11) = 150

dblPunkte(12) = 200: dblPunkte(13) = 150

dblPunkte(14) = 200: dblPunkte(15) = 100

' Polylinie im Modellbereich zeichnen

Set ZeichnenLwPolylinie = ThisDrawing.ModelSpace.AddLightWeightPolyline(dblPunkte)

End Function

Drehen

Gewählte Objekte werden um einen bestimmten Winkel um einen Drehpunkt gedreht.

Diese Sub-Prozedur ruft die Funktion ZeichnenPolylinie auf, um eine Polylinie zu erstellen. Danach wird ein Winkelwert über die InputBox abgefragt. Der eingegebene Winkelwert wird dann in das Bogenmaß umgerechnet.

Sub Beispiel_Drehen()

Dim objPlinie As AcadLWPolyline

'Funktion Polylinie aufrufen

Set objPlinie = ZeichnenLwPolylinie

MsgBox "Die Polylinie wird um 45° gedreht.", , "Drehen mit VBA"

' Define the rotation

Dim dblBasis(0 To 2) As Double

Dim dblWinkel As Double

dblWinkel = Winkel2Rad(45)

'45° werden in das Bogenmaß umgesetzt

dblBasis(0) = 100: dblBasis(1) = 100: dblBasis(2) = 0

'drehen

objPlinie.Rotate dblBasis, dblWinkel

ZoomExtents

End Sub

Die nachfolgende Funktion rechnet die eingegebenen Dezimalgrad in das Bogenmaß um.

Public Function Winkel2Rad(dblRad As Double) As Double

Winkel2Rad = dblRad * 3.14159265358979 / 180

End Function

Skalieren

Diese Methode erlaubt das proportionale verkleinern bzw. vergrößern von gewählten Objekten.

Nach dem Zeichnen der Polylinie über die Funktion ZeichnenPolylinie wird der Basispunkt für die Skalierung festgelegt und die Skalierung durchgeführt.

Diese Methode erlaubt das proportionale verkleinern bzw. vergrößern von gewählten Objekten.

Sub Beispiel_Skalieren()

Dim objPlinie As AcadLWPolyline

Dim dblbasis(0 To 2) As Double

Dim dblfaktor As Double

'2 mal die Funktion Polylinie aufrufen, einmal Originalgröße,

'einmal auf die Hälfte verkleinert

Set objPlinie = ZeichnenLwPolylinie

Set objPlinie = ZeichnenLwPolylinie

' Skalierung festlegen

dblbasis(0) = 100: dblbasis(1) = 100: dblbasis(2) = 0

dblfaktor = 0.5

'Skalierung durchführen

objPlinie.ScaleEntity dblbasis, dblfaktor

ZoomExtents 'Zoom Grenzen

End Sub

Reihe rechteckig

Der Befehl Reihe kopiert Objekte. Für die rechteckige Reihe geben Sie den Abstand der Objekte und die Anzahl der Zeilen und Spalten an.

Sub Example_ArrayRectangular()

Dim objKreis As AcadCircle

Set objKreis = KreisZeichnen

'rechteckige Reihe definieren

Dim lngZeilen As Long

Dim lngSpalten As Long

Dim lngEbenen As Long

Dim dblAbZeilen As Double

Dim dblAbSpalten As Double

Dim dblAbEbenen As Double

lngZeilen = 5

lngSpalten = 5

lngEbenen = 2

dblAbZeilen = 100

dblAbSpalten = 100

dblAbEbenen = 100

' Reihe erzeugen

Dim retObj As Variant

retObj = objKreis.ArrayRectangular(lngZeilen, lngSpalten, lngEbenen, dblAbZeilen, dblAbSpalten, dblAbEbenen)

ZoomExtents

End Sub

Reihe polar

Für die polare Reihe geben Sie das Zentrum der Drehung, die Anzahl der Objekte und den auszufüllenden Winkel an.

Sub PolareReihe()

Dim objKreis As AcadCircle

'Funktion Kreiszeichnen

Set objKreis = KreisZeichnen

'Polare Reihe definieren

Dim intAnzahl As Integer

Dim dblWinkel As Double

Dim dblBasis(0 To 2) As Double

intAnzahl = 7

dblWinkel = 360 / 180 * 3.1415926 'Vollkreis

dblBasis(0) = 0#: dblBasis(1) = 50#: dblBasis(2) = 0#

Dim retObj As Variant

retObj = objKreis.ArrayPolar(intAnzahl, dblWinkel, dblBasis)

ZoomExtents

End Sub

Eigenschaften ändern

Mit den bisher besprochenen Methoden können Sie Objekte in der Geometrie oder Anordnung verändern. Die Methoden zum Ändern der Eigenschaften betreffen die Darstellung der Objekte.

Objektfarbe

Mit dieser Methode kann die Farbe einzelner Objekte geändert werden.

Im Beispiel werden mit Hilfe einer Schleife die Farben von 1 bis 7 durchlaufen.

Sub Beispiel_ObjektFarbe()

Dim plineObj As AcadPolyline

Dim inti As Integer

' Polylinie zeichnen

Dim dblPunkte(8) As Double

dblPunkte(0) = 50: dblPunkte(1) = 50: dblPunkte(2) = 0

dblPunkte(3) = 100: dblPunkte(4) = 50: dblPunkte(5) = 0

dblPunkte(6) = 100: dblPunkte(7) = 150: dblPunkte(8) = 0

ZoomAll

Set plineObj = ThisDrawing.ModelSpace.AddPolyline(dblPunkte)

For inti = 1 To 7 'Farbe über Zählerschleife setzen

PlineObj.Color = inti

ThisDrawing.Regen (True)

MsgBox "Jetzt sehen Sie die Farbe mit der Nummer " & inti

Next

plineObj.Color = 256 'vonLayer

End Sub

Layer-Eigenschaft

Mit der Layer-Methode können Sie gewählte Objekte auf einen anderen Layer legen.

Das folgende Beispiel erzeugt den Layer "Konstruktion_035" und weist ihm die Farbe rot zu. Danach wird ein Kreis gezeichnet und die Objekteigenschaft LAYER auf Konstruktion_035 gesetzt.

Sub Beispiele_Layer()

' Layer erzeugen

Dim objLayer As AcadLayer

Set objLayer = ThisDrawing.Layers.Add("Konstruktion_035")

objLayer.Color = acRed

' Kreis zeichnen

Dim objKreis As AcadCircle

Dim dblZentrum(0 To 2) As Double

Dim dblRadius As Double

dblZentrum(0) = 3: dblZentrum(1) = 3: dblZentrum(2) = 0

dblRadius = 1.5

Set objKreis = ThisDrawing.ModelSpace.AddCircle(dblZentrum, dblRadius)

ZoomAll

'die Eigenschaft Layer des Kreises auf Konstruktion_035 ändern

objKreis.Layer = "Konstruktion_035"

'Regenerieren

ThisDrawing.Regen (True)

End Sub

Linientyp-Eigenschaft

Sie können den Linientyp von Objekten ändern.

Die folgende Prozedur ruft zuerst die Funktion LinientypLaden auf, danach die Funktion LinieErzeugen und ändert dann die Linientyp-Eigenschaft der neu gezeichneten Linie.

Sub Beispiel_Linientyp()

Dim objLinie As AcadLine

LinientypLaden 'Funktion LinientypLaden aufrufen

Set objLinie = LinieErzeugen 'Funktion LinieErzeugen

'Linientyp ändern

objLinie.Linetype = "acad_iso02w100"

ZoomAll

End Sub

Funktion LinientypLaden:

Public Sub LinientypLaden()

Dim objLinie As AcadLineType

Dim blnGefunden As Boolean

blnGefunden = False

For Each objLinie In ThisDrawing.Linetypes

If StrComp(objLinie.Name, "Acad_Iso02W100", 1) = 0 Then

blnGefunden = True

Exit For

End If

Next

If Not (blnGefunden) Then ThisDrawing.Linetypes.Load "Acad_Iso02W100", "acad.lin"

End Sub

Funktion LinieErzeugen:

Function LinieErzeugen() As AcadLine

Dim dblStart(0 To 2) As Double

Dim dblEnde(0 To 2) As Double

dblStart(0) = 50: dblStart(1) = 50: dblStart(2) = 0

dblEnde(0) = 100: dblEnde(1) = 100: dblEnde(2) = 0

Set LinieErzeugen = ThisDrawing.ModelSpace.AddLine(dblStart, dblEnde)

End Function

Sichtbarkeit-Eigenschaft

Hier steuern Sie, welche Objekte sichtbar bzw. unsichtbar sind.

Die folgende Prozedur zeichnet eine Linie, und fragt dann über eine Dialogbox ab, ob die gezeichnete Linie sichtbar oder unsichtbar sein soll. Über die Schaltfläche Abbrechen beenden Sie die Prozedur.

Function Visible()

Dim objLinie As AcadLine

Set objLinie = LinieErzeugen ' FunktionLinieErzeugen aufrufen

DISPLAY:

Dim response As Integer

response = MsgBox("Linie anzeigen?", vbYesNoCancel)

Select Case response

Case vbYes

objLinie.Visible = True

Case vbNo

objLinie.Visible = False

Case vbCancel

Exit Function

End Select

ThisDrawing.Regen True

GoTo DISPLAY

End Function

Ändern von 3D-Objekten

Häufig ergeben sich während des Konstruktionsvorganges Änderungen. Das Ändern von 3D-Objekten war in AutoCAD 14 nur bedingt möglich. In AutoCAD 2000 gibt es nun einige Methoden zum Ändern von 3D-Körpern.Bool’ sche Operationen.

Volumenkörper können nicht nur im Stück gezeichnet werden, sondern aus bestehenden Objekten erzeugt werden. Was Sie in der Schule unter dem Begriff Mengenlehre lernten, zeigt AutoCAD nun in der Praxis.

Schnittmenge

Die Schnittmenge kann aus Körpern erzeugt werden, die sich teilweise oder komplett überlagern.

Sub Beispiel_Schnittmenge()

Dim objQuader As Acad3DSolid

Dim dblQuZentrum(0 To 2) As Double

Dim dblQuHoehe As Double

Dim dblQuBreite As Double

Dim dblQuLaenge

dblQuZentrum(0) = 20: dblQuZentrum(1) = 20: dblQuZentrum(2) = 0

dblQuLaenge = 50: dblQuBreite = 50: dblQuHoehe = 50

' Quader erzeugen

Set objQuader = ThisDrawing.ModelSpace.AddBox(dblQuZentrum, dblQuLaenge, dblQuBreite, dblQuHoehe)

'Zylinder zeichnen

Dim objZylinder As Acad3DSolid

Dim dblZZentrum(0 To 2) As Double

Dim dblZRadius As Double

Dim dblZHoehe As Double

dblZZentrum(0) = 50: cylinderCenter(1) = 50: cylinderCenter(2) = 0

dblZRadius = 25

dblZHoehe = 100

Set objZylinderObj = ThisDrawing.ModelSpace.AddCylinder(cylinderCenter, cylinderRadius, cylinderHeight)

' Ansichtspunkt

Dim NewDirection(0 To 2) As Double

NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1

ThisDrawing.ActiveViewport.Direction = NewDirection

ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport

ZoomAll

MsgBox "Die Schnittmenge von 2 Körpern", vbOKOnly

objQuader.Boolean acIntersection, cylinderObj

ThisDrawing.Regen True

MsgBox "Fertig"

End Sub

Differenz

Bohrungen in einem Volumenkörper werden erzeugt, indem man in das Volumen eines Grundkörpers einen Zylinder zeichnet und den Zylinder mit der Methode Differenz vom Grundkörper abzieht.

Vereinigung

Mit der Methode Vereinigung kann aus vielen Einzelkörpern ein Gesamtkörper entstehen. Achten Sie darauf, daß Körper, die ein gemeinsames Volumen belegen und nicht mit Vereinigung zu einem Teil gemacht wurden, bei der Volumenberechnung ein falsches Ergebnis liefern.

Masseneigenschaften

Mit den Masseeigenschaften können Sie Volumen, Trägheits-, Deviationsmomente u.a. berechnen lassen. Über VBA können Sie auch eine Dichte zuweisen und die Masse berechnen. In AutoCAD gibt es diese Option nicht. Dort wird die Masse mit der Dichte 1 und entspricht damit dem Volumen.

Volumenberechnung

Das folgende Beispiel ruft die Funktion ZeichnenQuader auf, die den Datentyp Acad3DSolid zurückgibt. Der Rückgabewert wird durch 1.000.000 geteilt, um die mm³ in dm³ umzurechnen.

Vom Rückgabewert wird die Eigenschaft Volumen abgefragt.

Sub Beispiel_Volumen()

Dim dblVolumen As Double

dblVolumen = ZeichnenQuader.Volume / 1000000

AnsichtIso 'Funktion AnsichtIso aufrufen

ZoomAll

MsgBox "Das Volumen beträgt " & dblVolumen & " Kubikdezimeter." & vbCr _

& "Bei einer Dichte von 8 Kg/dm³ eine Masse von " & dblVolumen * 8 & " kg"

End Sub

Funktion QuaderZeichnen erstellt einen Quader:

Function ZeichnenQuader() As Acad3DSolid

Dim dblLaenge As Double, dblBreite As Double, dblHoehe As Double

Dim dblZentrum(0 To 2) As Double

dblZentrum(0) = 50: dblZentrum(1) = 50: dblZentrum(2) = 0

dblLaenge = 50: dblBreite = 70: dblHoehe = 100

Set ZeichnenQuader = ThisDrawing.ModelSpace.AddBox(dblZentrum, dblLaenge, dblBreite, dblHoehe)

End Function

Funktion AnsichtIso schaltet auf Iso Südwest um:

Function AnsichtIso()

Dim dblRichtung(0 To 2) As Double

dblRichtung(0) = -1: dblRichtung(1) = -1: dblRichtung(2) = 1

ThisDrawing.ActiveViewport.Direction = dblRichtung

ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport

End Function

Die folgende Prozedur berechnet das Flächenträgheitsmoment:

Public Sub Beispiel_Traegheit()

Dim TrMoment As Variant

AnsichtIso 'Ansicht Isometrie, siehe oben

TrMoment = ZeichnenQuader.momentOfInertia 'ZeichenQuader siehe oben

MsgBox "Das Trägheitsmoment ist " & TrMoment(0) & ", " & TrMoment(1) & ", " & TrMoment(2)

End Sub

Die folgende Prozedur zeigt die Hauptrichtungen des Quaders an.

Sub Beispiel_Hauprichtungen()

Dim varHauptrichtung As Variant

varHauptrichtung = ZeichnenQuader.PrincipalDirections

AnsichtIso

ZoomAll

MsgBox "Die Hauptrichtungen sind " & varHauptrichtung(0) & ", " & varHauptrichtung(1) & ", " & varHauptrichtung(2)

End Sub

Nachfolgend sehen Sie die Berechnung der Hauptmomente des Quaders:

Sub Beispie_Hauptmomente()

Dim varHauptMomente As Variant

varHauptMomente = ZeichnenQuader.PrincipalMoments

AnsichtIso

ZoomAll

MsgBox "Die Hauptmomente sind I: " & varHauptMomente(0) & ", J: " & varHauptMomente(1) & ", K: " & varHauptMomente(2)

End Sub

Deviation:

Sub Beispiel_Produkt()

Dim varProdukt As Variant

varProdukt = ZeichnenQuader.ProductOfInertia

MsgBox "Deviation XY " & varProdukt(0) & ", YZ " & varProdukt(1) & ", ZX " & varProdukt(2)

End Sub

Trägheitsradien

Sub Beispiel_Radien()

Dim varRadien As Variant

varRadien = ZeichnenQuader.RadiiOfGyration

MsgBox "The RadiiOfGyration for the box is " & varRadien(0) & ", " & varRadien(1) & ", " & varRadien(2)

End Sub

Schwerpunkt:

Sub MassenSchwerPunkt()

Dim varSchwerPunkt As Variant

varSchwerPunkt = ZeichnenQuader.Centroid

MsgBox "Der Schwerpunkt liegt in " & varSchwerPunkt(0) & ", " & varSchwerPunkt(1)

End Sub