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