---

beispiel.zip schriftfeld.jpg

Hallo Leute,
In meinen letzten Beitrag "Vom auussgew.Listviewelemt zum dazugehörigen Block", bin ich auf ein weiters Problem gestoßen, was nicht ohne weiters in VBA zu lösen ist, wie man mir als Quereinsteiger mitteilte. Deswegen will ich es zu einem neuen Thema machen.

In meinen Blockattribut (siehe Besispiel.dwg) ist der  Wert des Attributes "Flächenbezeichnung" über ein Schriftfeld assoziativ mit einer geschl. Polylinie
verknüpft. Der Flächeninhalt der PL wird in das Attribut übernommen.
Ich suche nach einer Möglichkeit in VBA über das Blockattribut die ObjectID der verknüpften Polylinie zu ermitteln.( Ich benötige den Layernamen der Polylinie, um zu überprüfen, ob allen Flächenstempel- Blöcke  auch die richtige Polylinien zugwiesen wurden)
In AutoLisp ist das möglich, aber da ich in VBA ein ListView generiert habe, und ich diese Funktionalität weiter nutzen will, möchte ich dasselbe auch in VBA programmieren.
--------------------------------------------------------------------------------
;Lisp code zum ermitteln der verknüpften Polylinie aus einen Attrbutwert :

(setq d1 (entget (car(nentsel "\nAttribut wählen: "))))
(setq d1_0  (cdr (assoc 0 d1)))
(setq dn d1) 
  (while (/= d1_0  "SEQEND")   
      (setq dn (cdr (assoc -1 dn)))
      (setq dn (entget (entnext dn)))
      (setq d1_0  (cdr (assoc 0 dn)))
    )

 
(setq da (entget (cdr (assoc -2 dn))))
(setq ptr (cdr (assoc -1 da)))
(setq e1 (entnext ptr))
(setq ed (entget e1)) ; Elementdaten-FlächenID
(setq e2 (entnext e1))        ;Gibt den Namen des Elements zurck
(setq ed2 (entget e2)) ; Elementdaten-Flächenbezeichnung
(setq e3 (entnext e2))        ;Gibt den Namen des Elements zurck
(setq ed3 (entget e3)) ; Elementdaten-Flächenbelag
(setq e4 (entnext e3))        ;Gibt den Namen des Elements zurck
(setq ed4 (entget e4)) ; Elementdaten-Flächenbelag
(setq d1 ed4) 
(if (/=  (assoc 360 d1) nil)
    (progn
      (setq d2 (entget (cdr(assoc 360 d1))))
      (setq d3 (entget (cdr(assoc 360 d2))))
      (setq d4 (entget (cdr (assoc 360 d3))))
      (setq d5 (entget (cdr (assoc 360 d4))))
      (setq d5a (cdr (assoc 331 d5)))
      (setq d5b (cdr (assoc 301 d5)))
      (setq ed5b_ss (substr d5b 1 1))
          (if  (= ed5b_ss "#")
            (progn
              (princ "\nkeine Verknüpfung zu einer Polylinie")
              (id_pruef d1)
            )
          )
      (redraw d5a 3)
      (Princ "\nPolylinie wird ausgeleuchtet")
    )
    (progn
        (princ "\nkeine Verknüpfung zu einer Polylinie")
        (id_pruef d1)
    )
)

_____________________________________________________________________

Etwas umständlich, aber es funktioniert. Warum soll das gleiche in VB
nicht funktionieren?
Ich habe  noch ein Screenshot gemacht, mit dem Eigenschaftsfenster
vom Schriftfeld des Attibutwertes Flächeninhalt. Dort ist ja auch die Object-Id der Polylinie ablesbar. Ich habe zwar auch schon etwas über Schriftfelder im Forum gelesen, konnte es leider für meine Belange nicht verwenden.

Falls es in VBA nicht möglich sein sollte, kann ich von VBA aus an Lisp die ObjekID des Blockattributes übergeben und als Rückgabewert die OID der Polylinie bekommen? Ich habe gelesen, dass man nur Strings übergeben kann.

Gruß Volker

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

---

Hi,

und wenn Du's in Lisp schon hast, es ist nicht verwerflich, unterschiedliche Programmiersprachen zu verwenden, wenn es denn vorteilhaft (und technisch machbar) ist.

