Falscher Ansatz lieber Kollege
Also entweder Lispeln wir oder wir machen VBA.
Klar kann man das mixen, was aber zur allgemeinen Freude weit mehr sonderbare Randprobleme verurscht als das einmal komplett
sauber durchzuziehen (Falls möglich manche Sachen gibt es nur in LISP manche nur In VBA etc und als letzten Ausweg gibt es den Mix oder gar ne VB.NET lib).
Das Sendcommanden und lispeln ist auch äußerst langsam.
Es gibt ausnahmen. Sowas macht Sinn wenn der angestoßene Befehl nativ im Autocad in C programmiert wurde.
Ich habe mal ne reload alle xrefs routine in VBA geschrieben. Klar funzt die.
Ist aber logischerweise gemessen an dem was man mit sendcommand absetzt (ein befehl) langsam.
Das macht Autoacad intern mit C++ Da brauche ich nicht nachzudenken warum das fix ist.
Andrerseits Vorteil meiner Routine die bricht nicht einfach ab. Solange die was findet reloadet die.
KLar habe ich beide Varianten im Repartoire.
Aber das nur am Rande.
Ich verweise "nur am Rand darauf das" ich einige ziemlich umfangreiche Blockbibliotheken hier hochgeladen und der Allgemeinheit zur Verfügung gestellt habe.
Da gibt es auch ne Isch dich machen Block inne Zeichnung Routine (Und so ziemlich alles was man über das bearbeiten von Blöcken nieh wissen wollte umbenennen löschen Entitys addieren etc).
Diese untenstehende Routine fügt einen Block in einen Block ein. (Die ist dort auch in der Bibliothek)
Woabei man wissen sollt edas der Modelspace oder paperspace auch nur ein Block ist.
WWenn man den Targetblock weg lässt wirds der modelspace
Der erste Parameter ist der Koordinatenpunkt wo eingefügt werden soll.
Als Variant weil einige ACAD Befehle koordinaten in einem variant zurückgeben Block insert aber ein Array von DOUBLE haben will. Ist also egal wie man das serviert.
Der nächste Parameter ist der Name des Blockes der als Referenz eingefügt werden soll.
Der Rest ist skalieren und rotieren.
So und nun must du nicht mehr lispeln und sendcommanden (das macht man am besten nur im alleräußersten Notfalle wenn gar nix andres mehr geht)
Routine benutzen und nicht weiter rätseln
Zurückgegeben wird übrigens die frisch eingefügte Blockreferenz.
Der Block muss in der Zeichnung bereits vorhanden sein.
Blöcke aus anderen Zeichnungen zu mopsen und einzufügen oder von einer Datei einzufügen siehe Bibliothek
Lieben Gruß
Thomas
Function block_insert(varPnt, strname, Optional dblScalex As Double = 1, Optional dblScaley As Double = 1, Optional dblScalez As Double = 1, Optional Angle As Double = 0, Optional TargetBlock As String = "") As AcadBlockReference
Set block_insert = Nothing
Dim blo As AcadBlockReference
If strname = "" Then Exit Function
Dim P(2) As Double
On Error Resume Next
P(0) = CDbl(varPnt(0))
P(1) = CDbl(varPnt(1))
P(2) = CDbl(varPnt(2))
On Error GoTo 0
Dim testb As AcadBlock
On Error Resume Next
Set testb = Nothing
ERR.Clear
Set testb = thisdrawing.BLOCKS.ITEM(strname)
If (testb Is Nothing Or ERR.Number <> 0) Then
Dim S As String
S = strname
If block_copy_db_definition(S, func_stdlib) = False Then
''debug.print strName, " BLOCK not found !!! "
Call say(strname & " BLOCK not found or interface error !!! ")
strname = ""
ERR.Clear
Exit Function
End If
End If
Dim OBJECTSPACE As AcadBlock
If TargetBlock = "" Then
Set OBJECTSPACE = RFSPACE
Else
Set OBJECTSPACE = thisdrawing.BLOCKS.ITEM(TargetBlock)
End If
Set blo = OBJECTSPACE.InsertBlock(P, strname, dblScalex, dblScaley, dblScalez, Angle)
dwgunits = S2D(thisdrawing.GetVariable("INSUNITS"))
' ''debug.print err.DESCRIPTION
bu = blo.Insunits
' ''debug.print bu
If bu <> dwgunits Then
Dim SC As String
If dwgunits = 6 And bu = "Millimeters" Then SC = "0.001" 'dwg meter, blo mm
If dwgunits = 4 And bu = "Meters" Then SC = "1000" 'dwg mm ,blo meter
On Error GoTo 0
If Trim(SC) <> "" Then
Call blo.ScaleEntity(P, val(SC))
End If
End If
Set block_insert = blo
On Error GoTo 0
End Function
------------------
Wer es nicht versucht, hat schon verlorn
Und bei 3 Typos gibts den vierten gratis !
<<< for sale !
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP