Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  AutoCAD VBA
  Block copieren und neu einfügen

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
Autor Thema:  Block copieren und neu einfügen (2468 mal gelesen)
H.D.
Mitglied



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

Beiträge: 25
Registriert: 12.05.2005

P4 3.20 GHz
1,00 GB RAM
WinXP SP2
Autodesk Architectural Desktop 2004

erstellt am: 20. Jul. 2005 15:10    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,

ich habe folgendes Problem:

Ich möchte einen Block aus einer Zeichnung (diese besteht nur aus einem Block) copieren und diesen in der aktuellen Zeichnung einfügen.
Ich habe es schon mit CopyObjects probiert, hatte das Problem, dass das Quelldocument mit dem Zieldocument übereinstimmen muss.

Hier mein bisherigern Code:

Public Sub ImportBlock()
Dim vEinfuege as Variant
Dim abrCopyBlock as AcadBlockReference
Dim abBlock as AcadBlock
Dim abCopyBlock as AcadBlock
Dim ActDoku as AcadDocument
Dim OpenDoku as AcadDocument
On Local Error Resume Next

'...
'Hier wird vorher nach der entsprechenden Zeichnung gesucht
'...

Set ActDoKu = ThisDrawing.Application.ActiveDokument
Set OpenDoku = ThisDrawing.Application.Documents.Open(.DateiPfad.Text)
Set abBlock = ThisDrawing.Blocks("Test")
vEinfuege=ActDoku.Utility.GetPoint(, "Einfuegepunkt angeben")

