---

Was mich schon lange angenervt hat, ist die Tatsache das man manche Sachen aus VBA heraus nicht direkt adressieren kann.

Also hab ich mal ein wenig gestöbert.
Fazit man kann mit VB.NET eine tool dll erzeugen, die man aus VBA heraus ansprechen kann.

Da das Ganze nicht aufzusetzen wirklich Spaß macht.
Und die zu generierenden Funktionsköpfe nun wirklich etwas gewöhnungsbedürftig sind hierzu etwas code.

Zutaten: Visual Studio 2015 (Express langt)
Sowie das zugehörige AUTOCAD SDK.

In den Projekteinstellungen muß man die Build Version explizit festlegen und COM Sichtbarkeit anhaken. Also In AWENDUNG  ASSEMBLYINFORMATIONEN ASSEMBLY-COM-SICHTBAR-MACHEN anhaken. Sowie bei den Kompilieroptionen einen Haken bei FÜR-COM-INTEROP-REGISTRIEREN rein.
Das Projekt brauch ferner Verweise auf die im ACAD SDK enthaltenen DLLs.
Die VB DLL/TLB muß natürlich wie üblich im VBA als Verweis gesetzt werden.

Nachfolgendes Beispiel gibt auf der Debug Konsole aus welcher Block gerade im Blockeditor bearbeitet wird. (dafür ist keine VBA Funktion vorhanden)

VBA:
Sub tbedit()
Dim c As New acad
Debug.Print c.TestBEdit
End Sub

VB.NET:
Option Compare Text
Option Strict Off

Imports System
Imports System.Runtime.InteropServices
Imports WIN32 = Microsoft.Win32

Imports System.Collections.Generic
Imports System.Linq
Imports System.Text
Imports System.Threading.Tasks
Imports System.Windows
Imports VB7 = Microsoft.VisualBasic
Imports VB6 = Microsoft.VisualBasic

Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.Runtime

Namespace acadLib

    Public Interface Iacad
        Property OpeningBalance() As Double
        Property Rate() As Double
        Property Payment() As Double
        Property Term() As Short
        Property RiskRating() As String
        Function TestBEdit() As String
        Function ComputePayment() As Double

        Function ComputeOpeningBalance() As Double
        Function ComputeRate() As Double
        Function ComputeTerm() As Short
        Function GetFirstPmtDistribution(PmtAmt As Double, ByRef Balance As Double, ByRef PrinPortion As Double, ByRef IntPortion As Double) As Boolean
        Function GetNextPmtDistribution(PmtAmt As Double, ByRef Balance As Double, ByRef PrinPortion As Double, ByRef IntPortion As Double) As Boolean
    End Interface

    <ClassInterface(ClassInterfaceType.AutoDual), ComVisible(True)>
    Public Class acad
        Implements Iacad
        Private m_openingBalance As Double
        Private m_rate As Double
        Private m_payment As Double
        Private m_term As Short
        Private m_riskRating As String

        Public Property OpeningBalance() As Double Implements Iacad.OpeningBalance

            Get
                Return m_openingBalance
            End Get
            Set
                m_openingBalance = Value
            End Set
        End Property

        Public Property Rate() As Double Implements Iacad.Rate

            Get
                Return m_rate
            End Get
            Set
                m_rate = Value
            End Set
        End Property

        Public Property Payment() As Double Implements Iacad.Payment

            Get
                Return m_payment
            End Get
            Set
                m_payment = Value
            End Set
        End Property

        Public Property Term() As Short Implements Iacad.Term

            Get
                Return m_term
            End Get
            Set
                m_term = Value
            End Set
        End Property

        Public Property RiskRating() As String Implements Iacad.RiskRating

            Get
                Return m_riskRating
            End Get
            Set
                m_riskRating = Value
            End Set
        End Property

        Public Function TestBEdit() As String _
            Implements Iacad.TestBEdit
            TestBEdit = ""
            Dim doc As Document = Application.DocumentManager.MdiActiveDocument
            Dim ed As Editor
            If doc IsNot Nothing Then
                ed = doc.Editor
                If Autodesk.AutoCAD.Internal.AcAeUtilities.IsInBlockEditor() Then
                    TestBEdit = Autodesk.AutoCAD.Internal.AcAeUtilities.GetBlockName()
                End If
            End If
        End Function

        Public Function ComputePayment() As Double Implements Iacad.ComputePayment

            Payment = Util.Round(OpeningBalance * (Rate /
              (1 - Math.Pow(1 + Rate, -Term))), 2)
            Return Payment
        End Function

        Public Function ComputeOpeningBalance() As Double Implements Iacad.ComputeOpeningBalance

            OpeningBalance = Util.Round(Payment / (Rate / (1 - Math.Pow(1 + Rate, -Term))), 2)
            Return OpeningBalance
        End Function

        Public Function ComputeRate() As Double _
        Implements Iacad.ComputeRate

            Dim DesiredPayment As Double = Payment

            For m_rate = 0.001 To 28.0 - 0.001 Step 0.001
                Payment = Util.Round(OpeningBalance * (Rate / (1 - Math.Pow(1 + Rate, -Term))), 2)

                If Payment >= DesiredPayment Then
                    Exit For
                End If
            Next
            Return Rate
        End Function

-----------------------

Happy coding !

        Public Function ComputeTerm() As Short _
        Implements Iacad.ComputeTerm

            Dim DesiredPayment As Double = Payment

            For m_term = 1 To 479
                Payment = Util.Round(OpeningBalance * (Rate / (1 - Math.Pow(1 + Rate, -Term))), 2)

                If Payment <= DesiredPayment Then
                    Exit For
                End If
            Next
            Return Term
        End Function

        Public Function GetFirstPmtDistribution(PmtAmt As Double, ByRef Balance As Double, ByRef PrinPortion As Double, ByRef IntPortion As Double) As Boolean Implements Iacad.GetFirstPmtDistribution

            Balance = OpeningBalance
            Return GetNextPmtDistribution(PmtAmt, Balance, PrinPortion,
              IntPortion)
        End Function

        Public Function GetNextPmtDistribution(PmtAmt As Double, ByRef Balance As Double, ByRef PrinPortion As Double, ByRef IntPortion As Double) As Boolean Implements Iacad.GetNextPmtDistribution

            IntPortion = Util.Round(Balance * Rate, 2)
            PrinPortion = Util.Round(PmtAmt - IntPortion, 2)
            Balance = Util.Round(Balance - PrinPortion, 2)

            If Balance <= 0.0 Then
                Return False
            End If
            Return True
        End Function
    End Class

    Friend Class Util

        Public Shared Function Round(value As Double, digits As Short) As Double
            Dim factor As Double = Math.Pow(10, digits)
            Return Math.Round((value * factor)) / factor
        End Function

        <ComRegisterFunctionAttribute()>
        Public Shared Sub RegisterFunction(ByVal type As Type)
            WIN32.Registry.ClassesRoot.CreateSubKey(GetSubkeyName(type))
        End Sub

        <ComUnregisterFunctionAttribute()>
        Public Shared Sub UnregisterFunction(ByVal type As Type)
            WIN32.Registry.ClassesRoot.DeleteSubKey(GetSubkeyName(type), False)
        End Sub

        Private Shared Function GetSubkeyName(ByVal type As Type) As String
            Dim S As New System.Text.StringBuilder()
            S.Append("CLSID\{")
            S.Append(type.GUID.ToString().ToUpper())
            S.Append("}\Programmable")
            Return S.ToString()
        End Function

    End Class

End Namespace

------------------
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