---

Hallo,
ich habe ein kleines VBA-Programm geschrieben, das nach Vorgabe (Länge, Breite und Radius) ein Langloch zeichnet und als Block in die Zeichnung einfügt. Der Name von diesem Block wird automatisch erstellt.

Nun habe ich 2 kleine Probleme, die ich bis jetzt mit der Suchfunktion und google nicht lösen konnte.

1. Das automatische Erstellen des Blocknamens habe ich wie folgt gelöst:

blockname = "Langloch " + laenge + "x" + breite + "_r" + radius
Set Block = ThisDrawing.Blocks.Add(Bpkt, blockname)

Das funktioniert, solange Länge, Breite oder Radius ganze Zahlen sind. Sind es Kommazahlen, bekomme ich Fehlermeldung. Wenn ich die Variablen vorher als Double deklariere, bekomme ich eine Fehlermeldung bei der zweiten Zeile. Was mache ich falsch?

2. Angenommen der Benutzer erstellt ein Langloch 30x20_r10. Tage später fügt er das Gleiche Langloch noch mal ein (mit meinem VBA Programm), mit gleichen Namen natürlich. Nun habe ich das Problem, dass das Langloch in dem Block „doppelt“ gezeichnet ist. Erstellt man noch mal identisches Langloch, ist das Langloch dreifach im Block drin usw.
D.h. der vorhandene Block wird mit dem neuen Block zusammengefügt.
Wie kann ich vor dem einfügen des Blockes abfragen a) ob dieser Blockname/Block schon vorhanden ist und b) mit z.b. MsgBox abfragen ob der alte Block ersetzt werden soll?

Vielen Dank
Georg

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

---

Hi Georg,

Zitat:

---

Sind es Kommazahlen, bekomme ich Fehlermeldung

---

Sonderzeichen sind in Blocknamen nicht, daher könntest Du diese vorher ersetzen:

Code:

---

blockname = "Langloch " + replace(replace(laenge,",","_"),".","_") + "x" + replace(replace(breite,",","_"),".","_") + "_r" + replace(replace(radius,",","_"),".","_")

---

Zitat:

---

das Gleiche Langloch noch mal ein (mit meinem VBA Programm), mit gleichen Namen natürlich

---

da musst Du zuerst überprüfen, ob es schon eine Blockdefinition mit dem Namen existiert, bevor Du eine solche erstellst.
Der bequemere Weg:

Code:

---

On Error Resume Next
dim tBlDef as AcadBlock
set tBlDef = ThisDrawing.Blocks.Item(BlockName)  '<BlockName> steht für Deinen Blocknamen
if (tBlDef is Nothing) then
  'die Blockdefinition existiert noch nicht
  'muss erstellt werden
....

---

- alfred -

------------------
www.hollaus.at

---

Alfred,
Danke für die sehr schnelle Antwort.

Die Funktion replace funktioniert wunderbar. Ich verstehe aber nicht, wieso du sie doppelt einsezt. so funktioniert es bei mir auch:

blockname = "Langloch " + Replace(laenge, ",", ".") + "x" + Replace(breite, ",", ".") + "_r" + Replace(radius, ",", ".")

zu Punkt 2. mein Quellcode sieht in Moment so aus:

Dim Block As AcadBlock
Dim blockname As String
Dim BlockRef As AcadBlockReference
Dim text1 As String
Dim IPoint As Variant
...
blockname = "Langloch " + Replace(laenge, ",", ".") + "x" + Replace(breite, ",", ".") + "_r" + Replace(radius, ",", ".")
Set Block = ThisDrawing.Blocks.Item(blockname)
If (Block Is Nothing) Then
Bpkt(0) = laenge / 2: Bpkt(1) = breite / 2: Bpkt(2) = 0
Set Block = ThisDrawing.Blocks.Add(Bpkt, blockname)
End If
... hier kommt das Quelltext, mit dem die Zeichnung erstellt wird...
Me.Hide
text1 = vbCrLf & "Einfügepunkt anklicken:" 'Aufforderung
IPoint = ThisDrawing.Utility.GetPoint(, text1) 'Einfügepunkt
Set BlockRef = ThisDrawing.ModelSpace.InsertBlock(IPoint, blockname, 1, 1, 1, 0)

