FELIXJM Posted January 20, 2012 Share Posted January 20, 2012 I have functions VBA for GET and SET Lisp variables. How modify for VB .NET [size=2][size=2][color=#0000ff][size=2][color=#0000ff]Function[/color][/size][/color][/size][size=2] GetLispVariable([/size][size=2][color=#0000ff][size=2][color=#0000ff]ByVal[/color][/size][/color][/size][size=2] varname [/size][size=2][color=#0000ff][size=2][color=#0000ff]As[/color][/size][/color][/size][size=2][color=#0000ff][size=2][color=#0000ff]String[/color][/size][/color][/size][size=2]) [/size][size=2][color=#0000ff][size=2][color=#0000ff]As[/color][/size][/color][/size][size=2][color=#0000ff][size=2][color=#0000ff]Object[/color][/size][/color][/size][/size] [size=2][size=2][color=#0000ff][size=2][color=#0000ff]Dim[/color][/size][/color][/size][size=2] VL [/size][size=2][color=#0000ff][size=2][color=#0000ff]As[/color][/size][/color][/size][size=2][color=#0000ff][size=2][color=#0000ff]Object[/color][/size][/color][/size][/size] [size=2][size=2][color=#0000ff][size=2][color=#0000ff]If[/color][/size][/color][/size][size=2] VL [/size][size=2][color=#0000ff][size=2][color=#0000ff]Is[/color][/size][/color][/size][size=2][color=#0000ff][size=2][color=#0000ff]Nothing[/color][/size][/color][/size][size=2][color=#0000ff][size=2][color=#0000ff]Then[/color][/size][/color][/size][/size] [size=2][size=2] VL = CreateObject([/size][size=2][color=#a31515][size=2][color=#a31515]"VL.APPLICATION.16"[/color][/size][/color][/size][size=2])[/size][/size] [size=2][size=2][color=#0000ff][size=2][color=#0000ff]End[/color][/size][/color][/size][size=2][color=#0000ff][size=2][color=#0000ff]If[/color][/size][/color][/size][/size] [size=2][size=2][color=#0000ff][size=2][color=#0000ff]With[/color][/size][/color][/size][size=2] VL.ActiveDocument.Functions[/size] [size=2] GetLispVariable = .Item([/size][size=2][color=#a31515][size=2][color=#a31515]"eval"[/color][/size][/color][/size][size=2]).funcall(.Item([/size][size=2][color=#a31515][size=2][color=#a31515]"read"[/color][/size][/color][/size][size=2]).funcall(varname))[/size] [size=2][color=#0000ff][size=2][color=#0000ff]End[/color][/size][/color][/size][size=2][color=#0000ff][size=2][color=#0000ff]With[/color][/size][/color][/size] [size=2][color=#0000ff][size=2][color=#0000ff]End[/color][/size][/color][/size][size=2][color=#0000ff][size=2][color=#0000ff]Function[/color][/size][/color][/size] [size=2][color=#0000ff][size=2][color=#0000ff]Sub[/color][/size][/color][/size][size=2] SetLispVariable([/size][size=2][color=#0000ff][size=2][color=#0000ff]ByVal[/color][/size][/color][/size][size=2] varname [/size][size=2][color=#0000ff][size=2][color=#0000ff]As[/color][/size][/color][/size][size=2][color=#0000ff][size=2][color=#0000ff]String[/color][/size][/color][/size][size=2], [/size][size=2][color=#0000ff][size=2][color=#0000ff]ByVal[/color][/size][/color][/size][size=2] value [/size][size=2][color=#0000ff][size=2][color=#0000ff]As[/color][/size][/color][/size][size=2][color=#0000ff][size=2][color=#0000ff]Object[/color][/size][/color][/size][size=2])[/size] [size=2][color=#0000ff][size=2][color=#0000ff]Dim[/color][/size][/color][/size][size=2] VL [/size][size=2][color=#0000ff][size=2][color=#0000ff]As[/color][/size][/color][/size][size=2][color=#0000ff][size=2][color=#0000ff]Object[/color][/size][/color][/size] [size=2][color=#0000ff][size=2][color=#0000ff]If[/color][/size][/color][/size][size=2] VL [/size][size=2][color=#0000ff][size=2][color=#0000ff]Is[/color][/size][/color][/size][size=2][color=#0000ff][size=2][color=#0000ff]Nothing[/color][/size][/color][/size][size=2][color=#0000ff][size=2][color=#0000ff]Then[/color][/size][/color][/size] [size=2] VL = CreateObject([/size][size=2][color=#a31515][size=2][color=#a31515]"VL.APPLICATION.16"[/color][/size][/color][/size][size=2])[/size] [size=2][color=#0000ff][size=2][color=#0000ff]End[/color][/size][/color][/size][size=2][color=#0000ff][size=2][color=#0000ff]If[/color][/size][/color][/size] [size=2][color=#0000ff][size=2][color=#0000ff]With[/color][/size][/color][/size][size=2] VL.ActiveDocument.Functions[/size] [size=2].Item([/size][size=2][color=#a31515][size=2][color=#a31515]"set"[/color][/size][/color][/size][size=2]).funcall .Item([/size][size=2][color=#a31515][size=2][color=#a31515]"read"[/color][/size][/color][/size][size=2]).funcall(varname), value[/size] [size=2][color=#0000ff][size=2][color=#0000ff]End[/color][/size][/color][/size][size=2][color=#0000ff][size=2][color=#0000ff]With[/color][/size][/color][/size] [size=2][color=#0000ff][size=2][color=#0000ff]End[/color][/size][/color][/size][size=2][color=#0000ff][size=2][color=#0000ff]Sub[/color][/size][/color][/size] [size=2][color=#008000][size=2][color=#008000]'PARA SETAR ==> SetLispVariable "nomevar", "Funciona!!"[/color][/size][/color][/size] [size=2][color=#008000][size=2][color=#008000]'PARA PEGAR ==> MsgBox ReadLispVariable("nomevar")[/color][/size][/color][/size] [/size] OK. Thank you. FELIXJM Quote Link to comment Share on other sites More sharing options...
Jeff H Posted January 20, 2012 Share Posted January 20, 2012 http://www.theswamp.org/index.php?topic=35714.msg409451#msg409451 Quote Link to comment Share on other sites More sharing options...
FELIXJM Posted January 20, 2012 Author Share Posted January 20, 2012 http://www.theswamp.org/index.php?topic=35714.msg409451#msg409451 VB.NET not C# ok. Quote Link to comment Share on other sites More sharing options...
BlackBox Posted January 20, 2012 Share Posted January 20, 2012 VB.NET not C# ok. Give this a try. :wink: Quote Link to comment Share on other sites More sharing options...
FELIXJM Posted January 20, 2012 Author Share Posted January 20, 2012 Thanks, I converted to VB.NET. I need one more help, I am not expert in VB.NET, use only for display screens for Autolisp because the DCL is very rigid. I just need the functions GETLISPSYM and SETLISPSYM to put in a MODULE in VB.NET Can you help? ' CodeHimBelonga kdub@theSwamp ' #Region "UsingRegion" Imports System.Collections.Generic Imports System.Linq Imports System.Data Imports System.IO Imports System.Text Imports System.Text.RegularExpressions Imports System.Runtime.InteropServices Imports Autodesk.AutoCAD.ApplicationServices Imports Autodesk.AutoCAD.DatabaseServices Imports Autodesk.AutoCAD.EditorInput Imports Autodesk.AutoCAD.Geometry Imports Autodesk.AutoCAD.Runtime Imports Autodesk.AutoCAD.Windows Imports AcadApp = Autodesk.AutoCAD.ApplicationServices.Application Imports ACAD = Autodesk.AutoCAD.Interop Imports ACADCOM = Autodesk.AutoCAD.Interop.Common #End Region <Assembly: CommandClass(GetType(kdub_Testing.MyCommandsClass))> Namespace kdub_Testing Public Class MyCommandsClass Private dwg As Document Private db As Database Private ed As Editor ' Public Sub New() ActiveDrawing = AcadApp.DocumentManager.MdiActiveDocument End Sub Private Property ActiveDrawing() As Document Get Return dwg End Get Set dwg = value If dwg IsNot Nothing Then db = dwg.Database ed = dwg.Editor Else db = Nothing ed = Nothing End If End Set End Property ' ' Type of resbuf element ' credit to Alexander Rivilis Const RTNONE As Short = 5000 ' No result Const RTREAL As Short = 5001 ' Real number Const RTPOshort As Short = 5002 ' 2D poshort X and Y only Const RTSHORT As Short = 5003 ' Short integer Const RTANG As Short = 5004 ' Angle Const RTSTR As Short = 5005 ' String Const RTENAME As Short = 5006 ' Entity name Const RTPICKS As Short = 5007 ' Pick set Const RTORshort As Short = 5008 ' Orientation Const RT3DPOshort As Short = 5009 ' 3D poshort - X, Y, and Z Const RTLONG As Short = 5010 ' Long integer Const RTVOID As Short = 5014 ' Blank symbol Const RTLB As Short = 5016 ' list begin Const RTLE As Short = 5017 ' list end Const RTDOTE As Short = 5018 ' dotted pair Const RTNIL As Short = 5019 ' nil Const RTDXF0 As Short = 5020 ' DXF code 0 for ads_buildlist only Const RTT As Short = 5021 ' T atom Const RTRESBUF As Short = 5023 ' resbuf Const RTMODELESS As Short = 5027 ' interrupted by modeless dialog ' ' Error return code Const RTNORM As Short = 5100 ' Request succeeded Const RTERROR As Short = -5001 ' Some other error Const RTCAN As Short = -5002 ' User cancelled request -- Ctl-C Const RTREJ As Short = -5003 ' AutoCAD rejected request -- invalid Const RTFAIL As Short = -5004 ' Link failure -- Lisp probably died Const RTKWORD As Short = -5005 ' Keyword returned from getxxx() routine Const RTINPUTTRUNCATED As Short = -5008 ' Input didn't all fit in the buffer ''' <System.Security.SuppressUnmanagedCodeSecurity> _ <DllImport("acad.exe", EntryPoint := "acedPutSym", CharSet := CharSet.Unicode, CallingConvention := CallingConvention.Cdecl)> _ Private Shared Function acedPutSym(args As String, result As IntPtr) As Integer End Function <System.Security.SuppressUnmanagedCodeSecurity> _ <DllImport("acad.exe", EntryPoint := "acedGetSym", CharSet := CharSet.Unicode, CallingConvention := CallingConvention.Cdecl)> _ Private Shared Function acedGetSym(args As String, ByRef result As IntPtr) As Integer End Function ''' <summary> ''' ''' </summary> ''' <param name="name"></param> ''' <returns>ResultBuffer</returns> Friend Shared Function GetLispSym(name As String) As ResultBuffer Dim ip As IntPtr = IntPtr.Zero If (acedGetSym(name, ip) = RTNORM) AndAlso (ip <> IntPtr.Zero) Then Return ResultBuffer.Create(ip, True) End If Return Nothing End Function ''' <summary> ''' ''' </summary> <CommandMethod("DoIt1114a", CommandFlags.Modal)> _ Public Sub DoIt1114a() Dim res1 As ResultBuffer = GetLispSym("TestVar1") Dim res2 As ResultBuffer = GetLispSym("TestVar2") Dim res3 As ResultBuffer = GetLispSym("TestVar3") Dim res4 As ResultBuffer = GetLispSym("TestVar4") ed.WriteMessage("{0} : {1}", vbLf & "Res1", res1.ToString()) ed.WriteMessage("{0} : {1}", vbLf & "Res2", res2.ToString()) ed.WriteMessage("{0} : {1}", vbLf & "Res3", res3.ToString()) ed.WriteMessage("{0} : {1}", vbLf & "Res4", res4.ToString()) If res4 IsNot Nothing Then ' credit to Alexander Rivilis Dim s As New StringBuilder() s.Append(vbLf & "******") For Each val As TypedValue In DirectCast(res4, System.Collections.IEnumerable) s.AppendFormat(vbLf & "{0} -> {1}", val.TypeCode, val.Value.ToString()) Next s.Append(vbLf & "******") ed.WriteMessage(s.ToString()) End If End Sub ''' <summary> ''' ''' </summary> <CommandMethod("DoIt1114b", CommandFlags.Modal)> _ Public Sub DoIt1114b() Dim res As PromptResult = ed.GetString(vbLf & "Name of lisp-variable: ") Dim LispVarName As String = String.Empty If res.Status = PromptStatus.OK Then Dim rb As New ResultBuffer() LispVarName = res.StringResult rb.Add(New TypedValue(RTSTR, "This is the transported Text")) ' acedPutSym(LispVarName, rb.UnmanagedObject) End If ed.WriteMessage("{0} : {1}", vbLf & "Res1", GetLispSym(LispVarName).ToString()) End Sub ''' <summary> ''' ''' </summary> <CommandMethod("DoIt1114c", CommandFlags.Modal)> _ Public Sub DoIt1114c() ' '* Lets say we have an expectation that a Lisp List has a specific structure '* of (list String Integer RotationAngle 3dPoint) '* '* we need to build the ResultBuffer to suit. ' Dim resName As PromptResult = ed.GetString(vbLf & "Name of lisp-variable: ") Dim LispVarName As String = resName.StringResult Dim resStr As PromptResult = ed.GetString(vbLf & "Input String Value : ") Dim resInt As PromptIntegerResult = ed.GetInteger(vbLf & "Input Integer Value : ") Dim resAng As PromptDoubleResult = ed.GetAngle(vbLf & "Input or select Angle : ") Dim resPt As PromptPointResult = ed.GetPoint(vbLf & "Input or Select 3DPoint : ") ' For the exercise, assume the values are Valid .... 'danger Will Robinson' ' ' Use Tony's TypedValueList class to build the result buffer. Dim dataList As New TypedValueList() dataList.Add(LispDataType.ListBegin, 0) dataList.Add(LispDataType.Text, resStr.StringResult) dataList.Add(LispDataType.Int32, resInt.Value) dataList.Add(LispDataType.Angle, resAng.Value) dataList.Add(LispDataType.Point3d, resPt.Value) dataList.Add(LispDataType.ListEnd, 0) ' add the Variable to AutoCad acedPutSym(LispVarName, DirectCast(dataList, ResultBuffer).UnmanagedObject) ' get the Lisp variable from AutoCAD Dim rb1114c As ResultBuffer = GetLispSym(LispVarName) If rb1114c IsNot Nothing Then ' credit to Alexander Rivilis Dim s As New StringBuilder() s.Append(vbLf & "******") For Each val As TypedValue In DirectCast(rb1114c, System.Collections.IEnumerable) s.AppendFormat(vbLf & "{0} -> {1}", val.TypeCode, val.Value.ToString()) Next s.Append(vbLf & "******") ed.WriteMessage(s.ToString()) End If End Sub End Class End Namespace Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.