CADsite

  • vr 27 11 2020, 04:30:21
  • Welkom, gast
Log in of registreer jezelf.

Login met gebruikersnaam, wachtwoord en sessielengte
Geavanceerd zoeken  

Nieuws:

Pagina's: [1]   Omlaag

Auteur Topic: omzetten naar dll  (gelezen 684 keer)

cadtools@gmail.com

  • vaste forumklant
  • *****
  • Offline Offline
  • Berichten: 317
  • BIM dreamer
    • Bekijk profiel
omzetten naar dll
« Gepost op: zo 23 08 2020, 22:55:53 »

Hallo

Een eeuwigheid geleden dat ik hier vaker kwam. Sorry  :(
Zal mijn best weer doen om vaker van de partij te zijn.
Vraagje: is er iemand bekend met omzetten code naar dll .net
Ik ben er neit bedreven in. Ben geen fan van Visual studio. Te complex, te grote installs.

Deze code wil ik graag inladen


===



Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry

Public Class Contour_rhino
<CommandMethod("CONTOUR", CommandFlags.Modal)> Sub Contour()
        'Create sections of surfaces and solids at intervals in a specific direction.
        Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
        Dim ed As Editor = doc.Editor
        Dim db As Database = doc.Database

        Try
            ed.WriteMessage(vbLf & "Select one or more 3Dsolids or Surfaces:")
            Dim sf As New SelectionFilter(New TypedValue() {New TypedValue(0, "SURFACE,PLANESURFACE,EXTRUDEDSURFACE,SWEPTSURFACE,LOFTEDSURFACE,REVOLVEDSURFACE,NURBSURFACE,3DSOLID")})

            Dim pSelRes As PromptSelectionResult = ed.GetSelection(sf)
            If pSelRes.Status <> PromptStatus.OK Then
                Return
            End If

            Dim objIdArray() As ObjectId = pSelRes.Value.GetObjectIds()
            ed.WriteMessage(vbLf & "{0} Solids or Surfaces were selected.", objIdArray.Count)

            Using trx As Transaction = db.TransactionManager.StartTransaction()
                Dim btr As BlockTableRecord = TryCast(trx.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
                Dim StrtPt, EndPt As Point3d

                With Start_End_Direction.LineJigger.Jig()
                    StrtPt = .startpunt
                    EndPt = .eindpunt
                End With

                Dim Dist As Double = SelDistance() 'Distance
                If Dist = Nothing Then Exit Sub

                Dim IntermediatePt As Point3d = StrtPt
                Dim vecDir As Vector3d = StrtPt.GetVectorTo(EndPt).GetNormal 'normalvector of direction
                vecDir = vecDir.MultiplyBy(Dist) 'Normal vector multiplied by distance
                For Each oid As ObjectId In objIdArray
                    Dim ent As DBObject = trx.GetObject(oid, OpenMode.ForRead)

                    If TypeOf ent Is Solid3d Then 'Solid3D

                        Using sol As Solid3d = DirectCast(trx.GetObject(oid, OpenMode.ForRead), Solid3d)
                            While Not IntermediatePt.DistanceTo(EndPt) < Dist
                                Try

                                    Dim SectReg As Autodesk.AutoCAD.DatabaseServices.Region = sol.GetSection(New Plane(IntermediatePt, vecDir))
                                    SectReg.ColorIndex = 1
                                    btr.AppendEntity(SectReg)
                                    trx.AddNewlyCreatedDBObject(SectReg, True)
                                    'RegionToPolyline(SectReg.ObjectId, True) 'Hier zit nog een klein gekkigheidje in.
                                    IntermediatePt = New Point3d((IntermediatePt.X + vecDir.X), (IntermediatePt.Y + vecDir.Y), (IntermediatePt.Z + vecDir.Z))

                                Catch NoIntersection As Exception When NoIntersection.Message = "eNoIntersections"
                                    IntermediatePt = New Point3d((IntermediatePt.X + vecDir.X), (IntermediatePt.Y + vecDir.Y), (IntermediatePt.Z + vecDir.Z))

                                End Try
                            End While

                        End Using
                    End If

                    If TypeOf ent Is Autodesk.AutoCAD.DatabaseServices.Surface Then 'Surface

                        Using surf As Autodesk.AutoCAD.DatabaseServices.Surface = DirectCast(trx.GetObject(oid, OpenMode.ForRead), Autodesk.AutoCAD.DatabaseServices.Surface)
                            While Not IntermediatePt.DistanceTo(EndPt) < Dist

                                Dim SectionEntities As Entity() = surf.CreateSectionObjects(New Plane(IntermediatePt, vecDir))
                                If SectionEntities IsNot Nothing Then

                                    For Each SectEnt As Entity In SectionEntities
                                        SectEnt.ColorIndex = 1
                                        btr.AppendEntity(SectEnt)
                                        trx.AddNewlyCreatedDBObject(SectEnt, True)
                                    Next
                                End If

                                IntermediatePt = New Point3d((IntermediatePt.X + vecDir.X), (IntermediatePt.Y + vecDir.Y), (IntermediatePt.Z + vecDir.Z))

                            End While
                        End Using
                    End If

                    IntermediatePt = StrtPt
                Next

                trx.Commit()
            End Using

        Catch ex As Exception
            ed.WriteMessage(vbLf & "Something went wrong:"  & vbLf & ex.ToString())

        End Try
    End Sub


Function SelDistance() As Double
       
        Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
        Dim pDblOpts As PromptDoubleOptions = New PromptDoubleOptions("") With {
            .Message = vbCrLf & "Enter interval distance: ",
            .AllowZero = False,
            .AllowNegative = False,
            .AllowNone = False
          }
        Dim PromptDistance = doc.Editor.GetDouble(pDblOpts)

        If PromptDistance.Status = PromptStatus.OK Then
            SelDistance = PromptDistance.Value
        Else
            SelDistance = Nothing
        End If

    End Function


End Class


Namespace Start_End_Direction
    'Adapted from:
    'https://spiderinnet1.typepad.com/blog/2013/07/autocad-jig-vbnet-dynamic-dimension-and-line-jig-using-entityjig.html

    Public Class LineJigger
        Inherits EntityJig

        Private Shared mEndPoint As Point3d = New Point3d()

        Public Sub New(ByVal ent As Line)
            MyBase.New(ent)
        End Sub

        Protected Overrides Function Update() As Boolean
            '(TryCast(Entity, Line)).EndPoint = mEndPoint
            Dim lijn As Line = TryCast(Entity, Line)
            lijn.EndPoint = mEndPoint
            Return True
        End Function

        Protected Overrides Function Sampler(ByVal prompts As JigPrompts) As SamplerStatus
            Dim prOptions1 As JigPromptPointOptions = New JigPromptPointOptions(vbLf & "Select endpoint and direction: ") With {
                .BasePoint = (TryCast(Entity, Line)).StartPoint,
                .UseBasePoint = True,
                .UserInputControls = UserInputControls.Accept3dCoordinates Or UserInputControls.AnyBlankTerminatesInput Or UserInputControls.GovernedByOrthoMode Or UserInputControls.GovernedByUCSDetect Or UserInputControls.UseBasePointElevation Or UserInputControls.InitialBlankTerminatesInput Or UserInputControls.NullResponseAccepted
            }
            Dim prResult1 As PromptPointResult = prompts.AcquirePoint(prOptions1)
            If prResult1.Status = PromptStatus.Cancel Then Return SamplerStatus.Cancel

            If prResult1.Value.Equals(mEndPoint) Then
                Return SamplerStatus.NoChange
            Else
                mEndPoint = prResult1.Value
                Return SamplerStatus.OK
            End If
        End Function

        Public Shared Function Jig() As (startpunt As Point3d, eindpunt As Point3d)
            Try

                Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
                Dim ed As Editor = doc.Editor
                Dim ppr As PromptPointResult = ed.GetPoint(vbLf & "Select startpoint: ")
                If ppr.Status <> PromptStatus.OK Then Return Nothing
                Dim pt As Point3d = ppr.Value
                Dim ent As Line = New Line(pt, pt) With {
                    .ColorIndex = 4
                }
                ent.TransformBy(ed.CurrentUserCoordinateSystem)
                Dim jigger As LineJigger = New LineJigger(ent)
                Dim pr As PromptResult = ed.Drag(jigger)

                Return (ent.StartPoint, ent.EndPoint)
            Catch

                Return (Nothing, Nothing)
            End Try

        End Function

    End Class
End Namespace

Gelogd
Pagina's: [1]   Omhoog