Hallo Thomas und Interessierte,
abei mein Lösungsansatz für folgende Aufgabe:
Auswahl einer Blockreferenz mittels Lisp und Aufruf eines VBA-Formulars, in dem die Blockattribute
ausgelsen werden.
Gruß Volker
Lisp :
(defun c:testdial ()
(Vl-load-com)
(Setq applic (vlax-get-acad-object))
(setq hElement (car (entsel "Wählen Sie bitte ein Blockattribut aus")))
(setq hOBJEKTID (vla-get-objectid
(vlax-ename->vla-object hElement)
)
) ; ObjektID des ausgewählten Blockes
(vl-vbarun "modul1.zeigeform_raumstempel"); Aufruf des VBA - Makros
(Princ)
); Defun
''VBA-Makro in Module
Public Sub zeigeform_raumstempel()
UserForm1.Show 0 ;'Formular wird angezeigt
End Sub
'Userform1 - Prozedur
Private Sub UserForm_Activate()
' Aus In Lisp ausgewählte Blockreferenz wird über die OjektID die Blockreferenz ermittlet
'und die Atrribute des Blockes werden in Textfelderdes Formulares angelegt
Dim objectc As Object
Dim objraumId As Variant
Dim Attributes As Variant
VL_Initialize ' Aufruf zum Inialisieren der Lisp-Schnittstelle
objraumId = GetLispSymbol("hOBJEKTID") ' OnjektID aus Lisp wird zurück gegeben
Set objectc = ThisDrawing.ObjectIdToObject(objraumId)
If objectc.HasAttributes = True Then ' zürückgegenes Ogjekt ist in diesem Fall eine Blockreferenz
Attributes = objectc.GetAttributes
Me.TextBox0.value = Attributes(0).TextString ' Im Formular werden die Attribute des Blockes angezeigt
Me.TextBox1.value = Attributes(1).TextString '
'....
Else
MsgBox ("Block hat keine Attrbute")
End If
End Sub
'allgemeine Deklarationen zwischen LISP und VBA
Dim VL As Object 'Deklarationen
Dim VLF As Object
Dim VLRead As Object
Dim VLEval As Object
'-----------------------------------------------------------------------------------------------------------------
' Definition und Funktionen der VBA-Lsip-schnittstelle
'-----------------------------------------------------------------------------------------------------------------
Sub VL_Initialize()
'ThisDrawing.SendCommand ("(vl-load-com)" & vbCr) ' nicht benötigt, da in diesem Fall von Lisp nach VBA
Set VL = ThisDrawing.Application.GetInterfaceObject("VL.Application.16")
Set VLF = VL.ActiveDocument.Functions
Set VLRead = VLF.Item("read")
Set VLEval = VLF.Item("eval")
End Sub
Sub VL_Terminate()
Set VLEval = Nothing
Set VLRead = Nothing
Set VLF = Nothing
Set VL = Nothing
End Sub
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
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) '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 "(setq translate-variant nil)"
End Function
Function GetLispSymbol(symbolname As String)
Dim sym As Object, list As Object
Dim elements() As Variant, i As Long, Count As Integer, art As String
art = Lispvartype(symbolname)
Set sym = VLRead.funcall(symbolname)
If art = "LIST" Then
Set list = VLEval.funcall(sym)
Count = VLF.Item("length").funcall(list)
ReDim elements(0 To Count - 1) As Variant
For i = 0 To Count - 1
elements(i) = VLF.Item("nth").funcall(i, list)
Next
GetLispSymbol = elements
Else
GetLispSymbol = VLEval.funcall(sym)
End If
End Function
Function GetLispList(symbolname As String) As Variant
Dim sym As Object, list As Object
Dim Count, elements(), i As Long
Set sym = VLRead.funcall(symbolname)
Set list = VLEval.funcall(sym)
Count = VLF.Item("length").funcall(list)
ReDim elements(0 To Count - 1) As Variant
For i = 0 To Count - 1
elements(i) = VLF.Item("nth").funcall(i, list)
Next
GetLispList = elements
End Function
Function Entlast() As AcadEntity
Dim retval As String
EvalLispExpression ("(defun *vox-entlast* ( / ele) (if (setq ele (entlast))(cdr (assoc 5 (entget ele)))))")
retval = VLF.Item("*vox-entlast*")
EvalLispExpression ("(setq *vox-entlast* nil)")
If retval <> "" Then Set Entlast = ThisDrawing.HandleToObject(retval)
End Function
Function Lispvartype(symbolname As String) As String
EvalLispExpression ("(defun *vox-type* (symbolname) (vl-prin1-to-string (type (eval (read symbolname)))))")
Lispvartype = VLF.Item("*vox-type*").funcall(symbolname)
EvalLispExpression ("(setq *vox-type* nil)")
End Function
Sub NullifySymbol(ParamArray symbolname())
Dim i As Integer
For i = LBound(symbolname) To UBound(symbolname)
EvalLispExpression "(setq " & CStr(symbolname(i)) & " nil)"
Next
End Sub
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP
Foren auf CAD.de (alle Foren)
| 
- 