Wenn Du Lisp in VBA verwenden willst, dann schau Dir das hier an.

- alfred -

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

---

Hallo Volker,

wenn es ein MText wäre wäre es einfach. Da gibt es die Methode in der Com Schnittstelle.

Code:

---

debug.print Mtext.FieldCode

---

Bei Attribut ist das aber leider nicht der Fall. IMHO wird die Felddefinition in einem Dictionary gespeichert. Normalerweise müsste man dieses auslesen können.

Um das zu Testen hab ich mal versucht und folgenden "Test" gebaut.

Code:

---

Sub test()

    Dim xRecordType As Variant, XRecordData As Variant
    Dim XRecord As AcadXRecord
    Dim BlockRef As AcadBlockReference
    Dim Attributes As Variant
    Dim AttributRef As AcadAttributeReference
    Dim Dic As AcadDictionary
   
    ThisDrawing.Utility.GetEntity BlockRef, inspkt, "Blockwählen"
   
    Attributes = BlockRef.GetAttributes
    For i = 0 To UBound(Attributes)
        Set AttributRef = Attributes(i)
        Debug.Print AttributRef.TagString
       
        If AttributRef.TagString = "FLÄCHENINHALT" Then
            If AttributRef.HasExtensionDictionary Then
               
                Set Dic = AttributRef.GetExtensionDictionary.Item("ACAD_FIELD")
                ' Hier geht es nicht weiter
                Set XRecord = Dic.GetObject(0)  '"ACAD_FIELD"
                XRecord.GetXRecordData xRecordType, XRecordData
               
            End If
        End If
    Next
End Sub

---

Geht aber irgendwie nicht 

Ich denke mit der Kombi Lisp und VB wird das am "besten" hinhauen.
Und besser ein Umweg als gar kein Weg. 

Wilfried Stelberg

------------------
Warum lisp'eln wenn's auch anders geht.
www.ib-stelberg.de

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

---

vba_dbview.jpg

Hallo Volker,
Hatte das Bildchen vergessen

------------------
Warum lisp'eln wenn's auch anders geht.
www.ib-stelberg.de

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

---

Hallo Wilfried,

danke für Deine Mühen, Dein Beispielcode die Dictionary auszulesen,
ist ein interessanter Ansatz.
Ich werde mich in das Abenteuer VBa2Lisp
stürzen und hoffe es mit dem Thread von Alfred "bewerkstelligen" zu können.

Gruß Volker

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

---

Hallo Alfred,

danke für den Link, ich werde es versuchen Von VBa eine Lisp-Routine einzubinden. Einfach wird es bestimmt nicht, allein wenn ich die Parameterübergabe sehe, wird es mir schon schwindlig. Es kann sein, dass ich mich nochmal melde, falls es unlösbar klemmt.

Danke Volker

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

---

you are always welcome, i'm just waiting 

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

---

Lispschnittstelle_fuer_VBA.pdf

Hallo Volker,  

Zitat:

---

Original erstellt von steinemann09:
...ich werde es versuchen Von VBa eine Lisp-Routine einzubinden. Einfach wird es bestimmt nicht

---

vor einiger Zeit tauchte die Frage auch bei mir in einem Kurs auf. Ich hatte damals dieses kleine Skript verfasst, vielleicht hilft es Dir.

Grüsse, Henning

------------------
Henning Jesse
VoxelManufaktur
Computer-Dienstleistungen für Architekten und Ingenieure

       http://www.voxelman.de

[Diese Nachricht wurde von wronzky am 20. Mrz. 2009 editiert.]

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

---

Hallo Henning,

sowas habe ich ja schon lange gesucht. Jetzt kann ich endlich auch andere Lispfunktionalitäten
über VBA steuern. Ich werde die Beispiele testen, um zu begreifen, wie es genau funktioniert.
Beim ersten Lesen der PDF ist mein  Eindruck  "sehr gut dokumentiert".

Ich melde mich (auch wenn alles gelingen sollte), nach meinen "VBA - Lisp - Versuchen" .

Gruß Volker

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

---

beispiel.zip

hallo henning,

