I am constantly doing layouts that involve using Arc, radius, chord & angle, where two of those are known, and the other two are unknown (needs to be either layout or manually calculated). I already have an excel spread sheet to doing something similar. I was just curious if there are any programs out there that do any kind of arc, chord & angle type of manipulation. For example, where it prompts you for a radius (the user would either input a radius on the number keypad or could measure/select two point in the drawing as input radius). then it would prompt you for either a chord or angle in the same manner. Then it would generate the solution as a text.
It's a lot quicker to input arc or angle, with a click of a mouse, then inputting into excel (and possibly making a typing mistake); and having to measure radius, or angle, then transcribing it to excel into the appropriate cell to solve the unknowns variable. Then having to copy the results, back to microstationas text. I am sure, I am not the only one that has ever needed such a program, and was just curious if there was one already written by someone (or something similar relating to solving for arc, chord, radius or angle). Thanks
If you can write the forumulæ in Excel, then you (or someone) can reproduce them using VBA.
Regards, Jon Summers LA Solutions
This is code for a macro that will do bearing and arcs, it is over a decade old but still works. I have be meaning to change it to a vba for years, but is low on my list. You can either copy into a macro, or use the concept in a vba.
' Places bearing on a line or arc
'--------------------------------------------------------------------
' Created: Larry Wilson
' Workfile: Bearing.bas
' Revision: 1.0
' Date: 3/1998
' Rev:1A LWilson-Change seperator and from dbl '' to "
' Notes:
Sub DegMinSec (Iangle#,Angle$)
Dim Degrees As Integer
Dim Minutes As Integer
Dim Seconds As Integer
Dim TempDouble as Double
Dim Sec as String
Sec=CHR$(34)
TempDouble = IAngle
Degrees = IAngle
TempDouble = TempDouble - Degrees
If TempDouble < 0 Then
TempDouble = Abs(1 - Abs(TempDouble))
Degrees = Degrees - 1
End If
TempDouble = TempDouble * 60
Minutes = TempDouble
TempDouble = TempDouble - Minutes
Minutes = Minutes - 1
Seconds = TempDouble
if Seconds > 59.5 then
Minutes = Minutes + 1
Seconds = Seconds - 60
End if
if Minutes > 59 then
Degrees = Degrees + 1
Minutes = Minutes - 60
Degrees = Abs(Degrees)
Minutes = Abs(Minutes)
Seconds = Abs(Seconds)
Angle$ = Format$(Degrees,"General Number") + "^"
Angle$ = Angle$ + Format$(Minutes,"General Number") + "'"
Angle$ = Angle$ + Format$(Seconds,"General Number") + Sec
End Sub
Sub Main
MbeSendCommand "Null"
' MbeSendCommand "set parseall off"
Dim accepted As Integer
Dim elem As New MbeElement 'defines an object called elem in which we
'will keep our element
Dim filePos As Long
Dim status As Integer
Dim Label as String
Dim IAngle as Double
Dim Radius as Double
Dim element as New MbeElement
Dim Angle As String
Dim ArcLength as Double
Dim StartPoint as MbePoint
Dim EndPoint as MbePoint
Dim ChLength as Double
Dim ChAngle as Double
Dim ChBearing as String
Dim NS as String
Dim EW as String
Dim endOfFilePos as Long
Dim Sp as String
Dim RotAngle as Double
Sp = " "
' MbeSendCommand "NOECHO"
MbeWriteCommand "MACRO Label Bearing"
MbeWritePrompt "Select Element"
accepted = FALSE
While NOT accepted
MbeStartLocate
MbeWritePrompt "Select element..."
MbeGetInput MBE_DataPointInput, _
MBE_ResetInput, _
MBE_CommandInput, _
MBE_KeyInInput
Start:
Lablel$ = ""
Select Case MbeState.InputType
Case MBE_CommandInput
MbeSendLastInput
Exit Sub
Case MBE_KeyinInput
End Select
filePos = element.fromLocate()
'While we've found an element that we haven't yet accepted
While MbeState.CmdResult = MBE_AcceptQuery AND _
NOT accepted
MbeWritePrompt "Accept/Reject"
Case MBE_ResetInput
filePos = elem.fromLocate()
'Because MbeStartLocate automatically finds another
'element if there is one at the same place.
Case MBE_DataPointInput
accepted = TRUE
Wend
Dim Tang as Double
Select Case element.type
Case Mbe_Arc
Radius = Element.primaryAxis
Label$ = "R=" + Format$(Radius, "Fixed") + "'"
IAngle = Element.SweepAngle
IAngle = Abs(IAngle)
IAngle = IAngle*180/PI
tang=iangle/2
tang=Tan(Tang/180*pi)
Tang=(Radius * Tang)
Call DegMinSec (IAngle#, Angle$)
Label$ = Label$ + chr$(10)
Label$ = Label$ + "23/64 ="
Label$ = Label$ + Angle$
Label$ =Label$+"T="+Format$(tang, "Fixed")
Label$ = Label$ + "ARC ="
ArcLength = IAngle / 360
ArcLength = ArcLength * PI * Radius * 2
Label$ = Label$ + Format$(ArcLength, "Fixed") + "'"
Case Mbe_Line
Case Else
DistBear:
Status=Element.getEndPoints(StartPoint,EndPoint)
TempDouble = (StartPoint.x - EndPoint.x)
Chlength = (StartPoint.y - EndPoint.y)
TempDouble = TempDouble * TempDouble
ChLength = ChLength * ChLength
ChLength = ChLength + TempDouble
ChLength = Sqr(ChLength)
MbeSendKeyin "dv=TEMP01"
MbeSendKeyin "sv=TEMP01"
MbeSendDataPoint startpoint, 1%
MbeSendKeyin "vi=top"
MbeSendCommand "act an pt3"
MbeSendDataPoint Startpoint
MbeSendKeyin "dx=,-5"
MbeSendKeyin "di=5,n0^e"
RotAngle = MbeSettings.angle * 180 / PI
MbeSendCommand "act an pt2"
MbeSendDataPoint EndPoint
MbeSendKeyin "vi=TEMP01"
ChAngle = MbeSettings.angle * 180 / PI
ChAngle = Changle - RotAngle
if ChAngle < 0 Then
ChAngle = 360 + ChAngle
Select Case ChAngle
Case 0 to 90
NS = "N"
EW = "E"
ChAngle = 90 - Changle
Case 90 to 180
EW = "W"
ChAngle = ChAngle - 90
Case 180 to 270
NS = "S"
ChAngle = 90 - (ChAngle - 180)
Case 270 to 360
ChAngle = ChAngle - 270
IAngle = ChAngle
If element.type = mbe_Arc Then
Label$ = Label$ + chr$(10) + "Ch=" + NS + Sp + Angle$ + EW
Label$ = Label$ + "-" + Format$(ChLength,"Fixed") + "'"
MbeSettings.angle = 0
ElseIf element.type = mbe_Line Then
Label$ = NS + Sp + Angle$ + EW
Label$ = Label$ + Sp + "- " + Format$(ChLength,"Fixed") + "'"
TempDouble = MbeSettings.angle/PI
If (MbeSettings.angle/PI) > .5 and (MbeSettings.angle/PI) < 1.5 Then
MbeSettings.angle = MbeSettings.angle - PI
PlaceText:
MbeSettings.textjustification = MBE_LeftTop
MbeSettings.nodejustification = MBE_LeftTop
MbeSendCommand "set parseall off"
MbeSendCommand "Place Text "
MbeSendKeyin Label
MbeSendCommand "set parseall on"
MbeWriteCommand ""
'MbeWritePrompt ""
' MbeWriteStatus "Pick Next Line <D> Exit <R>"
' MbeGetInput MBE_DataPointInput, _
' MBE_ResetInput, _
' MBE_CommandInput, _
' MBE_KeyInInput
Main
GOTO EndMacro
EndMacro:
' Turn Parse All back on
MbeSendCommand "set Parseall on"
MbeSendCommand "ECHO on"
MbeWritePrompt ""
MbeWriteStatus "Finished MACRO LABEL ARC"
Larry WilsonLWilson@LJBinc.com
Also the macro is setup where the user just picks the line or arc and the bearing of the line or information of the arc is put on the end of the cursor at active text format.
Thanks for the Macro. I tried using it but I am getting an error "complication failed at line 21
syntax error". Basically I opened the macro dialog box and selected "new" blank macro. Then I pasted your macro lines and saved it as aaa.bas macro. When I run the macro, I get an error. Also tried adding "Sub main" to the beginning of the macro routine. Is this the way to do it? Or would it be easier to to just post the Bearing.bas file as an attachment to this thread? Thanks
Hi
xxx.bas is a Microstation BASIC file extension... This is old and out-dated. xxx.mvba is a vba extension. Please double check that you are pasting this into a vba module.
--Robert