---

Hallo Leute,

ich bin neu hier, und finde das Forum sehr gut. Nun habe ich ein Problem in VB6. Ich dachte am Anfang nichts leichter als das, aber langsam bin ich am verzweifeln. Ich will einfach einen Block aus einer DWG in eine andere kopieren. Ja, ich habe die "Suche" benutzt und gefolgt, aber es will trotzdem nicht so recht. Hier mal der code:

Code:

---

Private Sub Command1_Click()
    Call CopyBlock("MEIN_BLOCK", "C:\Source.dwg", "C:\Target.dwg")
End Sub

Public Sub CopyBlock(sBlockName As String, sSourceFile As String, sTargetFile As String)
    Dim oAcad As AcadApplication
    On Error Resume Next
    Set oAcad = GetObject(, "AutoCAD.Application")
   
    If Err Then
        MsgBox "AutoCAD starten und so..."
        Exit Sub
    End If
   
    Dim oSource As AcadDocument
    Set oSource = oAcad.Documents.Open(sSourceFile)
   
    Dim oBlockRef As AcadBlockReference
    For Each oBlockRef In oSource.ModelSpace
        If oBlockRef.EntityName = "AcDbBlockReference" Then
            If oBlockRef.Name = sBlockName Then
                Exit For
            End If
        End If
    Next

    Dim oTarget As AcadDocument
    Set oTarget = oAcad.Documents.Open(sTargetFile)

    Call oTarget.ModelSpace.InsertBlock(oBlockRef.InsertionPoint, oBlockRef.Name, oBlockRef.XScaleFactor, oBlockRef.YScaleFactor, oBlockRef.ZScaleFactor, oBlockRef.Rotation)
End Sub

---

Leider wird der Block "MEIN_BLOCK" nicht in die Target.dwg eingefügt. Was mache ich denn falsch ??? Bin für jede Hilfe dankbar.

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

---

Hi hunter,

kleiner Vorschlag via Copy, hab faulerweise bissel reingeharkt, einmal zum Selbstbausatz ;-)

Gruss Nancy

Code:

---

Sub Command1_Click()
    'Call CopyBlock("MEIN_BLOCK", "C:\Source.dwg", "C:\Target.dwg")
    Call CopyBlock("myBlock", "C:\temp\test.dwg")
End Sub

Public Sub CopyBlock(sBlockName As String, sTargetFile As String)
'Public Sub CopyBlock(sBlockName As String, sSourceFile As String, sTargetFile As String)
'    Dim oAcad As AcadApplication
'    On Error Resume Next
'    Set oAcad = GetObject(, "AutoCAD.Application")
'    If Err Then
'        MsgBox "AutoCAD starten und so..."
'        Exit Sub
'    End If
    Dim oSource As AcadDocument, Otarget As AcadDocument
    'Set oSource = oAcad.Documents.Open(sSourceFile)
    Set oSource = Documents("Zeichng1.dwg")
    Dim myCopy(0 To 0) As Object, newO
    Dim oBlockRef As AcadBlockReference
    For Each oBlockRef In oSource.ModelSpace
      If oBlockRef.EntityName = "AcDbBlockReference" Then
        If oBlockRef.Name = sBlockName Then
          Set myCopy(0) = oBlockRef
          Exit For
        End If
      End If
    Next
    Set Otarget = Documents.Open(sTargetFile)
    newO = oSource.CopyObjects(myCopy, Otarget.ModelSpace)
End Sub

---

 

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

---

Hallo Nancy,

vielen Dank für den Tip. Funktioniert super! So einfach kann die Welt sein. Die Unities sind unterwegs...

lg

bug_hunter

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