3D Line – part 2

The distance formula

Function dist1(pt1() As Double) As Double
Dim x As Double, y As Double, z As Double
x = pt1(0): y = pt1(1): z = pt1(2)
dist1 = (x ^ 2 + y ^ 2 + z ^ 2) ^ (1 / 2)
End Function

Function dist2(pt1() As Double, pt2() As Double) As Double
Dim x As Double, y As Double, z As Double
x = pt2(0) - pt1(0)
y = pt2(1) - pt1(1)
z = pt2(2) - pt1(2)
dist2 = (x ^ 2 + y ^ 2 + z ^ 2) ^ (1 / 2)
End Function

test sub

Sub test17()
 Call Connect_Acad
Dim A() As Double, B() As Double
Dim x As Double, y As Double, z As Double

x = 5
y = 4
z = 3

A = pt(x, y, z)
B = pt(x, y, 0)

line1 A
txt1 midpt1(A), dec2(dist1(A))

line1 B
txt1 midpt1(B), dec2(dist1(B))

line1 pt(x, 0, 0)
txt1 midpt1(pt(x, 0, 0)), dec2(x)

line1 pt(0, y, 0)
line1 pt(0, 0, z)

line2 A, B
txt1 midpt2(A, B), dec2(dist2(A, B))

line2 pt(x, 0, 0), B
txt1 midpt2(pt(x, 0, 0), B), dec2(y)

label_pt2 A, "A", 2
label_pt2 B, "B", 2

Dim pt1() As Double
pt1 = pt(x / 2, y / 2, z / 2)
solidbox pt1, x, y, z

End Sub

text and label subs

Sub txt1(pt1() As Double, str As String, Optional height As Variant, Optional rotation As Variant)
  Dim objtxt As AcadText
  
  If IsMissing(height) Then
      height = textheight  'global var
    End If
    
  If IsMissing(rotation) Then
      rotation = 0
    End If
 
  Set objtxt = acadDoc.ModelSpace.AddText(str, pt1, height)
  objtxt.Layer = "0"
  
  If rotation <> 0 Then
  objtxt.rotation = deg2rad(CDbl(rotation))
  End If
     
 End Sub
 
Sub label_pt2(pt1() As Double, Optional str_label As String = "none", Optional prec As Integer = 4)

If IsMissing(height) Then
      height = textheight  'global var
    End If
    
Dim str As String
Dim x As Double, y As Double, z As Double
x = Round(pt1(0), prec)
y = Round(pt1(1), prec)
z = Round(pt1(2), prec)

str = "<" & x & "," & y & "," & z & ">"

If str_label <> "none" Then
str = str_label & " " & str
End If

txt1 pt1, str, textheight
End Sub
 
 Function dec2(number As Double) As Double
   Dim dbl As Double
   dbl = Round(number, 2)
   dec2 = dbl
 End Function

Acad3DSolid box sub. Transparency is a percentage 1 to 90. Higher numbers are more transparent.

Sub solidbox(pt() As Double, leng As Double, wid As Double, height As Double)

Dim objbox As Acad3DSolid
Set objbox = acadDoc.ModelSpace.AddBox(pt, leng, wid, height)
objbox.EntityTransparency = 80

acadApp.Update

End Sub

midpoint

Function midpt1(pt1() As Double) As Double()
Dim x As Double, y As Double, z As Double
x = pt1(0): y = pt1(1): z = pt1(2)
midpt1 = pt(x / 2, y / 2, z / 2)
End Function

Function midpt2(pt1() As Double, pt2() As Double) As Double()
Dim x1 As Double, y1 As Double, z1 As Double
x = (pt1(0) + pt2(0)) / 2
y = (pt1(1) + pt2(1)) / 2
z = (pt1(2) + pt2(2)) / 2
midpt2 = pt(x, y, z)
End Function

test sub


Sub test18()
Call Connect_Acad
Dim A() As Double, B() As Double, C() As Double

A = pt(2, 1, 3)
B = pt(3, -1, -2)
C = pt(0, 2, -1)

line2 A, B
line2 B, C
line2 C, A

line2 midpt2(A, B), midpt2(B, C)
line2 midpt2(B, C), midpt2(C, A)
line2 midpt2(C, A), midpt2(A, B)

label_pt2 A, "A"
label_pt2 B, "B"
label_pt2 C, "C"

label_pt2 midpt2(A, B)
label_pt2 midpt2(B, C)
label_pt2 midpt2(C, A)

acadApp.Update
End Sub

the angles to 3 decimal places

the triangles are all congruent. the middle triangle has half the perimeter of the outer triangle and one fourth the area.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

This site uses Akismet to reduce spam. Learn how your comment data is processed.