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