ich hoffe, nach so langer Zeit, Dich hierüber noch erreichen zu können. Ich habe versucht Dein Script an meine Aufgabe anzupassen. Aber leider funktioniert es noch nicht.

Abgespeckt stelle ich Dir meinen Versuch mal rein, der sich an Deinem
Beipiel orientiert.

Diese Lisproutine versuche ich leider efolglos in VBA zu implementieren, (die eigentliche ist umfangreicher, aber es geht erst mal ums Prinzip):

(defun oi2la()
; Routine zur Ermittlung des Layernamens aus der Objekt-ID
(setq DOC(vla-get-activedocument(vlax-get-acad-object)))
(setq OBJ2(vla-ObjectIDToObject DOC hOBJEKTID)); hOBJEKTID ist
;die Objekt-Id des Blockes
(setq OBJ3(vlax-vla-object->ename OBJ2))
(setq layer_n (cdr (assoc 8 (entget OBJ3))))
) 

' Der Qelltext in VBA

Sub test()
Dim result0 As AcadEntity, result1, result2, result3, result4
Dim liste(5) As Integer, zahl As Double, text As String
Dim BlockRef As AcadBlockReference
    Dim Attributes As Variant
VL_Initialize
ThisDrawing.Utility.GetEntity BlockRef, inspkt, "Blockwählen"
    Attributes = BlockRef.GetAttributes
    oi = Attributes(3).ObjectID ' Ermittlung der Objekt-ID des
                                ' Blockattributes

result2 = SetLispSymbol("test2", oi) 'zahl
result2 = GetLispSymbol("test2") 'zahl
' Ist die Funktion GETLISPSymbol erforderlich, mir nicht verständlich, dass das erste relult2 keinen Wert enthält, das 2. einen
Wert zurückgibt?

VL_Terminate
End Sub

Function SetLispSymbol(symbolname As String, ByVal value)
Dim sym As Object, ret
Set sym = VLRead.funcall(symbolname)
ret = VLF.Item("set").funcall(sym, value)
'EvalLispExpression "(defun translate-variant (data) (cond ((= (type " & "data) 'list) (mapcar 'translate-variant data)) ((= (type data)" 'variant)" & "(translate-variant (vlax-variant-value data))) ((= (type data)'safearray)" & "(mapcar 'translate-variant (vlax-safearray->list data))) (t data)))"
EvalLispExpression "(defun translate-variant (data) (cond  ((= (type data) 'variant)" & "(translate-variant (vlax-variant-value data))) ((= (type data)'safearray)" & "(mapcar 'translate-variant (vlax-safearray->list data))) (t data)))"
EvalLispExpression "(setq " & symbolname & "(translate-variant " & symbolname & "))"

'EvalLispExpression "(defun oi2la() (setq " & DOC & "(vla-get-activedocument(vlax-get-acad-object)))(setq " & OBJ2 & "(vla-ObjectIDToObject " & DOC & "    ret ))(setq " & OBJ3 & " (vlax-vla-object->ename OBJ2)(setq " & layer_n & " (cdr (assoc 8 (entget OBJ3))))      )"

' In ret sollte die Objekt-Id stehen, was aber nicht funktioniert
' Die Lispfunktion soll aus der Obejekt-Id des Elementes den
' Layernamen ermitteln

EvalLispExpression "(setq translate-variant nil)"
End Function

Function EvalLispExpression(lispStatement As String)
Dim sym As Object, retval
Set sym = VLRead.funcall(lispStatement)
On Error Resume Next

retval = VLEval.funcall(sym)
If Err Then
EvalLispExpression = ""
Else
EvalLispExpression = retval
End If
End Function

' Die Intialisierungsfunktionen; GetLispSymbol etc. sind den
' lezten beiden Seiten Deines Scipts entnommen.

____________________________________________________________________

Bei der Definition der Lisp-Funktion in VBA sehe ich nicht rictig durch. Muss ich eine zusätzliche Variabel dekalrieren, weil die Funktion aus der Objekt-ID (Long) den Layernamen (String)zurückgibt.
Ich hoffe, ich nehme Dich nicht zu sehr in Anspruch, aber wenn es gelingen würde, in result den Layernamen zu übergeben, wäre mir schon sehr geholfen.

Im Anhang ist der Block mit den Attributen, den ich abfrage.

Gruß Volker

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