Set abCopyBlock = ActDoku.Blocks.Add(vEinfuege, abBlock.Name)
set abrCopyBlock = ActDoku.Modelspace.InstertBlock(vEinfuege, abBlock.Name, 1#, 1#, 1#,0)

'Hier müsste ich den abBlock dem abCopyBlock zuweisen, copieren ...?

End sub

Ich stehe auf dem Schlauch und/oder habe ein Brett vorm Kopf. Ich hoff Ihr könnt mir helfen.

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

fuchsi
Mitglied
Programmierer c#.net Datawarehouse


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

Beiträge: 1201
Registriert: 14.10.2003

AutoCad Version 2012 deu/enu
<P>Windows 7 64bit

erstellt am: 20. Jul. 2005 16:11    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 H.D. 10 Unities + Antwort hilfreich

das geht mit Object DBX viel einfacher

Leider habe ich nur ein Beispiel in LISP, wie man von einer externen Datei einen Block in die aktive Zweichnung kopieren kann. Aber vielleicht kannst du das nach VBA konvertieren

; Routinen für Object DBX Zugriff auf externe Zeichnungen
;
; (OdbxOpenDwg name)
;    -> name follstaändiger pfad mit .dwg
;    <- documentObject oder nil
;
; (OdbxCloseDwg doc)
;    -> documentObject
;    <- nil
;
; (OdbxCopyBlock doc blname newName)
;    -> documentObject
;    -> name  Blockname im sourcedocument
;    -> newnname  neuer Name im aktivem docuement oder nil bei gleichem namen
;    <- t bzw. nil

;------------------------------------------------------------------------------
; Öffnen                                                                     
;------------------------------------------------------------------------------
(defun OdbxOpenDwg (name /  iacad idoc )

  (cond ((and (findfile name)
      (setq iacad (vlax-get-acad-object))
              (setq idoc  (try 'vla-GetInterfaceObject (list iacad  "ObjectDBX.AxDbDocument")))
      (try 'vla-open (list idoc name))
)
    idoc
)
(t nil)
  )
)
;------------------------------------------------------------------------------
; schließen einer Zeichnung                                                   
;------------------------------------------------------------------------------
(defun OdbxCloseDwg ( doc / )
  (try 'vlax-release-object (list doc))
  nil
)
;------------------------------------------------------------------------------
; Kopiert aus einer geöffneten Zeichnung eine Blockdefinition                 
; in die aktuelle Zeichnung                                                   
; Rückgabe wert t bzw. nil                                                   
;------------------------------------------------------------------------------
(defun OdbxCopyBlock (doc blname newName / array blocks block )

  (cond ((and (setq array (vlax-make-safearray vlax-vbObject (cons 0  0)))
              (setq blocks (try 'vla-get-blocks (list doc)))
              (setq block (try 'vlax-invoke (list blocks "ITEM" blname)))
      (if newname (try 'vlax-put-property (list block "NAME" newName)) t)
              (vlax-safearray-put-element array 0 block)
              (try 'vla-CopyObjects (list doc array (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object)))))
) t)
(t nil)
  )
)

------------------

Ing. Anton Fuchs
WWW.FFZELL.AT.TC

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

fuchsi
Mitglied
Programmierer c#.net Datawarehouse


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

Beiträge: 1201
Registriert: 14.10.2003

AutoCad Version 2012 deu/enu
<P>Windows 7 64bit

erstellt am: 20. Jul. 2005 16: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 H.D. 10 Unities + Antwort hilfreich

habe im vorigen Lisp-Beispiel die Funktion Try vergessen, die wird dazu benötigt.


Das ganz wird dann so verwendet

(setq doc (OdbxOpenDwg "d:\\test.dwg"))
(OdbxCopyBlock doc "Blockname_in_test.dwg"  "gewünschter_Blockname_in_aktueller_Zeichnung)
(OdbxCloseDwg doc)


;------------------------------------------------------------------------------
; Testroutine ergibt nil im Fehlerfall ansonst den Rückgabewert der zu       
; testenden Funktion                                                         
; ist der Rückgabewert der Funktion auch im Erfolgsfall nil                   
; wird t zurückgegeben                                                       
;                                                                             
;  (try '+ (list 1 2 3 4 5 6))  ergibt 21                                     
;  (try '/ (list 5 0))          ergibt nil                                   
;------------------------------------------------------------------------------
(defun Try ( func arg / a1 a2 )
  (setq a2 (vl-catch-all-error-p  (setq a1 (vl-catch-all-apply func arg))))
  (cond (a2  nil)
(a1 a1)
(t t)
  )
)

------------------

Ing. Anton Fuchs
WWW.FFZELL.AT.TC

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

H.D.
Mitglied



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

Beiträge: 25
Registriert: 12.05.2005

P4 3.20 GHz
1,00 GB RAM
WinXP SP2
Autodesk Architectural Desktop 2004

erstellt am: 20. Jul. 2005 16:29    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

Danke für die schnelle Antwort Fuchsi!

Da ich noch nie "geLISPelt", bitte nich übel nehmen, habe, muss ich mal sehen wie und was ich aus deinem Code umsetzen Kann.

Auf jeden Fall 10U von mir.

H.D.

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

fuchsi
Mitglied
Programmierer c#.net Datawarehouse


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

Beiträge: 1201
Registriert: 14.10.2003

AutoCad Version 2012 deu/enu
<P>Windows 7 64bit

erstellt am: 20. Jul. 2005 16:45    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 H.D. 10 Unities + Antwort hilfreich

hab mal schnell das in VBA ausprobiert

das geht ja noch viel einfacher als in LISP !!!

    Set odbx = ThisDrawing.Application.GetInterfaceObject("ObjectDBX.AxDbDocument.16") ' für Acad2005 !!!!!!!

    odbx.Open ("d:\test.dwg") ' die externen Zeichnung

    Dim objCollection(0) As Object
    Set objCollection(0) = odbx.Blocks("sourceblock") ' der zu kopierende Blockname
    Call odbx.CopyObjects(objCollection, ThisDrawing.ModelSpace)

------------------

Ing. Anton Fuchs
WWW.FFZELL.AT.TC

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

H.D.
Mitglied



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

Beiträge: 25
Registriert: 12.05.2005

P4 3.20 GHz
1,00 GB RAM
WinXP SP2
Autodesk Architectural Desktop 2004

erstellt am: 20. Jul. 2005 17:04    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

Noch mal Danke Fuchsi,

werde das morgen Früh sofort ausprobieren!

Gruss H.D.

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

H.D.
Mitglied



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

Beiträge: 25
Registriert: 12.05.2005

P4 3.20 GHz
1,00 GB RAM
WinXP SP2
Autodesk Architectural Desktop 2004

erstellt am: 21. Jul. 2005 08:50    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

Moin zusammen!

@Fuchsi:

Ich habe deinen VBA-Code mal ausprobiert. Mit dem Kopieren/Einfügen des Blockes habe ich noch ein Problem.
Der Variablen ObjCollection wurde der Richtige Block zugewiesen, aber er erscheint nicht in der Zeichnung, obwohl ein Block mit dem passenden Name eingefügt wurde???

Dann habe ich noch eine Frage zu der Programmzeile:

Set odbx = ThisDrawing.Application.GetInterfaceObject("ObjectDBX.AxDbDocument.16") ' für Acad2005

Was bedeutet: "ObjectDBX.AxDbDocument.16" das? und wieso  "für Acad2005", scheint auch bei Autodesk 2004 zufunktionieren,welches ich benutze.

Gruss H.D.

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

fuchsi
Mitglied
Programmierer c#.net Datawarehouse


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

Beiträge: 1201
Registriert: 14.10.2003

AutoCad Version 2012 deu/enu
<P>Windows 7 64bit

erstellt am: 21. Jul. 2005 09:20    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 H.D. 10 Unities + Antwort hilfreich

Zitat:
Original erstellt von H.D.:
Moin zusammen!

@Fuchsi:

Ich habe deinen VBA-Code mal ausprobiert. Mit dem Kopieren/Einfügen des Blockes habe ich noch ein Problem.
Der Variablen ObjCollection wurde der Richtige Block zugewiesen, aber er erscheint nicht in der Zeichnung, obwohl ein Block mit dem passenden Name eingefügt wurde???

Dann habe ich noch eine Frage zu der Programmzeile:

Set odbx = ThisDrawing.Application.GetInterfaceObject("ObjectDBX.AxDbDocument.16") ' für Acad2005

Was bedeutet: "ObjectDBX.AxDbDocument.16" das? und wieso  "für Acad2005", scheint auch bei Autodesk 2004 zufunktionieren,welches ich benutze.

Gruss H.D.


Natürlich erscheint der Block nicht in der Zeichnung. Wir kopieren mit diesem Code auch lediglich die Blockdefinition aus der externen DWG in die aktuelle Zeichnung. Das Einfügen des Blockes im Modellbereich musstz du dann schon auf herkömmlichen Weg
(thisdrawing.ModelSpace.InsertBlock) machen. (schau mal mit dem Befehl -Block ? * nach, ob die Blockdefinition aus der externen Dwg reinkopiert wurde.)

zu ObjectDBX.AxDbDocument.16
Mit dem wird quasi ein "simuliertes" Autocad erzeugt. Damit kannst du Zeichnungen öffnen, verändern und abspeichern ohne dass du die Zeichnung im Editor von Acad öffnest. Das hat den Vorteil, dass das Ding deswegen sauschnell ist.
Dieses Quasi-Autocad verwendet z.B.: auch das Designcenter zum Auslesen von externen Zeichnungen.

Ich habe geschrieben "für Autocad 2005". das bezieht sich auch das .16
bei der 2000er Serie von Autodesk müsste es nämli9ch .15 heissen.
Bei der 2004er Serie (acad 2004 2005 2006?) heisst es halt .16

------------------

Ing. Anton Fuchs
WWW.FFZELL.AT.TC

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

H.D.
Mitglied



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

Beiträge: 25
Registriert: 12.05.2005

P4 3.20 GHz
1,00 GB RAM
WinXP SP2
Autodesk Architectural Desktop 2004

erstellt am: 21. Jul. 2005 09:52    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

Danke Fuchsi,

jetzt funktioniert es!

Gruss H.D.

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

MetZip
Mitglied


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

Beiträge: 6
Registriert: 05.07.2005

erstellt am: 05. Sep. 2005 15:09    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 H.D. 10 Unities + Antwort hilfreich

Hallo,
Habe eure Diskussion verfolgt. Meine Frage hierzu: Gibt es mit diesem "simulierten" Autocad auch eine Möglichkeit zu plotten oder kennt jemand einen anderen Lösungsansatz. Mit >thisdrawing.plot< bei "offenen" Autocad kann man das ja ohne Probleme machen.
Ich möchte gerne mit VB Layouts einer Zeichnung plotten können, ohne das AutoCAD komplett geladen wird.

Grüsse, MetZip

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

Stelli1
Moderator
Verm.-Ing.


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

Beiträge: 1521
Registriert: 17.08.2005

Map 2000-2014, Rasterdesign,
MapGuide, Autodesk Topobase,
VS6, VS.net 2013

erstellt am: 05. Sep. 2005 19:59    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 H.D. 10 Unities + Antwort hilfreich

Hallo Fuchsi,

da die Diskussion wieder aufgenommen ist..
.. noch die ein oder andere Frage/Problem.

Mit ..

Code:

Dim arx As Object
'Dim arx As AxDbDocument
Dim col(0) As Object
Dim blockdef As AcadBlock
Dim acadTyp As String

acadTyp = Left$(ThisDrawing.Application.Version, 2)

Set arx = ThisDrawing.Application.GetInterfaceObject("ObjectDBX.AxDbDocument." & acadTyp)
arx.Open "D:\Daten_PZ\PZ_AW_DIN.DWG"
   
    For Each blockdef In arx.Blocks
        If blockdef.IsLayout = False Then
          Set col(0) = blockdef
          Call arx.CopyObjects(col, ThisDrawing.Blocks)
        End If
    Next blockdef

Set arx = Nothing


kopiert das Script (eigentlich schön schnell) die gewünschten
Blöcke.
Frage 1: Muss/Kann man die Zeichnung wieder schliessen?
Frage 2: Bei Map6/ ACAD2002 hat die Bezeichnung des InterfaceObjektes
wohl eine anderes Schema. Hier läufst nicht ("Fehler beim laden der Anwendung")
Da das Ganze auch mit Map6/acad2002 laufen soll, hat einer eine Idee??

Gruss
Stelli1

------------------

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)2023 CAD.de | Impressum | Datenschutz