Author Topic: Invoke vlax function in vb  (Read 5494 times)

0 Members and 1 Guest are viewing this topic.

guohq

  • Newt
  • Posts: 84
Invoke vlax function in vb
« on: June 03, 2014, 11:23:11 AM »
Code: [Select]
Dim VLFuns As Object = cadApp.GetInterfaceObject("VL.Application.16").ActiveDocument.Functions

Dim VlFun As Object = VLFuns.Item("vlax-curve-getEndParam")

Dim EndParam As Object = VlFun.funcall(Cur)

when the code run at third line ,it throw an exception:


can you tell me why?
« Last Edit: June 03, 2014, 12:03:33 PM by guohq »

exmachina

  • Guest
Re: Invoke vlax function in vb
« Reply #1 on: June 09, 2014, 04:55:29 PM »
VBA or VB.NET?

For VBA, search over the internet (vlax.cl and curve.cls, by Frank Oquendo)


 For VB.NET:

vlax
Code - vb.net: [Select]
  1. ' Autor:        EsKaRaLaKaKaTua
  2. ' Descripción:  VLAX para VB.NET
  3. ' Version:      1.0.1.0
  4. ' Fecha:        14 de Febrero de 2009
  5.  
  6. Imports System
  7. Imports System.Reflection
  8. Imports System.Runtime.InteropServices
  9. Imports Autodesk.AutoCAD.Interop
  10.  
  11. Friend NotInheritable Class VLAX
  12.     Implements IDisposable
  13.  
  14.     Private ReadOnly _vlApp As Object
  15.     Private ReadOnly _vlFunctions As Object
  16.  
  17.     Private disposedValue As Boolean
  18.  
  19.     Friend Sub New(ByVal instance As AcadApplication)
  20.  
  21.         Try
  22.             _vlApp = instance.GetInterfaceObject("VL.Application.16")
  23.  
  24.         Catch ex As COMException
  25.             Throw New Exception("Primero debe llamarse, en AutoCAD, a la funcion (vl-load-com)")
  26.  
  27.         End Try
  28.  
  29.         Dim doc As Object = GetProperty(_vlApp, "ActiveDocument")
  30.         _vlFunctions = GetProperty(doc, "Functions")
  31.         Marshal.ReleaseComObject(doc)
  32.  
  33.     End Sub
  34.  
  35.     ' IDisposable
  36.     Protected Sub Dispose(ByVal disposing As Boolean)
  37.  
  38.         If Not Me.disposedValue Then
  39.  
  40.             If disposing Then
  41.             End If
  42.  
  43.             If _vlApp IsNot Nothing Then
  44.                 Marshal.ReleaseComObject(_vlFunctions)
  45.                 Marshal.ReleaseComObject(_vlApp)
  46.             End If
  47.  
  48.         End If
  49.  
  50.         Me.disposedValue = True
  51.     End Sub
  52.  
  53.     Friend Function EvalLispExpression(ByVal lispStatement As String) As Object
  54.  
  55.         Dim sym As Object = Read(lispStatement)
  56.  
  57.         Try
  58.             Return Eval(sym)
  59.  
  60.         Catch
  61.             Return String.Empty
  62.  
  63.         Finally
  64.             Marshal.ReleaseComObject(sym)
  65.         End Try
  66.  
  67.     End Function
  68.  
  69.     Friend Function GetLispList(ByVal symbolName As String) As Object()
  70.  
  71.         Dim sym As Object = Read(symbolName)
  72.         Dim list As Object = Eval(sym)
  73.         Marshal.ReleaseComObject(sym)
  74.  
  75.         Dim count As Integer = DirectCast(InvokeFunction("length", New Object() {list}), Integer)
  76.  
  77.         Dim elements(count - 1) As Object
  78.         Dim funcNth As Object = GetFunction("nth")
  79.  
  80.         For i As Integer = 0 To elements.Length - 1
  81.             elements(i) = funcNth.GetType.InvokeMember("funcall", _
  82.                                                        BindingFlags.InvokeMethod Or BindingFlags.Instance, _
  83.                                                        Nothing, _
  84.                                                        funcNth, _
  85.                                                        New Object() {i, list})
  86.         Next
  87.  
  88.         Marshal.ReleaseComObject(list)
  89.         Marshal.ReleaseComObject(funcNth)
  90.  
  91.         Return elements
  92.     End Function
  93.  
  94.     Friend Function GetLispSymbol(ByVal symbolName As String) As Object
  95.  
  96.         Dim sym As Object = Read(symbolName)
  97.         Dim result As Object = Eval(sym)
  98.         Marshal.ReleaseComObject(sym)
  99.  
  100.         Return result
  101.     End Function
  102.  
  103.     Friend Sub NullifySymbol(ByVal ParamArray symbolName() As String)
  104.  
  105.         For i As Integer = 0 To symbolName.Length - 1
  106.             Call EvalLispExpression(String.Format("(setq {0} nil)", symbolName(i)))
  107.         Next
  108.  
  109.     End Sub
  110.  
  111.     Friend Sub SetLispSymbol(ByVal symbolName As String, _
  112.                              ByVal symValue As Object)
  113.  
  114.         Dim sym As Object = Read(symbolName)
  115.         InvokeFunction("set", New Object() {sym, symValue})
  116.         Marshal.ReleaseComObject(sym)
  117.  
  118.         Call 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)))")
  119.         Call EvalLispExpression(String.Format("(setq {0}(translate-variant {0}))", symbolName))
  120.         Call EvalLispExpression("(setq translate-variant nil)")
  121.  
  122.     End Sub
  123.  
  124.     Private Function Eval(ByVal sym As Object) As Object
  125.         Return InvokeFunction("eval", New Object() {sym})
  126.     End Function
  127.  
  128.     Private Function GetFunction(ByVal key As String) As Object
  129.  
  130.         Return _vlFunctions.GetType.InvokeMember("Item", _
  131.                                                  BindingFlags.GetProperty Or BindingFlags.Instance, _
  132.                                                  Nothing, _
  133.                                                  _vlFunctions, _
  134.                                                  New Object() {key})
  135.  
  136.     End Function
  137.  
  138.     Private Function GetProperty(ByVal obj As Object, _
  139.                                  ByVal propName As String) As Object
  140.  
  141.         Return obj.GetType.InvokeMember(propName, _
  142.                                         BindingFlags.GetProperty Or BindingFlags.Instance, _
  143.                                         Nothing, _
  144.                                         obj, _
  145.                                         Nothing)
  146.  
  147.     End Function
  148.  
  149.     Private Function InvokeFunction(ByVal funcName As String, _
  150.                                     ByVal args() As Object) As Object
  151.  
  152.         Dim func As Object = GetFunction(funcName)
  153.         Dim result As Object = func.GetType.InvokeMember("funcall", _
  154.                                                          BindingFlags.InvokeMethod Or BindingFlags.Instance, _
  155.                                                          Nothing, _
  156.                                                          func, _
  157.                                                          args)
  158.         Marshal.ReleaseComObject(func)
  159.  
  160.         Return result
  161.     End Function
  162.  
  163.     Private Function Read(ByVal symbolName As String) As Object
  164.         Return InvokeFunction("read", New Object() {symbolName})
  165.     End Function
  166.  
  167. #Region " IDisposable Support "
  168.  
  169.     Public Sub Dispose() _
  170.            Implements IDisposable.Dispose
  171.         Dispose(True)
  172.         GC.SuppressFinalize(Me)
  173.     End Sub
  174.  
  175. #End Region
  176.  
  177. End Class

