---

Hallo zusammen,

Ich habe mir in Excel ein Programm erstellt um Stücklisten zu erstellen. Nun möchte ich gerne das ich von Excel aus die Maße von Objekten aus AutoCAD einfüge.

Das ganze soll folgendermaßen aussehen:

- Button in Excel klicken
- automatisch nach AutoCAD wechseln
- automatisch Befehl aufrufen
  (der Befehl ist ein Lispprogramm womit ich maße in der
  Zwischenablage speicher)
- automatisch zurück nach Excel wechseln

Nun zu meiner Frage:
Was muss ich im VBA-Editor in Excel eingeben, das nach AutoCAD gewechselt wird, der Befehl durchgeführt wird und danach nach Excel zurückgekehrt wird.

Ich hoffe mir kann jemand helfen da ich über VBA nur
sehr wenig kenne.  

mfg Alfonso

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

---

Hallo Alfonso,

bin mir nicht sicher, obs einwandfrei läuft, da ich nicht weiss,
was dein Lisp genau macht (Usereingaben? etc)
U.U. braucht man ja nicht unbedingt ein appactivate,
anyway, spiele mal bissel rum, achja ich bin mal einfach davon ausgegangen, dass Acad gestartet ist;-)

HTH, Nancy
--

Code:

---

Sub test()
    Dim acApp As Object, x
    Set acApp = GetObject(, "Autocad.application")
    x = acApp.activedocument.FullName
    Cells(1, 1) = x
    AppActivate "Autodesk Architectural Desktop 2005"
    ''acApp.activedocument.sendcommand "commandName" & chr(13)
    acApp.activedocument.sendcommand "vbastmt" & Chr(13) & "msgbox now" & Chr(13)
    '''AppActivate "Microsoft Excel"
End Sub

---

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

---

Hallo Nancy,

danke für die schnelle Antwort. Es funktioniert gut.

Ist es auch noch möglich das eine Meldung in Excel kommt, wenn AutoCAD oder eine Zeichnung nich geöffnet ist?

Hier der VBA-Code:

Sub Maßstabholen()
    Dim acApp As Object, x
    Set acApp = GetObject(, "Autocad.application")
    ''x = acApp.activedocument.FullName
    Cells(1, 1) = x
    AppActivate "AutoCAD 2000"
    acApp.activedocument.sendcommand "T2" & Chr(13)
    ''acApp.activedocument.sendcommand "vbastmt" & Chr(13) & "msgbox now" & Chr(13)
    AppActivate "Microsoft Excel"
    ActiveSheet.Paste
    Selection.TextToColumns Destination:=ActiveCell, DataType:=xlFixedWidth, _
    FieldInfo:=Array(Array(0, 1), Array(3, 1)), TrailingMinusNumbers:=True
End Sub

und der Lisp-Code:

(defun c:T2 (/)
  (setq exitflag nil)
  (setq obj nil)
  (setq P1 (getpoint "\nErsten Punkt angeben:"))
  (setq P2 (getcorner P1 "\Zweiten Punkt angeben:"))
  (setq xwert (rtos (- (car P2) (car P1)) 2 0))
  (setq ywert (rtos (- (cadr P2) (cadr P1)) 2 0))
  (setq wert (strcat xwert " " ywert))
  (vl-load-com)
  (setq a1 (vlax-create-object "avbClipboardDLL.avbClipboard"))
  (vlax-invoke a1  "clear")
  (vlax-invoke a1  "SetText" wert)
  (vlax-release-object a1)
  (princ)
)

mfg Alfonso

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

---

Abend Alfonso,

habs nicht auf alle Eventualitäten getestet, naja ein Versuch s.u.,
aber mal general - ich hab' zwar keinen Sprachfehler;-) - aber wenn
ich das richtig deute, misst du da nur zwei Längen in dem Lisp?

Wenn ja, ist das wie von hinten durch die Brust übers clipboard ins xlsheet ;-)
Hab dir mal eine vba-getpoint Methode reingesetzt, da bekommst folgenden Return:

p1(0 to 2) ==> p1(0)=x-Wert : p1(1)=y-Wert : p1(2)=z-Wert

selbiges bei p2.

Rein theoretisch kannste dir das ja dann gleich aus p1 und p2 errechnen, also sprich, das Lisp brauchste dann garnicht.
Wenn das also so in etwa hinkommen könnte mit meiner Vermutung,
stellt sich vielleicht noch die nächste Frage, ob es nicht gleich besser wäre, von Acad nach Excel zu schreiben, als - wie jetzt - andersrum.
Aber okay, kann auch sein ich bin da auf dem Holzweg und du machst in dem Lisp was ganz andres, ich habs nämlich nicht probiert;-)

[edit]achja, die sendcommand-zeile hab ich auskommentiert, wenn du es doch darüber machst, kannst/musst alles ab da bis auf die letzte Zeile mit appActivate auskommentieren.[/edit]

Gruss, Nancy
--

Code:

---

Sub test()
    Dim acApp As Object
    Dim myFile, p1, p2
    On Error Resume Next
    Set acApp = GetObject(, "Autocad.application")
    'wenn Acad nicht gestartet > Acad starten und Zeichnung öffnen
    If Err.Number = 429 Then
        Set acApp = CreateObject("Autocad.application")
        AppActivate Application.Caption
        myFile = Application.GetOpenFilename("dwg-Dateien (*.dwg),*.dwg", , "Zeichnung wählen")
        If myFile <> False Then
            acApp.documents.Open myFile
        Else
            MsgBox "ungültig"
            acApp.Quit
            Set acApp = Nothing
        End If
    End If
    AppActivate acApp.Caption
    '''acApp.activedocument.sendcommand "T2" & Chr(13)
    p1 = acApp.activedocument.utility.getpoint(, "erster Punkt:")
    p2 = acApp.activedocument.utility.getpoint(, "zweiter Punkt:")
    Range(Cells(1, 1), Cells(1, 3)) = Array("x", "y", "z")
    Range(Cells(2, 1), Cells(2, 3)) = p1
    Range(Cells(3, 1), Cells(3, 3)) = p2
    AppActivate Application.Caption
End Sub

---

[Diese Nachricht wurde von startrek am 14. Feb. 2006 editiert.]

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