Sub-Einsatzblöcke()
---------------------------------------------------------------------------------------
'Inserts Blöcke in Autocad mit Daten - Insertionspunkt, Blockname/Vollweg, Skalenfaktoren, Drehwinkel - von Excel.
"Anmerkung, dass der Blockname oder der Blockpfad bereits vorhanden sein muss, sonst wird nichts eingefügt.
"Der Code verwendet eine Spätbindung, so dass kein Verweis auf externe Autocad-Bibliothek (Typ) erforderlich ist.
"Es versteht sich, dass Autocad auf Ihrem Computer installiert werden muss, bevor dieser Code ausgeführt wird.
'geschrieben von: christos samaras
Datum: 21/04/2014
E-Mail: [email protected]
Website: http://www.myengineeringworld.net
---------------------------------------------------------------------------------------
"Erklärung der notwendigen Variablen.
dim acadapp als Objekt
dim acaddoc als Objekt
dim acadblock als Objekt
dim lastrow as long
dim i solange
dim Einführpunkt(0 bis 2) als Doppel
dim blockname als string
dim blockscale als Scalefactor
Dimm-Drehwinkel als Doppel
Aktivieren Sie das Koordinatenblatt und finden Sie die letzte Zeile.
mit Blättern("Beiträge")
.aktivieren
lastrow = .cells(.rows.count, "i").end(xlup). Zeile
Ende mit
"Überprüfe, ob Koordinaten für mindestens einen Kreis vorhanden sind.
wenn Letzterer < 5
msgbox "es gibt keine Koordinaten für den Insertionspunkt!", vbkritischer "Insertion Point Error"
Ausgang Sub
Ende
' überprüfen, ob autocad Anwendung geöffnet ist. wenn nicht geöffnet wird, erstellen Sie eine neue Instanz und machen sie sichtbar.
auf Fehlerwiederaufnahme
acadapp = getobject(, "autocad.application")
wenn acadapp nichts ist
acadapp = createobject("autocad.application")
acadapp.visible = true
Ende
'Check (wieder) wenn es ein Autocad-Objekt gibt.
wenn acadapp nichts ist
msgbox "sorry, es war unmöglich, Autocad zu starten!", vbkritische, "autocad Error"
Ausgang Sub
Ende
auf fehler goto 0
"Wenn es keine aktive Zeichnung gibt, schaffen Sie eine neue.
auf Fehlerwiederaufnahme
acaddoc = acadapp.activedocument
wenn acaddoc nichts ist
acaddoc = acadapp.documents.add
Ende
auf fehler goto 0
"Überprüfe, ob der aktive Raum Papierraum ist und ändere ihn in den Modellraum.
wenn acaddoc.activespace = 0 dann '0 = acpaperspace in frühe Bindung
acaddoc.activespace = 1 '1 = acmodelspace in frühe Bindung
Ende
auf Fehlerwiederaufnahme
'Loop durch alle Zeilen und fügen Sie die entsprechenden Blöcke in autocad.
mit Blättern("Beiträge")
für i = 5 zu Lasten
Setzen Sie den Blocknamen.
Blockname = .range("l" & i). Wert
"Wenn der Blockname nicht leer ist, fügen Sie den Block ein.
wenn Blockname <> vbnullstring dann
Setzen Sie den Einführpunkt.
Einführungspunkt(0) = .range("i" & i) Wert
Einführungspunkt(1) = .range("j" & i). Wert
Einführungspunkt(2) = .range("k" & i). Wert
'initialisieren Sie die optionalen Parameter.
blockscale.x = 1
blockscale.y = 1
Blockscale.z = 1
Drehwinkel = 0
' die optionalen Parameter festlegen (wenn Werte in den entsprechenden Bereichen vorhanden sind).
wenn .range("m" & i).value <> vbnullstring dann blockscale.x = .range("m" & i). Wert
wenn .range("n" & i).value <> vbnullstring dann blockscale.y = .range("n" & i). Wert
wenn .range("o" & i).value <> vbnullstring dann blockscale.z = .range("o" & i). Wert
wenn .range("p" & i).value <> vbnullstring dann rotationangle = .range("p" & i).value
"den Block mit den Blattdaten (Einschubpunkt, Blockname, Skalenfaktoren und Drehwinkel) angeben.
Die 0,0174532925 soll Grad in Radien umwandeln.
acadblock = acaddoc.modelspace.insertblock(Insertionpoint, Blockname, _
blockscale.x, blockscale.y, blockscale.z, rotationangle * 0.0174532925)
Ende
Ich bin der
Ende mit
Extrakt aus Kakao
' call updateattr
"Zoom in die Zeichnungsfläche.
acadapp.zoomextents
"Entlease die Objekte.
acadblock = nichts
acaddoc = nichts
acadapp = nichts
'informieren Sie den Benutzer über den Prozess.
msgbox "die Blöcke wurden erfolgreich in Autocad eingesetzt!", vbinformation, "vollendet"
Endteil
