Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de
  AutoCAD VBA
  VBA-Code läuft nicht unter ACAD 2013

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
  
Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte
  
NVIDIA GTC Paris und ISC High Performance-Konferenz 2025, eine Pressemitteilung
Autor Thema:  VBA-Code läuft nicht unter ACAD 2013 (1556 mal gelesen)
jobau
Mitglied
Bauingenieur


Sehen Sie sich das Profil von jobau an!   Senden Sie eine Private Message an jobau  Schreiben Sie einen Gästebucheintrag für jobau

Beiträge: 209
Registriert: 21.01.2003

erstellt am: 24. Okt. 2012 10:39    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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

Carsten1210
Mitglied
staatl. geprüfter Holztechniker


Sehen Sie sich das Profil von Carsten1210 an!   Senden Sie eine Private Message an Carsten1210  Schreiben Sie einen Gästebucheintrag für Carsten1210

Beiträge: 1360
Registriert: 24.07.2002

AutoCAD ACA 2024
Solidworks 2022 Sp5
Enterprise PDM 2022 Sp5
Pascam Woodworks
Visual Studio 2017 Pro
Windows 10 64Bit
Dell Precision 3660
Intel Core i9-12900K
32 GB Arbeitsspeicher
2x Dell U2415

erstellt am: 24. Okt. 2012 10:47    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für jobau 10 Unities + Antwort hilfreich

Hi,

Hast du schon mal die Verweise überprüft?!

Gruß, Carsten

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

jobau
Mitglied
Bauingenieur


Sehen Sie sich das Profil von jobau an!   Senden Sie eine Private Message an jobau  Schreiben Sie einen Gästebucheintrag für jobau

Beiträge: 209
Registriert: 21.01.2003

erstellt am: 24. Okt. 2012 11:06    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo Carsten,

was genau meinst du mit "Verweise überprüfen" ?

Gruß Jörg

------------------
AutoCAD CIVIL 3D 2012

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

Carsten1210
Mitglied
staatl. geprüfter Holztechniker


Sehen Sie sich das Profil von Carsten1210 an!   Senden Sie eine Private Message an Carsten1210  Schreiben Sie einen Gästebucheintrag für Carsten1210

Beiträge: 1360
Registriert: 24.07.2002

AutoCAD ACA 2024
Solidworks 2022 Sp5
Enterprise PDM 2022 Sp5
Pascam Woodworks
Visual Studio 2017 Pro
Windows 10 64Bit
Dell Precision 3660
Intel Core i9-12900K
32 GB Arbeitsspeicher
2x Dell U2415

erstellt am: 24. Okt. 2012 11:27    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für jobau 10 Unities + Antwort hilfreich

Hi Jörg,

Ich meine in der IDE-Umgebung unter Extras, Verweise.
Steht da irgendwo nicht vorhanden?!

Gruß, Carsten

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

jobau
Mitglied
Bauingenieur


Sehen Sie sich das Profil von jobau an!   Senden Sie eine Private Message an jobau  Schreiben Sie einen Gästebucheintrag für jobau

Beiträge: 209
Registriert: 21.01.2003

erstellt am: 24. Okt. 2012 11:44    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo Carsten,

vielen DANK für deine schnellen Antworten. Also ich habe jetzt
unter Extras/Verweise den Haken bei "Autocad 2013 Type Library" ergänzt.
Bei meinem Rechner ist auch noch ein Haken bei "Microsoft Forms 2.0 Object Library"
gesetzt. An dem anderen Rechner fehlt diese Option. Muss ich die Datei
irgendwo runterladen?

Gruß Jörg

------------------
AutoCAD CIVIL 3D 2012

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

CAD-Huebner
Ehrenmitglied V.I.P. h.c.
Verm.- Ing., ATC-Trainer



Sehen Sie sich das Profil von CAD-Huebner an!   Senden Sie eine Private Message an CAD-Huebner  Schreiben Sie einen Gästebucheintrag für CAD-Huebner

Beiträge: 9807
Registriert: 01.12.2003

AutoCAD 2.5 - 2022, LDD, MDT, RD, ADT, Civil
Inventor AIP 4-11, 2008 -2022
Win 10

erstellt am: 24. Okt. 2012 13:15    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für jobau 10 Unities + Antwort hilfreich

Zitat:
Original erstellt von jobau:
... ein Haken bei "Microsoft Forms 2.0 Object Library"
gesetzt. An dem anderen Rechner fehlt diese Option. Muss ich die Datei
irgendwo runterladen?

Gruß Jörg



Ich weiß gar nicht, ob der Verweis nötig ist (ist bei mir z.B. auch nicht).
Aber wenn du den Verweis erstellen möchtest, gehe auf Verweise > "Durchsuchen..." und suche nach
C:\Windows\System\FM20.dll (bzw.- SysWOW64 auf 64 bit Systemen)

------------------
Mit freundlichem Gruß

Udo Hübner
www.CAD-Huebner.de

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

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2025 CAD.de | Impressum | Datenschutz