---

Hallo Zusammen!

Nochmal zum Thema Block aus einem Verzeichnis/Ordner in die aktuelle Zeichnung über die Mausposition einfügen.

Geht dieses wirklich nicht über die GetPoint Funktion?
Über das LispTool "blockin" funktioniert es auch nicht.

Hier mal meine Versuche:

Code:

---

Private Sub CommandButton9_Click()
Dim NewInstBlock As AcadBlock
Dim NewInstBlockDef As AcadBlockReference
Dim dwgpath As String
Dim returnPnt As Variant
dwgpath = "c:\Temp\011_188x35_BA128_S.dwg"
returnPnt = ThisDrawing.Utility.GetPoint(, "Enter a point: ")
Set NewInstBlockDef = ThisDrawing.ModelSpace.InsertBlock(returnPnt, dwgpath, 1, 1, 1, 0)
End Sub

---

Code:

---

Private Sub CommandButton9_Click()
Dim NewInstBlock As AcadBlock
Dim NewInstBlockDef As AcadBlockReference
Dim dwgpath As String
dwgpath = "c:\Temp\011_188x35_BA128_S.dwg"
ThisDrawing.SendCommand "(blockIn " & dwgpath & ")" & vbCr
ThisDrawing.SendCommand "(blockIn2 " & dwgpath & ")" & vbCr
End Sub

---

Code:

---

Private Sub CommandButton9_Click()
Dim NewInstBlock As AcadBlock
Dim NewInstBlockDef As AcadBlockReference
Dim dwgpath As String
Dim returnPnt(2) As Double
returnPnt(0) = 0: returnPnt(1) = 0: returnPnt(2) = 0
dwgpath = "c:\Temp\011_188x35_BA128_f.dwg"
Me.Hide
Set NewInstBlockDef = ThisDrawing.ModelSpace.InsertBlock(returnPnt, dwgpath, 1, 1, 1, 0)
End Sub

---

Vielen Dank.

Gruß

Dirk

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

---

Hi Dirk,

Wo hats du denn deine Probleme mit dem Lisp?!

Mit Getpoint wirst du den Block nicht am Fadenkreuz sichtbar einfügen können.

Gruß, Carsten

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

---

Hi Dirk,

Noch ein kleiner Nachtrag:

Ersetz doch mal

Code:

---

dwgpath = "c:\Temp\011_188x35_BA128_S.dwg"
ThisDrawing.SendCommand "(blockIn " & dwgpath & ")" & vbCr

---

gegen

Code:

---

dwgpath = """c:\Temp\011_188x35_BA128_S.dwg"""
ThisDrawing.SendCommand "(blockIn " & dwgpath & ")" & vbCr

---

Gruß, Carsten

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

---

Hi Carsten!

Folgendes Problem habe ich noch.
Mit diesem Programmcode funktioniert es so weit, allerdings erst nach dem 2 Klick. Erst dann wird der Block eingefügt.

Code:

---

Private Sub CommandButton9_Click()
Dim NBlock1 As AcadBlockReference
Dim Prompt1 As String
Dim IPoint As Variant
Dim dwgPath As String
Dim dwgName As String
dwgPath = TextBox1.Value & "\"
dwgName = ListView1.SelectedItem.Text & ".dwg"
On Error Resume Next
Me.Hide
Prompt1 = vbCrLf & "Einfügepunkt:"
IPoint = ThisDrawing.Utility.GetPoint(, Prompt1) 'Einfügepunkt
Set NBlock1 = ThisDrawing.ModelSpace.InsertBlock(IPoint, dwgPath & dwgName, 1, 1, 1, 0)
End Sub

---

Nach dem ersten Programmstart / Klick erscheint in der Befehlszeile:

Einfügepunkt:*Abbruch*

Hast Du da ne Idee woran es liegen kann?

Gruß

Dirk

PS. mit dem blockin bekomme ich es nicht zum laufen

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

---

Hi Dirk,

Kannst du bitte nochmal eine DVB davon machen und uploaden?!
Wenn ich den Code ohne ne Form starte klappt das ohne Probleme.
Wie lautet denn der Aufruf (im Acad) für das Makro?!

Was passiert denn beim blockin, das du es nicht hinbekommst?! Kommt da ne Fehlermeldung?!

Gruß, Carsten

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

---

Bild01.jpg

Hi Carsten!

Das Programm spielt sich innerhalb einer UserForm ab und wird aus einem Modul her ausgeführt.

Code:

---

Sub User_Dialog() 'Dialog aufrufen
    UserForm1.Show
End Sub

---

ListView füllen:

Code:

---

Private Sub CommandButton4_Click()
Dim Anzahl As Integer
Dim PicList As ListItem
Anzahl = 0
Dim cFile As String
Dim i As Integer

    ListView1.View = lvwReport
    ListView1.ColumnHeaders.Clear
    ListView1.ColumnHeaders.Add , , "Bildname"
bmpPath = TextBox1.Value & "\"                      '"c:\Temp\"                                            '& "*.bmp")

 
    ListView1.ListItems.Clear
    ImageList1.ListImages.Clear
        cFile = Dir(bmpPath & "*.bmp")                    'sPath & sPattern(0))
    Do While cFile <> "" 'Wiederholen bis cFile=""
        Anzahl = Anzahl + 1
        'Größe der Bilder in der ImageList
        ImageList1.ImageHeight = 32
        ImageList1.ImageWidth = 32
        'Image aus Datei
        Image1.PictureSizeMode = fmPictureSizeModeZoom
        Image1.Picture = LoadPicture(bmpPath & cFile)
        'Image zu der ImageList
        ImageList1.ListImages.Add Anzahl, , Image1.Picture
        'Zuordnung zum ListView1
        ListView1.Icons = ImageList1
        ListView1.SmallIcons = ImageList1
        'ListView erzeugen
        Set PicList = ListView1.ListItems.Add(Anzahl, cFile, Left(cFile, Len(cFile) - 4), Anzahl, Anzahl)
        'nächste Datei
        cFile = Dir ' Aufruf der Funktion ohne Parameter!!
    Loop
Kill bmpPath & "*.bmp"
End Sub

---

Auf der UserForm (siehe Bild01) wir der Pfad über Ordnerauswahl in die TextBox geladen.
Danach erfolgt der Verzeichnisdurchlauf zur Erzeugung der Bilder für das ListView.
Per Buttonklick werden diese ins ListView geladen.
Markiere ich einen ListView Eintrag, soll per Buttonklick der eintprechende Block geladen werden.

Ist alles soweit durchgelaufen und ich drücke den Button zum einfügen des Blocks, bekomme ich in der Befehlszeile die Meldung

Einfügepunkt:*Abbruch*

Führ ich das Programm erneut aus, erscheinen die Felder / Liste durch die Me.Hide Funktion ja bereits gefüllt. Drücke ich dann den Einfügebutton funktioniert es problemlos.

Gruß

Dirk

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

---

Hi Dirk,

Das die Textboxen usw. beim 2. Aufruf gefüllt sind, liegt daran, das du die Form nicht entlädst(mit unload) sondern im Speicher belässt (mit hide).

Ich dir mal ne PM geschickt.

Gruß, Carsten

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