Sketch line functionality through VBA
@Anonymous,
Try below VBA code to calculate second point based on orientation (Horizontal or vertical). This code is embedded with MouseEvents. For more details on MouseEvents, refer below link.
Public Sub TestGetDrawingPoint()
Dim getPoint As New clsGetPoint
Dim pnt1 As Point2d
Dim pnt2 As Point2d
Do
Set pnt1 = getPoint.GetDrawingPoint("Click the desired location", kLeftMouseButton)
If Not pnt1 Is Nothing Then
Dim lineLen As Double
lineLen = InputBox("Enter the length of line")
Dim line_orientation As String
line_orientation = InputBox("Type H(Horizontal) or V(Vertical)")
line_orientation = UCase(line_orientation)
Dim hor_Alignment As String
Dim ver_Alignment As String
If line_orientation = "H" Then
hor_Alignment = InputBox("Type L(Left) or R(Right)")
hor_Alignment = UCase(hor_Alignment)
If hor_Alignment = "L" Then
Set pnt2 = ThisApplication.TransientGeometry.CreatePoint2d(pnt1.X - lineLen, pnt1.Y)
ElseIf hor_Alignment = "R" Then
Set pnt2 = ThisApplication.TransientGeometry.CreatePoint2d(pnt1.X + lineLen, pnt1.Y)
Else
MsgBox ("Invalid entry for horizantal alignment")
End If
ElseIf line_orientation = "V" Then
ver_Alignment = InputBox("Type U(Upward) or D(Downward)")
ver_Alignment = UCase(ver_Alignment)
If ver_Alignment = "U" Then
Set pnt2 = ThisApplication.TransientGeometry.CreatePoint2d(pnt1.X, pnt1.Y + lineLen)
ElseIf ver_Alignment = "D" Then
Set pnt2 = ThisApplication.TransientGeometry.CreatePoint2d(pnt1.X, pnt1.Y - line_len)
Else
MsgBox ("Invalid entry for vertical alignment")
End If
Else
MsgBox ("Invalid Entry for line orientation")
End If
End If
Loop While Not pnt Is Nothing
End Sub
Need to create a Class module called "clsGetPoint" and include the below code.
Private WithEvents m_interaction As InteractionEvents
Private WithEvents m_mouse As MouseEvents
Private m_position As Point2d
Private m_button As MouseButtonEnum
Private m_continue As Boolean
Public Function GetDrawingPoint(Prompt As String, button As MouseButtonEnum) As Point2d
Set m_position = Nothing
m_button = button
Set m_interaction = ThisApplication.CommandManager.CreateInteractionEvents
Set m_mouse = m_interaction.MouseEvents
m_interaction.StatusBarText = Prompt
m_interaction.Start
m_continue = True
Do
DoEvents
Loop While m_continue
m_interaction.Stop
Set GetDrawingPoint = m_position
End Function
Private Sub m_mouse_OnMouseClick(ByVal button As MouseButtonEnum, ByVal ShiftKeys As ShiftStateEnum, ByVal ModelPosition As Point, ByVal ViewPosition As Point2d, ByVal View As View)
If button = m_button Then
Set m_position = ThisApplication.TransientGeometry.CreatePoint2d(ModelPosition.X, ModelPosition.Y)
End If
m_continue = False
End Sub
For coincident constraint, refer the suggestions in below links.
http://adndevblog.typepad.com/manufacturing/2012/05/addcoincident-with-two-sketch-points.html
Thanks and regards,
CHANDRA SHEKAR G
Developer Advocate
Autodesk Developer Network
Hello @Anonymous,
It worked at certain times with a single axis, but adding 3 axes made it not work. It also wasn't unlatching from the first created line.
Can you please elaborate on above statement?
Thanks and regards,
CHANDRA SHEKAR G
Developer Advocate
Autodesk Developer Network
Accepted solution
Hello @Anonymous,
Hoping that below angle algorithm would help to draw horizontal and vertical line.
Public Sub DrawSketchLine()
' Check to make sure a sketch is active.
If Not TypeOf ThisApplication.ActiveEditObject Is Sketch Then
MsgBox "A sketch must be active."
Exit Sub
End If
Dim getPoint As New Class1
Dim pnt As Integer
pnt = 0
Do
Call getPoint.Initialize("Click the desired location", kLeftMouseButton)
pnt = pnt + 1
Loop While pnt > 2
End Sub
Private WithEvents oInteractionEvents As InteractionEvents
Private WithEvents oMouseEvents As MouseEvents
Private m_position As Point2d
Private m_button As MouseButtonEnum
Private m_continue As Boolean
Private oIntGraphics As InteractionGraphics
Private oStartPoint As Point
Private oEndPoint As Point
Public Sub Initialize(Prompt As String, Button As MouseButtonEnum)
Set m_position = Nothing
m_button = Button
Set oInteractionEvents = ThisApplication.CommandManager.CreateInteractionEvents
Set oMouseEvents = oInteractionEvents.MouseEvents
oInteractionEvents.StatusBarText = Prompt
oInteractionEvents.Start
m_continue = True
Do
DoEvents
Loop While m_continue
m_interaction.Stop
End Sub
Private Sub oMouseEvents_OnMouseDown(ByVal Button As MouseButtonEnum, ByVal ShiftKeys As ShiftStateEnum, ByVal ModelPosition As Point, ByVal ViewPosition As Point2d, ByVal View As View)
If oStartPoint Is Nothing Then
Set oStartPoint = ModelPosition
Else
Dim dY As Double
Dim dX As Double
Dim m As Double
dY = oStartPoint.Y - ModelPosition.Y
dX = oStartPoint.X - ModelPosition.X
m = dY / dX
Dim angle As Double
angle = Atn(m) * 180 / 3.1415
If Abs(angle) >= 45 Then
'Draws vertical line
ModelPosition.X = oStartPoint.X
ElseIf Abs(angle) <= 45 Then
'Draws horizontal line
ModelPosition.Y = oStartPoint.Y
End If
Set oEndPoint = ModelPosition
Dim oSketchLine As SketchLine
Dim oStartPoint2d As Point2d
Dim oEndPoint2d As Point2d
If TypeOf ThisApplication.ActiveEditObject Is PlanarSketch Then
Dim oSketch2d As PlanarSketch
Set oSketch2d = ThisApplication.ActiveEditObject
Set oStartPoint2d = oSketch2d.ModelToSketchSpace(oStartPoint)
Set oEndPoint2d = oSketch2d.ModelToSketchSpace(oEndPoint)
Set oSketchLine = oSketch2d.SketchLines.AddByTwoPoints(oStartPoint2d, oEndPoint2d)
Dim offsetCol As ObjectCollection
Set offsetCol = ThisApplication.TransientObjects.CreateObjectCollection
offsetCol.Add oSketchLine
Call oSketch2d.OffsetSketchEntitiesUsingDistance(offsetCol, 2.54, True, False, True)
Call oSketch2d.OffsetSketchEntitiesUsingDistance(offsetCol, 2.54, False, False, True)
ElseIf TypeOf ThisApplication.ActiveEditObject Is DrawingSketch Then
Dim oDrawingSketch As DrawingSketch
Set oDrawingSketch = ThisApplication.ActiveEditObject
Set oStartPoint2d = oDrawingSketch.SheetToSketchSpace(ThisApplication.TransientGeometry.CreatePoint2d(oStartPoint.X, oStartPoint.Y))
Set oEndPoint2d = oDrawingSketch.SheetToSketchSpace(ThisApplication.TransientGeometry.CreatePoint2d(oEndPoint.X, oEndPoint.Y))
Set oSketchLine = oDrawingSketch.SketchLines.AddByTwoPoints(oStartPoint2d, oEndPoint2d)
End If
Set oStartPoint = Nothing
Set oEndPoint = Nothing
End If
End Sub
Private Sub oMouseEvents_OnMouseMove(ByVal Button As MouseButtonEnum, ByVal ShiftKeys As ShiftStateEnum, ByVal ModelPosition As Point, ByVal ViewPosition As Point2d, ByVal View As View)
If Not oStartPoint Is Nothing Then
' Set a reference to the transient geometry object for user later.
Dim oTransGeom As TransientGeometry
Set oTransGeom = ThisApplication.TransientGeometry
' Create a graphics data set object. This object contains all of the
' information used to define the graphics.
Dim oDataSets As GraphicsDataSets
Set oDataSets = oIntGraphics.GraphicsDataSets
If oDataSets.Count <> 0 Then
oDataSets.Item(1).Delete
End If
' Create a coordinate set.
Dim oCoordSet As GraphicsCoordinateSet
Set oCoordSet = oDataSets.CreateCoordinateSet(1)
' Create an array that contains coordinates
Dim oPointCoords(5) As Double
oPointCoords(0) = oStartPoint.X
oPointCoords(1) = oStartPoint.Y
oPointCoords(2) = oStartPoint.Z
oPointCoords(3) = ModelPosition.X
oPointCoords(4) = ModelPosition.Y
oPointCoords(5) = ModelPosition.Z
' Assign the points into the coordinate set.
Call oCoordSet.PutCoordinates(oPointCoords)
'Set preview color to red.
Dim oColorSet As GraphicsColorSet
Set oColorSet = oDataSets.CreateColorSet(1)
oColorSet.Add 1, 0, 255, 0
' Create the ClientGraphics object.
Dim oClientGraphics As ClientGraphics
Set oClientGraphics = oIntGraphics.PreviewClientGraphics
If oClientGraphics.Count <> 0 Then
oClientGraphics.Item(1).Delete
End If
' Create a new graphics node within the client graphics objects.
Dim oLineNode As GraphicsNode
Set oLineNode = oClientGraphics.AddNode(1)
' Create a LineGraphics object within the node.
Dim oLineSet As LineStripGraphics
Set oLineSet = oLineNode.AddLineStripGraphics
oLineSet.ColorSet = oColorSet
' Assign the coordinate set to the line graphics.
oLineSet.CoordinateSet = oCoordSet
ThisApplication.ActiveView.Update
End If
End Sub
Private Sub oInteractionEvents_OnTerminate()
ThisApplication.ActiveView.Update
End Sub
Please feel free to contact if there is any queries.
If solves problem, click on "Accept as solution" / give a "Kudo".
Thanks and regards,
CHANDRA SHEKAR G
Developer Advocate
Autodesk Developer Network