Curve
Code - vb.net: [Select]
  1. ' Autor:        EsKaRaLaKaKaTua
  2. ' Descripción:  Curve para VB.NET
  3. ' Version:      1.0.1.0
  4. ' Fecha:        14 de Febrero de 2009
  5.  
  6. Imports System
  7. Imports System.Collections.Generic
  8. Imports Autodesk.AutoCAD.Interop
  9. Imports Autodesk.AutoCAD.Interop.Common
  10.  
  11. Friend Class Curve
  12.     Implements IDisposable
  13.  
  14.     Private ReadOnly _vlax As VLAX
  15.  
  16.     Private _entity As AcadEntity
  17.  
  18.     Private Shared ReadOnly _allowedTypes As List(Of String) = GetAllowedTypes()
  19.  
  20.     Friend Sub New(ByVal instance As AcadApplication)
  21.  
  22.         _vlax = New VLAX(instance)
  23.     End Sub
  24.  
  25.     Friend ReadOnly Property Area() As Double
  26.         Get
  27.  
  28.             Dim result As Double
  29.  
  30.             With _vlax
  31.                 .SetLispSymbol("handle", _entity.Handle)
  32.                 result = CDbl(.EvalLispExpression("(vlax-curve-getArea (handent handle))"))
  33.                 .NullifySymbol("handle")
  34.             End With
  35.  
  36.             Return result
  37.         End Get
  38.     End Property
  39.  
  40.     Friend ReadOnly Property Closed() As Boolean
  41.         Get
  42.  
  43.             Dim result As Boolean
  44.  
  45.             With _vlax
  46.                 .SetLispSymbol("handle", _entity.Handle)
  47.                 result = CBool(.EvalLispExpression("(vlax-curve-isClosed (handent handle))"))
  48.                 .NullifySymbol("handle")
  49.             End With
  50.  
  51.             Return result
  52.         End Get
  53.     End Property
  54.  
  55.     Friend ReadOnly Property CurveType() As String
  56.         Get
  57.             Return _entity.ObjectName
  58.         End Get
  59.     End Property
  60.  
  61.     Friend ReadOnly Property EndParameter() As Double
  62.         Get
  63.  
  64.             Dim result As Double
  65.  
  66.             With _vlax
  67.                 .SetLispSymbol("handle", _entity.Handle)
  68.                 result = CDbl(.EvalLispExpression("(vlax-curve-getEndParam (handent handle))"))
  69.                 .NullifySymbol("handle")
  70.             End With
  71.  
  72.             Return result
  73.         End Get
  74.  
  75.     End Property
  76.  
  77.     Friend ReadOnly Property Endpoint() As Double()
  78.         Get
  79.  
  80.             Dim result() As Object
  81.  
  82.             With _vlax
  83.                 .SetLispSymbol("handle", _entity.Handle)
  84.                 .EvalLispExpression("(setq lst (vlax-curve-getEndPoint (handent handle)))")
  85.                 result = .GetLispList("lst")
  86.                 .NullifySymbol("handle", "lst")
  87.             End With
  88.  
  89.             Return GetDoubleArray(result)
  90.         End Get
  91.  
  92.     End Property
  93.  
  94.     Friend Property Entity() As AcadEntity
  95.         Get
  96.             Return _entity
  97.         End Get
  98.         Set(ByVal value As AcadEntity)
  99.  
  100.             If Not _allowedTypes.Contains(value.ObjectName) Then
  101.                 Throw New Exception("La entidad no es una curva")
  102.             End If
  103.  
  104.             _entity = value
  105.         End Set
  106.     End Property
  107.  
  108.     Friend ReadOnly Property Length() As Double
  109.         Get
  110.  
  111.             Dim result As Double
  112.  
  113.             With _vlax
  114.                 .SetLispSymbol("handle", _entity.Handle)
  115.                 .EvalLispExpression("(setq curve (handent handle))")
  116.                 result = CDbl(.EvalLispExpression("(vlax-curve-getDistAtParam curve (vlax-curve-getEndParam curve))"))
  117.                 .NullifySymbol("handle", "curve")
  118.             End With
  119.  
  120.             Return result
  121.         End Get
  122.     End Property
  123.  
  124.     Friend ReadOnly Property Periodic() As Boolean
  125.         Get
  126.  
  127.             Dim result As Boolean
  128.  
  129.             With _vlax
  130.                 .SetLispSymbol("handle", _entity.Handle)
  131.                 result = CBool(.EvalLispExpression("(vlax-curve-isPeriodic (handent handle))"))
  132.                 .NullifySymbol("handle")
  133.             End With
  134.  
  135.             Return result
  136.         End Get
  137.     End Property
  138.  
  139.     Friend ReadOnly Property Planar() As Boolean
  140.         Get
  141.  
  142.             Dim result As Boolean
  143.  
  144.             With _vlax
  145.                 .SetLispSymbol("handle", _entity.Handle)
  146.                 result = CBool(.EvalLispExpression("(vlax-curve-isPlanar (handent handle))"))
  147.                 .NullifySymbol("handle")
  148.             End With
  149.  
  150.             Return result
  151.         End Get
  152.     End Property
  153.  
  154.     Friend ReadOnly Property StartPoint() As Double()
  155.         Get
  156.  
  157.             Dim result() As Object
  158.  
  159.             With _vlax
  160.                 .SetLispSymbol("handle", _entity.Handle)
  161.                 .EvalLispExpression("(setq lst (vlax-curve-getStartPoint (handent handle)))")
  162.                 result = .GetLispList("lst")
  163.                 .NullifySymbol("handle", "lst")
  164.             End With
  165.  
  166.             Return GetDoubleArray(result)
  167.         End Get
  168.     End Property
  169.  
  170.     Friend Function GetClosestPointTo(ByVal Point As Object, _
  171.                                       Optional ByVal Extend As Boolean = False) As Double()
  172.  
  173.         Dim result() As Object
  174.  
  175.         With _vlax
  176.             .SetLispSymbol("handle", _entity.Handle)
  177.             .SetLispSymbol("givenPt", Point)
  178.  
  179.             If Extend Then .EvalLispExpression("(setq ext T)")
  180.             .EvalLispExpression("(setq lst (vlax-curve-getClosestPointTo (handent handle) givenPt ext))")
  181.             result = .GetLispList("lst")
  182.             .NullifySymbol("handle", "lst", "ext", "givenPt")
  183.         End With
  184.  
  185.         Return GetDoubleArray(result)
  186.  
  187.     End Function
  188.  
  189.     Friend Function GetClosestPointToProjection(ByVal Point As Object, _
  190.                                                 ByVal Normal As Object, _
  191.                                                 Optional ByVal Extend As Boolean = False) As Double()
  192.  
  193.         Dim result() As Object
  194.  
  195.         With _vlax
  196.             .SetLispSymbol("handle", _entity.Handle)
  197.             .SetLispSymbol("givenPt", Point)
  198.             .SetLispSymbol("normal", Normal)
  199.  
  200.             If Extend Then
  201.                 .EvalLispExpression("(setq ext T)")
  202.             End If
  203.  
  204.             .EvalLispExpression("(setq lst (vlax-curve-getClosestPointToProjection (handent handle) givenPt normal ext))")
  205.             result = .GetLispList("lst")
  206.             .NullifySymbol("handle", "lst", "normal", "ext", "givenPt")
  207.         End With
  208.  
  209.         Return GetDoubleArray(result)
  210.  
  211.     End Function
  212.  
  213.     Public Function GetDistanceAtParameter(ByVal Param As Double) As Double
  214.  
  215.         Dim result As Double
  216.  
  217.         With _vlax
  218.             .SetLispSymbol("handle", _entity.Handle)
  219.             .SetLispSymbol("param", Param)
  220.             result = CDbl(.EvalLispExpression("(vlax-curve-getDistAtParam (handent handle) param)"))
  221.             .NullifySymbol("handle", "param")
  222.         End With
  223.  
  224.         Return result
  225.  
  226.     End Function
  227.  
  228.     Friend Function GetDistanceAtPoint(ByVal Point As Object) As Double
  229.  
  230.         Dim result As Double
  231.  
  232.         With _vlax
  233.             .SetLispSymbol("handle", _entity.Handle)
  234.             .SetLispSymbol("point", Point)
  235.             result = CDbl(.EvalLispExpression("(vlax-curve-getDistAtPoint (handent handle) point)"))
  236.             .NullifySymbol("handle", "point")
  237.         End With
  238.  
  239.         Return result
  240.  
  241.     End Function
  242.  
  243.     Friend Function GetFirstDerivative(ByVal Param As Double) As Double()
  244.  
  245.         Dim result() As Object
  246.  
  247.         With _vlax
  248.             .SetLispSymbol("handle", _entity.Handle)
  249.             .SetLispSymbol("param", Param)
  250.             .EvalLispExpression("(setq lst (vlax-curve-getFirstDeriv (handent handle) param))")
  251.             result = .GetLispList("lst")
  252.             .NullifySymbol("handle", "param", "lst")
  253.         End With
  254.  
  255.         Return GetDoubleArray(result)
  256.  
  257.     End Function
  258.  
  259.     Friend Function GetParameterAtDistance(ByVal Dist As Double) As Double
  260.  
  261.         Dim result As Double
  262.  
  263.         With _vlax
  264.             .SetLispSymbol("handle", _entity.Handle)
  265.             .SetLispSymbol("dist", Dist)
  266.             result = CDbl(.EvalLispExpression("(vlax-curve-getParamAtDist (handent handle) dist)"))
  267.             .NullifySymbol("handle", "dist")
  268.         End With
  269.  
  270.         Return result
  271.  
  272.     End Function
  273.  
  274.     Friend Function GetParameterAtPoint(ByVal Point As Object) As Double
  275.  
  276.         Dim result As Double
  277.  
  278.         With _vlax
  279.             .SetLispSymbol("handle", _entity.Handle)
  280.             .SetLispSymbol("point", Point)
  281.             result = CDbl(.EvalLispExpression("(vlax-curve-getparamAtPoint (handent handle) point)"))
  282.             .NullifySymbol("handle", "point")
  283.         End With
  284.  
  285.         Return result
  286.  
  287.     End Function
  288.  
  289.     Friend Function GetPointAtDistance(ByVal Dist As Double) As Double()
  290.  
  291.         Dim result() As Object
  292.  
  293.         With _vlax
  294.             .SetLispSymbol("handle", _entity.Handle)
  295.             .SetLispSymbol("dist", Dist)
  296.             .EvalLispExpression("(setq lst (vlax-curve-getPointAtDist (handent handle) dist))")
  297.             result = .GetLispList("lst")
  298.             .NullifySymbol("handle", "dist", "lst")
  299.         End With
  300.  
  301.         Return GetDoubleArray(result)
  302.  
  303.     End Function
  304.  
  305.     Friend Function GetPointAtParameter(ByVal Param As Double) As Double()
  306.  
  307.         Dim result() As Object
  308.  
  309.         With _vlax
  310.             .SetLispSymbol("handle", _entity.Handle)
  311.             .SetLispSymbol("param", Param)
  312.             .EvalLispExpression("(setq lst (vlax-curve-getPointAtParam (handent handle) param))")
  313.             result = .GetLispList("lst")
  314.             .NullifySymbol("handle", "param", "lst")
  315.         End With
  316.  
  317.         Return GetDoubleArray(result)
  318.  
  319.     End Function
  320.  
  321.     Friend Function GetSecondDerivative(ByVal Param As Double) As Double()
  322.  
  323.         Dim result() As Object
  324.  
  325.         With _vlax
  326.             .SetLispSymbol("handle", _entity.Handle)
  327.             .SetLispSymbol("param", Param)
  328.             .EvalLispExpression("(setq lst (vlax-curve-getSecondDeriv (handent handle) param))")
  329.             result = .GetLispList("lst")
  330.             .NullifySymbol("handle", "param", "lst")
  331.         End With
  332.  
  333.         Return GetDoubleArray(result)
  334.  
  335.     End Function
  336.  
  337.     Private Shared Function GetDoubleArray(ByVal obj() As Object) As Double()
  338.  
  339.         Dim result(obj.Length - 1) As Double
  340.  
  341.         For i As Integer = 0 To obj.Length - 1
  342.             result(i) = CDbl(obj(i))
  343.         Next
  344.  
  345.         Return result
  346.     End Function
  347.  
  348.     Private Shared Function GetAllowedTypes() As List(Of String)
  349.  
  350.         Dim list As New List(Of String)
  351.  
  352.         list.Add("AcDbCircle")
  353.         list.Add("AcDbLine")
  354.         list.Add("AcDbArc")
  355.         list.Add("AcDbSpline")
  356.         list.Add("AcDb3dPolyline")
  357.         list.Add("AcDbPolyline")
  358.         list.Add("AcDb2dPolyline")
  359.         list.Add("AcDbEllipse")
  360.         list.Add("AcDbLeader")
  361.  
  362.         Return list
  363.     End Function
  364.  
  365.     Private disposedValue As Boolean
  366.  
  367.     ' IDisposable
  368.     Protected Overridable Sub Dispose(ByVal disposing As Boolean)
  369.  
  370.         If Not Me.disposedValue Then
  371.  
  372.             If disposing Then
  373.                 _vlax.Dispose()
  374.             End If
  375.  
  376.         End If
  377.  
  378.         Me.disposedValue = True
  379.     End Sub
  380.  
  381. #Region " IDisposable Support "
  382.  
  383.     Public Sub Dispose() _
  384.            Implements IDisposable.Dispose
  385.         Dispose(True)
  386.         GC.SuppressFinalize(Me)
  387.     End Sub
  388.  
  389. #End Region
  390. End Class
  391.  

exmachina

  • Guest
Re: Invoke vlax function in vb
« Reply #2 on: June 21, 2014, 02:08:56 PM »
After eleven days, What is the problem? Does the code does not work?

Please explain it, other users can make a profit.

zzyong00

  • Guest
Re: Invoke vlax function in vb
« Reply #3 on: April 29, 2015, 11:16:21 AM »
http://bbs.mjtd.com/thread-113517-1-1.html
Please check this link,it's no need vl16.tlb,you can use "vlax-curve-***" functtions.