TurboCAD 3D Elbows first created 22/10/05 - last modified xx/xx/xx Page Author: Ty Harness

---

Here's a little macro to make it quicker and easier to draw 3D elbows in TurboCAD Pro. I like to show the source code on the web page and if you are unsure how to turn that into a tcm file then please look at 'VBA in sixty seconds'. Elbows are fantistic building blocks to more complex 3D design.

Figure 1- A pair of chrome rendered elbows

You can choose the tude diameter, bend radius and the inclusive angle.

Figure 2 - Screen shot of the macro below

---

Private Const degtorad = 0.0174532
Private Const PI = 3.1415927

Sub InsertElbow()

Dim D As Double
Dim IA As Double
Dim BR As Double

Dim s As String
s = InputBox("Tube Diameter", "Elbows", 50 )
If s = "" Then Exit Sub
D = CDbl(s)

s = InputBox("Inclusive Angle", "Elbows", 90 )
If s = "" Then Exit Sub
IA = CDbl(s)
IA = IA

BR = D

s = InputBox("Bend Radius", "Elbows", BR)
If s = "" Then Exit Sub
BR = CDbl(s)


makeElbow D, IA, BR


End Sub

Private Function makeElbow(dia As Double, IncAngDeg As Double, BendRad As Double) As Long

Dim App As Application
Dim ActDr As Drawing
Dim Grs As Graphics
Dim gr As Graphic
Dim Gr1 As Graphic
Dim Ver As Vertex

Set App = IMSIGX.Application
Set ActDr = App.ActiveDrawing
Set Grs = ActDr.Graphics

Set gr = Grs.Add(, "TCW40SPIN") '
gr.Properties("$ROTATIONANGLE") = IncAngDeg 'deg


'On Error Resume Next
'For i = 0 To gr.Properties.Count - 1
's = s + gr.Properties(i).Name & " " & gr.Properties(i).Value & Chr(10)
'Next i
'Msgbox s

'roatation axis
Set Ver = gr.Vertices.Add( 0 , 0 , 0 )
Set Ver = Nothing
Set Ver = gr.Vertices.Add( 100 , 0 , 0 )
Set Ver = Nothing


r# = dia * 0.5 ' radius tubex0# = 0y0# = 0
Set Gr1 = Grs.AddCircleCenterAndPoint(x0, y0, 0 , x0 + r, y0, 0 ) ' create the graphic that will be profile (base) for extrude
Gr1.MoveRelative 0 , BendRad, 0
Set Gr1 = Grs.Remove(Gr1.Index) ' remove the base graphic from Graphics collection of the drawing

gr.Graphics.AddGraphic Gr1 ' add the base grahic to graphics collection of extrude

makeElbow = gr.ID

Set Gr1 = Nothing
Set gr = Nothing
Set Grs = Nothing
Set ActDr = Nothing
Set App = Nothing

End Function

---

[Home] [Mechanics] [Welding] [Software] [CAD] [Math]

Tested in Firefox 1.06: FireFox homepage