This example shows how to fillet and stretch sketch entities.
'--------------------------------------------------------------
'Preconditions:
' 1. Create a VB.NET Windows console project.
' 2. Copy and paste this project into the VB.NET IDE.
' 3. Add a reference to:
' install_dir\APISDK\tlb\DraftSight.Interop.dsAutomation.
' 4. Add references to System and System.Windows.Forms.
' 5. Start DraftSight and open a new drawing.
' 6. Run the macro.
'
'Postconditions:
'1. Three pairs of sketch entities are created and filleted.
'2. Three sketch entities are created and stretched.
'----------------------------------------------------------------
Imports
System.Collections.Generic
Imports
System.Text
Imports
DraftSight.Interop.dsAutomation
Imports
System.Runtime.InteropServices
Imports
System.Windows.Forms
Module
Module1
Dim
dsApp As
DraftSight.Interop.dsAutomation.Application
Dim
dsDoc As
Document
Sub
Main(ByVal
args As
String())
'Connect to DraftSight application
dsApp = ConnectToDraftSight()
If
dsApp Is
Nothing
Then
Return
End
If
dsApp.AbortRunningCommand()
' abort any command currently running in
DraftSight to avoid nested commands
'Get
active document
dsDoc = dsApp.GetActiveDocument()
If
dsDoc Is
Nothing
Then
MessageBox.Show("There
are no opened documents in DraftSight.")
Return
End
If
'Get
model space
Dim
dsModel As
Model = dsDoc.GetModel()
'Get sketch manager
Dim
dsSketchMgr As
SketchManager = dsModel.GetSketchManager()
'Fillet entities
FilletEntities(dsSketchMgr)
'Stretch entities
StretchEntities(dsSketchMgr)
End
Sub
Sub
StretchEntities(ByVal
dsSketchMgr As
SketchManager)
'Stretch parameters
Dim
displacementX As
Double = 4
Dim
displacementY As
Double = 6
Dim
displacementZ As
Double = 0
Dim
dsEntities As
DispatchWrapper() = Nothing
Dim
crossingBoxStartCorner As
Double() =
Nothing
Dim
crossingBoxEndCorner As
Double() =
Nothing
'Prepare
entities for stretch
DrawEntitiesForStretch(dsSketchMgr,
dsEntities, crossingBoxStartCorner, crossingBoxEndCorner)
'Zoom extents
dsApp.Zoom(dsZoomRange_e.dsZoomRange_Fit,
Nothing,
Nothing)
MessageBox.Show("Entities before
STRETCH.")
'Stretch entities
dsSketchMgr.StretchEntities(displacementX,
displacementY, displacementZ, dsEntities, crossingBoxStartCorner,
crossingBoxEndCorner)
'Zoom extents
dsApp.Zoom(dsZoomRange_e.dsZoomRange_Fit,
Nothing,
Nothing)
MessageBox.Show("Entities after
STRETCH.")
End
Sub
Sub
DrawEntitiesForStretch(ByVal
dsSketchMgr As
SketchManager, ByRef
dsEntities As
DispatchWrapper(), ByRef
crossingBoxStartCorner As
Double(),
ByRef
crossingBoxEndCorner As
Double())
'Initialize output entities array
Dim
entitiesIndex As
Integer = 0
Dim
entitiesCount As
Integer = 3
dsEntities = New
DispatchWrapper(entitiesCount) {}
'Draw polyline
Dim
closed As
Boolean =
True
Dim
coordinates As
Double() =
{1, 1, 3, 1, 3, 3, _
1, 3}
Dim
dsPolyline As
PolyLine = dsSketchMgr.InsertPolyline2D(coordinates, closed)
'Add polyline to output array of
entities
dsEntities(System.Math.Max(System.Threading.Interlocked.Increment(entitiesIndex),
entitiesIndex - 1)) = New
DispatchWrapper(dsPolyline)
'Draw line
Dim
startPoint As
Double() =
{4, 1, 0}
Dim
endPoint As
Double() =
{4, 5, 0}
Dim
dsLine As
Line = dsSketchMgr.InsertLine(startPoint(0), startPoint(1),
startPoint(2), endPoint(0), endPoint(1), endPoint(2))
'Add line to output array of
entities
dsEntities(System.Math.Max(System.Threading.Interlocked.Increment(entitiesIndex),
entitiesIndex - 1)) = New
DispatchWrapper(dsLine)
'Draw circle
Dim
radius As
Double = 1
Dim
centerPoint As
Double() =
{6, 2, 0}
Dim
dsCircle As
Circle = dsSketchMgr.InsertCircle(centerPoint(0), centerPoint(1),
centerPoint(2), radius)
'Add circle to output array of
entities
dsEntities(System.Math.Max(System.Threading.Interlocked.Increment(entitiesIndex),
entitiesIndex - 1)) = New
DispatchWrapper(dsCircle)
'Specify crossing coordinates
crossingBoxStartCorner =
New
Double() {0.6, 2,
0}
crossingBoxEndCorner = New
Double()
{8, 6, 0}
End
Sub
Sub
FilletEntities(ByVal
dsSketchMgr As
SketchManager)
Dim
firstPointOnEntityDblArray As
Double() =
Nothing
Dim
firstEntityArray As
DispatchWrapper() = Nothing
Dim
secondPointOnEntityDblArray As
Double() =
Nothing
Dim
secondEntityArray As
DispatchWrapper() = Nothing
'Prepare
entities for fillet
DrawEntitiesForFillet(dsSketchMgr,
firstPointOnEntityDblArray, firstEntityArray, secondPointOnEntityDblArray,
secondEntityArray)
'Zoom extents
dsApp.Zoom(dsZoomRange_e.dsZoomRange_Fit,
Nothing,
Nothing)
MessageBox.Show("Entities before
FILLET.")
'Set fillet radius
Dim
filletRadius As
Double =
1.5
SetFilletRadius(dsDoc, filletRadius)
'Do fillet entities
dsSketchMgr.FilletEntities(firstPointOnEntityDblArray,
firstEntityArray, secondPointOnEntityDblArray, secondEntityArray)
'Zoom extents
dsApp.Zoom(dsZoomRange_e.dsZoomRange_Fit,
Nothing,
Nothing)
MessageBox.Show("Entities after
FILLET.")
End
Sub
Sub
DrawEntitiesForFillet(ByVal
dsSketchMgr As
SketchManager, ByRef
firstPointOnEntityDblArray As
Double(),
ByRef
firstEntityArray As
DispatchWrapper(), ByRef
secondPointOnEntityDblArray As
Double(),
ByRef
secondEntityArray As
DispatchWrapper())
'Count of entity pairs to fillet
Dim
count As
Integer = 3
'Initialize output arrays
firstPointOnEntityDblArray =
New
Double(count * 3 -
1) {}
firstEntityArray = New
DispatchWrapper(count - 1) {}
secondPointOnEntityDblArray = New
Double(count
* 3 - 1) {}
secondEntityArray = New
DispatchWrapper(count - 1) {}
Dim
entityIndex As
Integer = 0
Dim
coordinateIndex As
Integer = 0
'--------Draw the first pair of
entities to fillet-----------------------
'Draw
a line
Dim
startPoint As
Double() =
{0, 0, 0}
Dim
endPoint As
Double() =
{5, 0, 0}
Dim
dsLine As
Line = dsSketchMgr.InsertLine(startPoint(0), startPoint(1),
startPoint(2), endPoint(0), endPoint(1), endPoint(2))
'Add line entity to output arrays
firstEntityArray(entityIndex) =
New
DispatchWrapper(dsLine)
firstPointOnEntityDblArray(coordinateIndex) = endPoint(0)
firstPointOnEntityDblArray(coordinateIndex + 1) = endPoint(1)
firstPointOnEntityDblArray(coordinateIndex + 2) = endPoint(2)
'Draw an arc
Dim
radius As
Double = 1
Dim
centerPoint As
Double() =
{2, -1, 0}
Dim
startAngle As
Double =
Math.PI
Dim
endAngle As
Double =
1.5 * Math.PI
Dim
dsArc As
CircleArc = dsSketchMgr.InsertArc(centerPoint(0), centerPoint(1),
centerPoint(2), radius, startAngle, endAngle)
'Add arc entity to output arrays
secondEntityArray(entityIndex) =
New
DispatchWrapper(dsArc)
secondPointOnEntityDblArray(coordinateIndex) = centerPoint(0) -
radius
secondPointOnEntityDblArray(coordinateIndex + 1) = centerPoint(1)
secondPointOnEntityDblArray(coordinateIndex + 2) = centerPoint(2)
'Increase entity index
entityIndex += 1
'Increase coordinate index
coordinateIndex += 3
'--------Draw the second pair of
entities to fillet----------------------
'Draw
a line
startPoint =
New
Double() {11, 0,
0}
endPoint = New
Double()
{16, 0, 0}
dsLine = dsSketchMgr.InsertLine(startPoint(0), startPoint(1),
startPoint(2), endPoint(0), endPoint(1), endPoint(2))
'Add line entity to output arrays
firstEntityArray(entityIndex) =
New
DispatchWrapper(dsLine)
firstPointOnEntityDblArray(coordinateIndex) = endPoint(0)
firstPointOnEntityDblArray(coordinateIndex + 1) = endPoint(1)
firstPointOnEntityDblArray(coordinateIndex + 2) = endPoint(2)
'Draw a circle
centerPoint =
New
Double() {18, -1,
0}
radius = 1
Dim
dsCircle As
Circle = dsSketchMgr.InsertCircle(centerPoint(0), centerPoint(1),
centerPoint(2), radius)
'Add circle entity to output arrays
secondEntityArray(entityIndex) =
New
DispatchWrapper(dsCircle)
secondPointOnEntityDblArray(coordinateIndex) = centerPoint(0) -
radius
secondPointOnEntityDblArray(coordinateIndex + 1) = centerPoint(1)
secondPointOnEntityDblArray(coordinateIndex + 2) = centerPoint(2)
'Increase entity index
entityIndex += 1
'Increase coordinate index
coordinateIndex += 3
'--------Draw the third pair of
entities to fillet-----------------------
'Draw
first circle
centerPoint =
New
Double() {7, -1,
0}
radius = 1
Dim
dsFirstCircle As
Circle = dsSketchMgr.InsertCircle(centerPoint(0), centerPoint(1),
centerPoint(2), radius)
'Add circle entity to output arrays
firstEntityArray(entityIndex) =
New
DispatchWrapper(dsFirstCircle)
firstPointOnEntityDblArray(coordinateIndex) = centerPoint(0)
firstPointOnEntityDblArray(coordinateIndex + 1) = centerPoint(1) +
radius
firstPointOnEntityDblArray(coordinateIndex + 2) = centerPoint(2)
'Draw second circle
centerPoint(0) = 9
Dim
dsSecondCircle As
Circle = dsSketchMgr.InsertCircle(centerPoint(0), centerPoint(1),
centerPoint(2), radius)
'Add circle entity to output arrays
secondEntityArray(entityIndex) =
New
DispatchWrapper(dsSecondCircle)
secondPointOnEntityDblArray(coordinateIndex) = centerPoint(0)
secondPointOnEntityDblArray(coordinateIndex + 1) = centerPoint(1) +
radius
secondPointOnEntityDblArray(coordinateIndex + 2) = centerPoint(2)
End
Sub
Sub
SetFilletRadius(ByVal
dsDoc As
Document, ByVal
filletRadius As
Double)
Dim
setResult As
dsSetCommandOptionResult_e
Dim
filletRadCommandOption As
dsCommandOptionDouble_e =
dsCommandOptionDouble_e.dsCommandOptionDouble_SetFltRad
dsDoc.SetCommandOptionDouble(filletRadCommandOption,
filletRadius, setResult)
If
dsSetCommandOptionResult_e.dsSetCommandOptionResult_Success <> setResult
Then
MessageBox.Show("Document.SetCommandOptionDouble()
returns " & setResult.ToString() &
" after setting of "
& filletRadCommandOption & " command
option.")
End
If
End
Sub
Function
ConnectToDraftSight() As
DraftSight.Interop.dsAutomation.Application
Dim
dsApp As
DraftSight.Interop.dsAutomation.Application =
Nothing
Try
'Connect
to DraftSight
dsApp =
DirectCast(Marshal.GetActiveObject("DraftSight.Application"),
DraftSight.Interop.dsAutomation.Application)
Catch
ex As
Exception
MessageBox.Show("Failed to
connect to DraftSight. Cause: " &
ex.Message)
dsApp = Nothing
End
Try
Return
dsApp
End
Function
End Module