Ende:
End Sub

Ich habe das Gefühl, dass ich was mit "set Block" nicht richtig mache.

Georg

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

---

Dimensionierung?
Dim Bpkt(0 To 2) As Double

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

---

Ja KlaK,
das ist bei mir im Quelltext dabei, ich habe versucht nur die relevanten Sachen einzufügen und habe diese eine Zeile vergessen.

ich muss noch vielleicht dazu sagen, dass das Programm ohne:
Set Block = ThisDrawing.Blocks.Item(blockname)
If (Block Is Nothing) Then
End If
problemlos läuft.

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

---

Hi,   

Zitat:

---

Die Funktion replace funktioniert wunderbar. Ich verstehe aber nicht, wieso du sie doppelt einsezt

---

Wenn Du genau schaust, dann ersetze ich mit meiner Version erstmal den Punkt gegen ein Underline und dann den Beistrich gegen ein Underline. Wieso mach ich das: erstens, weil ich zu faul zum Denken bin und zweitens, weil es in unterschiedlichen Programmiersprachen (gepaart mit unterschiedlichen Ländereinstellungen in Windows) immer unterschiedliche Ausgaben von Zahlenwerten gibt, wenn man diese in einen Text umwandelt.

Da kann die Dezimaltrennung mal ein Beistrich, mal ein Punkt sein; und zur Draufgabe gibt's dann hie und da noch ein Tausenderzeichen. ==> Mit dem zweifachen 'Replace' hab ich alles raus  

[EDIT]
zu spät gekommen

Das Programm läuft durch, weil Du oben 'On Error Resume Next' drin hast, folglich wird eine neuerliche Blockdefinition (wenn ein Block mit diesem Namen schon existiert) übergangen und ignoriert.

Welche Fehlermeldung hast Du denn?

[/EDIT]

- alfred -

------------------
www.hollaus.at

[Diese Nachricht wurde von a.n. am 13. Feb. 2009 editiert.]

---

On Error Resume Next habe ich rausgenommen.
Wenn ich das Programm in einer leeren Zeichnung, die noch keine Blöcke hat, starte, Zeigt er ein Fehler bei oder besser gesagt markiert er mir:
Set Block = ThisDrawing.Blocks.Item(blockname)

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

---

Und das ist auch richtig so, denn wenn Du einen Block zuweisen möchtest, den es nicht gibt, ist das eben ein Fehler.

Deshalb mache ich es entweder so wie Du am Anfang mit:
on error resume next
Set Block = ThisDrawing.Blocks.Add(Bpkt, blockname)
If Err <> 0 then
  Set Block = ThisDrawing.Blocks.Item(blockname)
End If
on error goto 0

oder (die sauberste Lösung) ich verwende eine Unterroutine, die alle Blöcke in Blocks durchsucht. Wenn der Block nicht vorhanden ist wird er erzeugt. Die Funktion gibt dann den Block (vorhanden oder neu erzeugt) zurück.
Nachteil bei der zweiten Variante: Bei vielen Blöcken in der Zeichnung kann das Durchsuchen schon etwas dauern.

Grüße,
Klaus

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

---

Ich habe nochmal den 1. Vorschlag von Alfred angeguckt und herumexperementiert. Nun klappt es.
So sieht es jetzt aus:

blockname = "Langloch " + Replace(laenge, ",", ".") + "x" + Replace(breite, ",", ".") + "_r" + Replace(radius, ",", ".") 'Blockname automatisch erstellen
Set Block = ThisDrawing.Blocks.Item(blockname)
If (Block Is Nothing) Then
Bpkt(0) = laenge / 2: Bpkt(1) = breite / 2: Bpkt(2) = 0
Set Block = ThisDrawing.Blocks.Add(Bpkt, blockname)
...Quellcode fürs Langloch...
End if
Me.Hide
text1 = vbCrLf & "Einfügepunkt anklicken:" 'Aufforderung
IPoint = ThisDrawing.Utility.GetPoint(, text1) 'Einfügepunkt
Set BlockRef = ThisDrawing.ModelSpace.InsertBlock(IPoint, blockname, 1, 1, 1, 0)

Vielen Dank Alfred und Klaus!!!
Grüße
Georg

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