VBA-Code läuft nicht unter ACAD 2013 (Autodesk/AutoCAD VBA)

Hallo zusammen,

vorab: ich bin ziemlicher VBA-Anfänger! Aber ich habe es geschafft, mir diesen
Programmcode zum Zeichen von Planrahmen zu erstellen. Das Programm hat
unter verschiedenen ACAD-Versionen (von 2007 bis 2012) immer funktioniert.
Jetzt wollte ich es auf einem Rechner mit ACAD CIVIL 2013 64bit anwenden.
Das Programm gibt mir aber schon bei der Zeile " Dim lineObj1 As AcadLine "
ein Fehlermeldung...

Muss das Programm komplett umgeschrieben werden? Und wenn ja, wie und wo
kann ich da Hilfe zu finden???

Danke für jede Hilfe!
Gruß Jörg

Hier der VBA-Code:

'***** Zeichnen **************

Private Sub CommandButton2_Click()
On Error Resume Next
Dim lineObj1 As AcadLine
Dim startPoint(0 To 2) As Double
Dim endPoint(0 To 2) As Double
Dim returnPnt As Variant
Dim farbe1 As Variant
Dim farbe2 As Variant

Dim textObj As AcadText
Dim textString As String
Dim height As Double
Dim insertionPoint(0 To 2) As Double
Dim STEMPEL As AcadLayer
Dim basePoint(0 To 2) As Double
Dim rotationAngle As Double

Set STEMPEL = ThisDrawing.Layers.Add("STEMPEL")
ThisDrawing.ActiveLayer = STEMPEL

breite = (TextBox1)
höhe = (TextBox2)
f = (TextBox3)
If Val(f) < 100 Then
'MsgBox (Val(f))
f = Val(TextBox3 * 100)
End If
If Val(TextBox3) < 500 Then
farbe1 = 2
Else
farbe1 = 1
End If

If Val(TextBox3) = 1000 Then
farbe1 = 5
End If

farbe2 = 3

dx = Val(breite) * Val(f) / 1000
dy = Val(höhe) * Val(f) / 1000
'MsgBox (dx & "/" & dy)
'ZoomAll
'Unload Me
'Me.Hide

Me.Hide
'vPoint = ThisDrawing.Utility.GetPoint(, "Punkt wählen")
'Me.Show

'MsgBox ("Bitte Ecke unten-links auswählen ")
returnPnt = ThisDrawing.Utility.GetPoint(, "Enter a point: ")

x = returnPnt(0)
y = returnPnt(1)

'Rahmen außen

startPoint(0) = x: startPoint(1) = y: startPoint(2) = 0
endPoint(0) = x + dx: endPoint(1) = y: endPoint(2) = 0
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
lineObj.Color = farbe1
startPoint(0) = x + dx: startPoint(1) = y: startPoint(2) = 0
endPoint(0) = x + dx: endPoint(1) = y + dy: endPoint(2) = 0
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
lineObj.Color = farbe1

startPoint(0) = x + dx: startPoint(1) = y + dy: startPoint(2) = 0
endPoint(0) = x: endPoint(1) = y + dy: endPoint(2) = 0
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
lineObj.Color = farbe1

startPoint(0) = x: startPoint(1) = y + dy: startPoint(2) = 0
endPoint(0) = x: endPoint(1) = y: endPoint(2) = 0
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
lineObj.Color = farbe1

'Rahmen innen

startPoint(0) = x + 0.025 * f: startPoint(1) = y + 0.005 * f: startPoint(2) = 0
endPoint(0) = x + dx - 0.005 * f: endPoint(1) = y + 0.005 * f: endPoint(2) = 0
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
lineObj.Color = farbe2

startPoint(0) = x + dx - 0.005 * f: startPoint(1) = y + 0.005 * f: startPoint(2) = 0
endPoint(0) = x + dx - 0.005 * f: endPoint(1) = y + dy - 0.005 * f: endPoint(2) = 0
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
lineObj.Color = farbe2

startPoint(0) = x + dx - 0.005 * f: startPoint(1) = y + dy - 0.005 * f: startPoint(2) = 0
endPoint(0) = x + 0.025 * f: endPoint(1) = y + dy - 0.005 * f: endPoint(2) = 0
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
lineObj.Color = farbe2

startPoint(0) = x + 0.025 * f: startPoint(1) = y + dy - 0.005 * f: startPoint(2) = 0
endPoint(0) = x + 0.025 * f: endPoint(1) = y + 0.005 * f: endPoint(2) = 0
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
lineObj.Color = farbe2

If Val(TextBox1) < 297 Then
GoTo 1000:
End If

'Hilfslinie,senkrecht

startPoint(0) = x + dx - 0.185 * f: startPoint(1) = y: startPoint(2) = 0
endPoint(0) = x + dx - 0.185 * f: endPoint(1) = y + dy: endPoint(2) = 0
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
lineObj.Color = farbe1

If Val(TextBox2) < 297 Then
GoTo 1000:
End If

'Hilfslinien,waagerecht

startPoint(0) = x: startPoint(1) = y + 0.297 * f: startPoint(2) = 0
endPoint(0) = x + 0.025 * f: endPoint(1) = y + 0.297 * f: endPoint(2) = 0
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
lineObj.Color = farbe1

startPoint(0) = x + dx: startPoint(1) = y + 0.297 * f: startPoint(2) = 0
endPoint(0) = x + dx - 0.005 * f: endPoint(1) = y + 0.297 * f: endPoint(2) = 0
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
lineObj.Color = farbe1

'Hilfslinien,waagerecht(oben)

If Val(TextBox2) > 594 Then
startPoint(0) = x: startPoint(1) = y + 2 * 0.297 * f: startPoint(2) = 0
endPoint(0) = x + 0.025 * f: endPoint(1) = y + 2 * 0.297 * f: endPoint(2) = 0
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
lineObj.Color = farbe1

startPoint(0) = x + dx: startPoint(1) = y + 2 * 0.297 * f: startPoint(2) = 0
endPoint(0) = x + dx - 0.005 * f: endPoint(1) = y + 2 * 0.297 * f: endPoint(2) = 0
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
lineObj.Color = farbe1
End If

1000:

'Beschriftung

textString = TextBox1 & " mm"
insertionPoint(0) = x: insertionPoint(1) = y - 0.2 * f
height = 0.1 * f
Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)

textString = TextBox2 & " mm"
insertionPoint(0) = x + dx + 0.2 * f: insertionPoint(1) = y
height = 0.1 * f
Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)
basePoint(0) = x + dx + 0.2 * f: basePoint(1) = y
rotationAngle = 1.570796
textObj.Rotate basePoint, rotationAngle

textString = "1:" & TextBox3
insertionPoint(0) = x + dx / 6: insertionPoint(1) = y + dy / 2
height = 0.1 * f
Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)

'ZoomAll

End Sub

------------------
AutoCAD CIVIL 3D 2011

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