Autocad Point Variable

All of Autocad graphics methods use a 3 place array of doubles for the coordinates.

The simplest way to sub this is by passing the static array for the sub to fill data.

Dim PtA(0 To 2) As Double
Call pt1(ptA, 1, 2, 0)

Sub pt1(ByRef pnt() As Double, x As Double, y As Double, z As Double)
pnt(0) = x: pnt(1) = y: pnt(2) = z
End Sub

This changes ptA in the calling program. Another way is to make a function and pass the array back to a receiving variable.
This requires a dynamic array.

Dim ptA() As Double
ptA = Pt(1, 2, 0)

Function Pt(x As Double, y As Double, z As Double) As Double()
Dim pnt(0 To 2) As Double
pnt(0) = x: pnt(1) = y: pnt(2) = z
Pt = pnt
End Function

We can even get away with this – no variables at all.

Set lineAB = acadDoc.ModelSpace.AddLine(Pt(1, 4, 0), Pt(9, 1, 0))

Dynamic arrays can accept point values. A lot of objects return point values, autocad help always seems to use a single variant to hold the array.

The utility polarpoint method returns a point value.

RetVal = object.PolarPoint(Point, Angle, Distance)
Point Type: Variant (three-element array of doubles)
Return Value Type: Variant (three-element array of doubles)

Dim polarPnt As Variant
Dim basePnt(0 To 2) As Double

polarPnt = ThisDrawing.Utility.PolarPoint(basePnt, angle, distance)
Set lineObj = ThisDrawing.ModelSpace.AddLine(basePnt, polarPnt)

PolarPoint returns an array. You cannot assign to a static array. Dynamic arrays can assign. If the declaration is to a dynamic array with the correct type Double it still works (in my version.)

Dim polarPnt() As Double

Advertisements

If Euclid had Autocad

The 2300 year old geometry primer begins with definitions for point, line and plane surface establishing these concepts which will be used virtually unchanged even in modern cad applications. A point has no parts, it says. Later geometers will add it only has position but no dimension. A line has only length, no width, only one dimension. A plane surface has both length and width, two dimensions. 17th century mathematicians added XYZ variables to locate position. Euclid constructed, stated (“I say that…”), and proved elementary facts of geometry by starting with the most basic usable definitions and with virtual or real tools of straightedge and compass, that only allowed lines and circles to be constructed, made a textbook of geometry theorems that all depend on previous constructions for the proof of their canonic accuracy. His very first theorem constructs an equilateral triangle, a triangle with all sides and all angles equal, from a single random line.

Euclid has been criticized by moderns because he included no previous definition, postulate or axiom that two circles overlapping intersect in a single point. I thought finding that intersection point would be the hardest part of programming it, but there is a dedicated method, Intersectwith, for nearly every autocad object which returns a single dimension array of x, y and z values for all intersections. Here I just choose the first one. I use a random number generator to create the seed line.


Sub prime_pr1()
'given lineAB call proposition1
Connect_Acad

Dim ptA(0 To 2) As Double
Dim ptB(0 To 2) As Double
Dim Ax As Double, Ay As Double
Dim Bx As Double, By As Double

Ax = rnddbl(0, 10)
Ay = rnddbl(0, 10)
Bx = rnddbl(11, 20)
By = rnddbl(0, 10)

Call pt(ptA, Ax, Ay, 0)
Call pt(ptB, Bx, By, 0)
   
   Call pr1(ptA, ptB)
acadApp.Update
End Sub


Sub pr1(ptA() As Double, ptB() As Double)
Dim lineAB As AcadLine, lineAC As AcadLine, lineBC As AcadLine
Dim circD As AcadCircle, circE As AcadCircle
Dim ptC(0 To 2) As Double

Dim r As Double
Dim intpts As Variant

Set lineAB = acadDoc.ModelSpace.AddLine(ptA, ptB)

r = distance(ptA, ptB)
Set circD = acadDoc.ModelSpace.AddCircle(ptA, r)

r = distance(ptB, ptA)
Set circE = acadDoc.ModelSpace.AddCircle(ptB, r)

intpts = circD.IntersectWith(circE, acExtendNone)
Call intpts_eval(intpts)

'going to take positive y value
'keeps traditional illustrations upright
    If ptG1(1) > ptG2(1) Then
ptC(0) = ptG1(0)
ptC(1) = ptG1(1)
ptC(2) = ptG1(2)
    Else
ptC(0) = ptG2(0)
ptC(1) = ptG2(1)
ptC(2) = ptG2(2)
    End If

Set lineAC = acadDoc.ModelSpace.AddLine(ptA, ptC)
Set lineBC = acadDoc.ModelSpace.AddLine(ptB, ptC)

End Sub



helper functions


Option Explicit

Public num_int_pts As Integer

Public ptG1(0 To 2) As Double
Public ptG2(0 To 2) As Double

'to evaluate the output array of the Intersectwith method
'loads up to two points in a global variable
'the calling program has to decide which one to use
'the core loop here taken directly out of autocad vba help for Intersectwith method
Sub intpts_eval(intpts As Variant)
 Dim i As Integer, j As Integer, k As Integer
    Dim str As String

If VarType(intpts) <> vbEmpty Then
        For i = LBound(intpts) To UBound(intpts)
            str = "Intersection Point[" & k & "] is: " & intpts(j) & "," & intpts(j + 1) & "," & intpts(j + 2)
            Debug.Print str
            str = ""
            i = i + 2
            j = j + 3
            k = k + 1
        Next
    End If
    
    Debug.Print LBound(intpts)
    Debug.Print UBound(intpts)
    
  'global var
  num_int_pts = k
  
  Select Case k
  Case Is = 0
  ptG1(0) = 0: ptG1(1) = 0: ptG1(2) = 0
  ptG2(0) = 0: ptG2(1) = 0: ptG2(2) = 0
  
  Case Is = 1
  Call pt(ptG1, (intpts(0)), (intpts(1)), (intpts(2)))
  ptG2(0) = 0: ptG2(1) = 0: ptG2(2) = 0
    
  Case Is = 2
  Call pt(ptG1, (intpts(0)), (intpts(1)), (intpts(2)))
  Call pt(ptG2, (intpts(3)), (intpts(4)), (intpts(5)))
 
  Case Is > 2
    MsgBox "thats a lot of points"
 End Select
End Sub


Sub pt(ByRef ptn() As Double, x As Double, y As Double, z As Double)
ptn(0) = x: ptn(1) = y: ptn(2) = z
End Sub

Function rnddbl(upr As Double, lwr As Double) As Double
Randomize
rnddbl = CDbl((upr - lwr + 1) * Rnd + lwr)
End Function

' straight out of autocad vba help
' Calculate distance between two points
Function distance(sp As Variant, ep As Variant) As Double
  Dim x As Double
  Dim y As Double
  Dim z As Double
  x = sp(0) - ep(0)
  y = sp(1) - ep(1)
  z = sp(2) - ep(2)

  distance = Sqr((Sqr((x ^ 2) + (y ^ 2)) ^ 2) + (z ^ 2))
End Function