Hello,
This afternoon I works on a script designed to draw line with a given length and angle.
run the script then draw a rubber line close to the size and angle you want ; the first point will be fixed.
enter the new values for length and angle in the box (or hit enter/OK if no change for the value.
the cancel button in the window, the ESC key or the MMB are used to terminate/cancel the drawing (the function auto repeat)
I'm working to convert it to a plugin soon.
' New CamBam VBScript
' sized lines - dh42 2015
Dim abort As Boolean, finished As Boolean, redo As Boolean
Dim mPoint As Point3F()
'*******************************************************************************************
Sub main()
redo = True
Dim lgt As Double, ang As Double'lenght, angle
Dim p As Polyline
dim rep as string 'reply of the inputbox -> "" = cancel
Do While redo = True 'repeat the command until ESC or MMB is pressed
abort = False
finished = False
RuberLine()'use MeasureEditMode to draw a line
If finished = False Then Exit Do 'aborted by ESC before 'finished' become true
' test if 2 identical points = line of null lenght
If mPoint(0).Equals(mPoint(1)) Then Exit Do
' add the polyline to the drawing
p = AddPoly(mPoint(0), mPoint(1))
' display the datas and get the new values
'lenght
rep = InputBox("Lenght = " & LineLenght(p), "Lenght", Format(LineLenght(p), "0.00#"))
if rep ="" then Exit Do 'canceled with the msgbox button
lgt = Val(rep)
if lgt = 0 then Exit Do ' new lenght = 0 -> cancel
'angle
rep = InputBox("Angle = " & LineAngle(p), "Angle", Format(LineAngle(p), "0.00#"))
if rep ="" then Exit Do 'canceled with the msgbox button
ang = Val(rep)
'modify the polyline with new lenght and angle
RedoPoly(p, lgt, ang)
Loop
End Sub
'*******************************************************************************************
Sub point_clicked(ByVal sender As Object, ByVal e As EventArgs)
mPoint = sender.returnvalue
abort = True
finished = True
End Sub
'*******************************************************************************************
Sub point_clicked_clr(ByVal sender As Object, ByVal e As EventArgs)
abort = True
redo = False
End Sub
'*******************************************************************************************
Function LineLenght(p As Polyline) As Double
'find the distance between the 2 points (2D on XY axis)
Dim v As Vector2F
v = New Vector2F(p.FirstPoint, p.LastPoint)
Return v.Length
End Function
'*******************************************************************************************
Function LineAngle(p As Polyline) As Double
'find the angle between the 2 points (2D on XY axis)
Dim v As Vector2F
v = New Vector2F(p.FirstPoint, p.LastPoint)
Return (v.Angle / math.Pi) * 180
End Function
'*******************************************************************************************
Sub RedoPoly(poly As Polyline, l As Double, a As Double)
' change the polyline lenght, according to the user request
'l = lenght a = angle (°)
' the news end points ; p1 don't change, it stay the firts point of the polyline at the same location
Dim p1 As Point3F = New Point3F, p2 As Point3F = New Point3F
p1 = poly.FirstPoint'catch the firts point of the polyline
'calculate new lenght
Dim newlx As Double
Dim newly As Double
'convert to radians
a = DegToRad(a)
'x lenght
newlx = l * Math.Cos(a)
'y lenght
newly = l * Math.Sin(a)
'new coord for p2
p2.X = p1.X + newlx
p2.Y = p1.Y + newly
'create and add the new polyline
AddPoly(p1, p2)
'and remove the old polyline (in this order because if not, after the line is created, the snap point
' to the last created line is not working until a new line is created, or removed ..)
'
CamBamUI.MainUI.ActiveView.CADFile.RemovePrimitive(poly)
End Sub
'*******************************************************************************************
Function DegToRad(angle As Double) As Double
'convert degré to radians
Return angle * Math.PI / 180
End Function
'*******************************************************************************************
Function AddPoly(p1 As Point3F, p2 As Point3F) As Polyline
Dim poly As Polyline = New Polyline
poly.Add(p1)
poly.Add(p2)
'display the polyline
CamBamUI.MainUI.ActiveView.CADFile.Add(poly)
CamBamUI.MainUI.ActiveView.RefreshView()
Return poly
End Function
'*******************************************************************************************
Sub RuberLine()
Dim edmode As New MeasureEditMode(CamBamUI.MainUI.ActiveView)
edmode.DefaultValue = vbNull
edmode.Prompt = "Cliquer du bouton du milieu ou Escape pour terminer"
AddHandler edmode.OnReturnOK, AddressOf point_clicked
AddHandler edmode.OnReturnCancel, AddressOf point_clicked_clr
CamBamUI.MainUI.ActiveView.SetEditMode(edmode)
CamBamUI.MainUI.ActiveView.RepaintEditMode()
'wait for edit mode finished (or ESC)
Do While abort = False
System.Windows.Forms.Application.DoEvents()
Loop
RemoveHandler edmode.OnReturnOK, AddressOf point_clicked
RemoveHandler edmode.OnReturnCancel, AddressOf point_clicked_clr
End Sub
'*******************************************************************************************
++
David
Edit: plugin version added.