Euclid Book 1 Proposition 3

Proposition 3 looks simple, but it uses Proposition 2 which uses Proposition 1. Prop 3 is in turn used by many other Propositions through the entire work.

For debugging it was handy to have a consistent not random pair of given lines, so I made a definite parameter start procedure, selected to look similar to the traditional start points.

Sub prime_pr3()
'given two unequal lines AB and GH
Connect_Acad

Dim ptA(0 To 2) As Double
Dim ptB(0 To 2) As Double
Dim ptG(0 To 2) As Double
Dim ptH(0 To 2) As Double

Dim Ax As Double, Ay As Double
Dim Bx As Double, By As Double
Dim Gx As Double, Gy As Double
Dim Hx As Double, Hy As Double

Ax = rnddbl(0, 5)
Ay = rnddbl(0, 5)
Bx = rnddbl(15, 25)
By = rnddbl(0, 10)
Hx = rnddbl(-5, 0)
Hy = rnddbl(12, 18)
Gx = rnddbl(5, 5)
Gy = rnddbl(12, 18)

Call pt(ptA, Ax, Ay, 0)
Call pt(ptB, Bx, By, 0)
Call pt(ptG, Gx, Gy, 0)
Call pt(ptH, Hx, Hy, 0)

Call pr3_sub(ptA, ptB, ptG, ptH)
    
    acadApp.Update
End Sub


Sub pump_pr3()
'hardwiring two unequal lines AB and GH
Connect_Acad

Dim ptA(0 To 2) As Double
Dim ptB(0 To 2) As Double
Dim ptG(0 To 2) As Double
Dim ptH(0 To 2) As Double

Call pt(ptA, 1, 1, 0)
Call pt(ptB, 10, 2, 0)
Call pt(ptG, 3, 8, 0)
Call pt(ptH, -3, 9, 0)

Call pr3_sub(ptA, ptB, ptG, ptH)
    
    acadApp.Update
End Sub


Sub pr3_sub(ptA() As Double, ptB() As Double, ptG() As Double, ptH() As Double)

Dim lineAB As AcadLine, lineGH As AcadLine
Dim lineAH As AcadLine
Dim lineAE As AcadLine, lineEB As AcadLine
Dim lineAD As AcadLine
Dim circF As AcadCircle

Dim r As Double
Dim intpts As Variant

Dim ptD(0 To 2) As Double
Dim ptE(0 To 2) As Double

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

'i copied sub for prop2 and only added object deletes
'at the bottom otherwise this is same as pr2
'pr2 calls its own pr1
Call pr3_pr2_sub(ptA, ptG, ptH)

 'vertex found
ptD(0) = ptG1(0)
ptD(1) = ptG1(1)
ptD(2) = ptG1(2)

r = distance(ptA, ptD)
Set circF = acadDoc.ModelSpace.AddCircle(ptA, r)

intpts = lineAB.IntersectWith(circF, acExtendNone)
Call intpts_eval(intpts)

'should only be one
ptE(0) = intpts(0)
ptE(1) = intpts(1)
ptE(2) = intpts(2)

lineAB.Delete
'circF.Delete

Set lineAE = acadDoc.ModelSpace.AddLine(ptA, ptE)
Set lineEB = acadDoc.ModelSpace.AddLine(ptE, ptB)

'labels
Dim th As Double
th = 1#

Call txt_h("A", ptA, th)
Call txt_h("B", ptB, th)
Call txt_h("D", ptD, th)
Call txt_h("E", ptE, th)

End Sub
Advertisements

Euclid Book 1 Proposition 2

Euclid’s 2nd proposition draws a line at point A equal in length to a line BC. It uses proposition 1 and is used by proposition 3. I tried to make a generic program I could use for both the primary job of illustrating the theorem and for the purpose of being used by subsequent theorems, but it is simpler to separate those into two sub procedures. The programming was pretty easy except when a line is extended to meet a circle, there are two intersections, and one of them has to be selected. A good illustration with labeled objects helps keep it straight.

In autocad 1-2 is not a problem. The solution would be to copy or move the line endpoint to endpoint. In Euclid, lines cannot be moved. The compass cannot be used to transfer a distance by being picked up off the page. In autocad items are rigid. When two objects the same are copied to the same location they exactly coincide. Euclid’s 4th Axiom is “Things that coincide with one another are equal to one another”. This has caused remarks as to its real meaning. If you cannot move an object to super-impose, how would you know, and even if you could move them, no physical object will perfectly cover another. This common belief, things that are the same coincide, is intended to point to ideal form, like we have in a cad program.

Sub prime_pr2()
'given ptA and lineBC call proposition2
Connect_Acad

Dim ptA(0 To 2) As Double
Dim ptB(0 To 2) As Double
Dim ptC(0 To 2) As Double

Dim Ax As Double, Ay As Double
Dim Bx As Double, By As Double
Dim Cx As Double, Cy As Double

Ax = rnddbl(0, 5)
Ay = rnddbl(0, 5)
Bx = rnddbl(6, 10)
By = rnddbl(0, 10)
Cx = rnddbl(6, 20)
Cy = rnddbl(15, 25)

Call pt(ptA, Ax, Ay, 0)
Call pt(ptB, Bx, By, 0)
Call pt(ptC, Cx, Cy, 0)

    Call pr2(ptA, ptB, ptC)
acadApp.Update
End Sub


Sub pr2(ptA() As Double, ptB() As Double, ptC() As Double)

Dim lineBC As AcadLine
Dim lineAB As AcadLine, lineAD As AcadLine, lineBD As AcadLine
Dim lineAL As AcadLine, lineBG As AcadLine
Dim circH As AcadCircle, circK As AcadCircle

Dim r As Double
Dim intpts As Variant

Dim ptD(0 To 2) As Double
Dim ptG(0 To 2) As Double
Dim ptL(0 To 2) As Double

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

'now we need Euclid 1-1 to draw equilateral triangle
Call pr2_pr1_sub(ptA, ptB)

 'vertex found
ptD(0) = ptG1(0)
ptD(1) = ptG1(1)
ptD(2) = ptG1(2)

Set lineAD = acadDoc.ModelSpace.AddLine(ptA, ptD)
Set lineBD = acadDoc.ModelSpace.AddLine(ptB, ptD)

 'find ptG, do lineBG
r = distance(ptB, ptC)
Set circH = acadDoc.ModelSpace.AddCircle(ptB, r)
intpts = lineBD.IntersectWith(circH, acExtendThisEntity)
Call intpts_eval(intpts)

'want ptG intersection farthest from ptD
If distance(ptD, ptG1) > distance(ptD, ptG2) Then
ptG(0) = ptG1(0)
ptG(1) = ptG1(1)
ptG(2) = ptG1(2)

Else
ptG(0) = ptG2(0)
ptG(1) = ptG2(1)
ptG(2) = ptG2(2)
End If

Set lineBG = acadDoc.ModelSpace.AddLine(ptB, ptG)

 'now find ptL, do lineAL
r = distance(ptD, ptG)
Set circK = acadDoc.ModelSpace.AddCircle(ptD, r)

intpts = lineAD.IntersectWith(circK, acExtendThisEntity)
Call intpts_eval(intpts)

'going to take the lesser y value
If ptG1(1) > ptG2(1) Then
ptG1(0) = ptG2(0)
ptG1(1) = ptG2(1)
ptG1(2) = ptG2(2)
End If

ptL(0) = ptG1(0)
ptL(1) = ptG1(1)
ptL(2) = ptG1(2)

Set lineAL = acadDoc.ModelSpace.AddLine(ptA, ptL)

'ptG1 is same as ptL
End Sub


Sub pr2_pr1_sub(ptA() As Double, ptB() As Double)
'just the bare necessities - no drawing - calculate vertex
Dim circD As AcadCircle, circE As AcadCircle

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

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

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

'going to take positive y value
'this is how i am passing back found vertex
If ptG2(1) > ptG1(1) Then
ptG1(0) = ptG2(0)
ptG1(1) = ptG2(1)
ptG1(2) = ptG2(2)
End If

circD.Delete
circE.Delete

End Sub

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

DimStyles and TextStyles

Dimstyles are a collection. Each dimstyle object is itself a collection of 78 variables (at least) that are not visible in VBA. They can be set through the setvariable method of the activedocument, but I dont think there is any way to survey for them except through the autocad interface. Typing -Dimstyle at the command line (with a dash) brings up the command line version with a Variables option. Type V, then type STANDARD to get a nice screen list of every variable and its value in the STANDARD style. I cut and pasted this to a text editor capable of column mode, then eventually pasted it into a visual basic module for the purpose of using it to make a new dimension style. It looked better in the text editor. this is HTML which eliminates extra spaces. So you get a screenshot. This is Autocad 2018.

The STANDARD dimstyle is the default. Creating a new dimstyle in VBA with AcadDoc.DimStyles.Add(“my_new_name”) creates a copy of the intrinsic standard, the same settings STANDARD is made from. The settings desired are then made by changing the current variables in the activedrawing, then using Dimstyle.CopyFrom method to load all current dim variables into the Dimstyle object. So that means we dont have to rewrite all these values. We create a new clean style, its our only option, we run a list of AcadDoc.Setvariable “DIMXXX” changes we want to use, and then we run the CopyFrom method.

I looked at some Dimstyles I use and came up with a list to vary the standard to an Inch style i use, then having worked out those variables, i saw that my feet style only changed 3 of the Inch variables. So these can be run incrementally. If i want Feet, i run Inches then Feet over the top of it. Similarly Decimal only changes 2 variables from Feet.

The dimension textstyle and dimscale used vary as needed. We want to be able to change them at will.

here are the “scripts” to change variables, with textstyle and dimscale removed. Everything not shown will be the same as the Standard. The details are subject to change.

 Sub dim_inch()
 '  acadDoc.setvariable "DIMSCALE", 1#                    '  Overall scale factor"
 '  acadDoc.setvariable "DIMTXSTY", "Standard"            '  Text style"
  acadDoc.setvariable "DIMLUNIT", 5                      '  Linear unit format"
  acadDoc.setvariable "DIMFRAC", 1                       '  Fraction format"
 
  acadDoc.setvariable "DIMTXT", 0.125                    '  Text height"
  acadDoc.setvariable "DIMASZ", 0.09375                  '  Arrow size"
  
  acadDoc.setvariable "DIMCLRT", 7                       '  Dimension text color

  acadDoc.setvariable "DIMTAD", 1                        '  Place text above the dimension line"
  acadDoc.setvariable "DIMTOH", 0                        '  Text outside horizontal"
  acadDoc.setvariable "DIMTIH", 0                        '  Text inside extensions is horizontal"
  acadDoc.setvariable "DIMTOFL", 1                       '  Force line inside extension lines"
  acadDoc.setvariable "DIMTIX", 1                        '  Place text inside extensions"
 
  acadDoc.setvariable "DIMTMOVE", 2                      '  Text movement - dont move the line"
  acadDoc.setvariable "DIMEXE", 0.0625                   '  Extension above dimension line"
 End Sub
 
 
 Sub dim_feet()
  acadDoc.setvariable "DIMLUNIT", 4                      '  Linear unit format"
  acadDoc.setvariable "DIMFRAC", 2                       '  Fraction format"
  acadDoc.setvariable "DIMZIN", 3                       '  Zero suppression"
 End Sub
 
 
 Sub dim_decimal()
  acadDoc.setvariable "DIMLUNIT", 2                      '  Linear unit format"
  acadDoc.setvariable "DIMADEC", 1                      '  Angular decimal places
 End Sub

For this approach, i want the dimstyle to use whatever textstyle is current. I want to tell it the dimscale and the textstyle. Textstyles are made very similar to Dimstyles. They are a collection, a new name is added that has default settings, the settings are changed. They dont have many settings. When programming you mostly need to keep the user supplied name mentally separate from the official system font name. usually they are the same or similar, but the font system name has to be given exactly. its helpful to look at the GetFont method first to see what the values are that autocad returns for the settings of textstyles set up through the interface Styles dialog.

Sub getfont()
Connect_Acad
Dim styles As AcadTextStyles
Dim style As AcadTextStyle
Set styles = acadDoc.TextStyles

Dim strtypeface As String
Dim bold As Boolean, italic As Boolean
Dim lngchar As Long, lngpitch As Long

For Each style In styles
    style.getfont strtypeface, bold, italic, lngchar, lngpitch

    Debug.Print style.Name    'user supplied name in the list box of the style dialog
    Debug.Print style.fontFile  'actual file name not shown in style dialog
    Debug.Print strtypeface     'font name dropdown box in style dialog
    Debug.Print bold
    Debug.Print italic
    Debug.Print lngchar
    Debug.Print lngpitch
    Debug.Print
Next
End Sub

Once that is clear, you can send the same values you see in the Debug (Immediate) window. TextStyles.Add(“usernamehere”) will add any name you choose, but the typeface name must be as you see in the Autocad Style Dialog Font Name pulldown box.

Sub new_textstyle(str_stylename As String, str_typeface As String)

    Dim bold As Boolean, italic As Boolean
    Dim lngchar As Long, lngpitch As Long
    lngchar = 0
    lngpitch = 34 'i am sure this is not meaningless but this is typ(swiss 32 variable 2)
    bold = False
    italic = False
     
    Dim TextStyles As AcadTextStyles
    Dim curStyle As AcadTextStyle
    Dim newStyle As AcadTextStyle

    Set curStyle = acadDoc.ActiveTextStyle
    Set TextStyles = acadDoc.TextStyles
    
    Set newStyle = TextStyles.Add(str_stylename)
    acadDoc.ActiveTextStyle = newStyle
 
 'new style is added with no font information
 'autocad assigns defaults similar or same as standard
 
    newStyle.SetFont str_typeface, bold, italic, lngchar, lngpitch
    
    'sometimes i get a transient new style at this point
    'eliminated by the next new style unless i create actual text
End Sub

now we need the dimstyle creation that accepts parameters for the type (Inch, Feet, Decimal) and scale, using the current textstyle.
I am going to name the dimstyle according to the parameters used to make it.

Sub new_dimstyle(strname As String, strtype As String, dm As Integer)
    
    Dim style As AcadDimStyle
    Dim strdimstyle As String
    Dim strtextstyle As String
        strtextstyle = acadDoc.GetVariable("textstyle")
    
    strdimstyle = strname & "_" & strtype & "_" & dm
        
     Set style = acadDoc.DimStyles.Add(strdimstyle)
     acadDoc.ActiveDimStyle = style
     
      Select Case strtype
        Case "Inch"
        Call dim_inch
        
        Case "Feet"
        Call dim_inch
        Call dim_feet
        
        Case "Decimal"
        Call dim_inch
        Call dim_feet
        Call dim_decimal
      End Select

     acadDoc.setvariable "DIMTXSTY", strtextstyle
     acadDoc.setvariable "DIMSCALE", dm
    
    style.CopyFrom acadDoc  'the basic method for changing style contents

End Sub

and finally we can call it various ways.

Sub test_dim()
Call Connect_Acad

Call new_textstyle("Arial Narrow", "Arial Narrow")
Call new_dimstyle("ArialN", "Inch", 24)

Call new_textstyle("Technic", "Technic")
Call new_dimstyle("Technic", "Feet", 24)

Call new_textstyle("Courier", "Courier New")
Call new_dimstyle("Courier", "Decimal", 24)

End Sub

Using Move, Copy with AcadSelectionSet

Selection Sets in Autocad VBA do not contain methods to Move, Copy, Rotate, Scale, Mirror etc. The programmer has to make a For-Each loop to iterate through the Selection Set and apply the method to each individual entity one at a time. There are quite a few steps between making the selection set, populating it, then looping through its members and actually doing something to them. Breaking down these steps into small re-usable sub-procedures is the way to go.

Other than how to use them, Selection Sets have pretty good documentation not too hard to understand. The first sub-procedure makes a new clean Selection Set in the drawing. If it already exists it deletes it. Its called with a parameter name.

Sub addss(strname As String)
'adds a clean selection set
    Dim sset As AcadSelectionSet
    On Error Resume Next
    
    Set sset = acadDoc.SelectionSets.Item(strname)
    sset.Delete
    Set sset = acadDoc.SelectionSets.Add(strname)
    
    If sset Is Nothing Then
    MsgBox "unable to add " & strname & " selection set"
    End If
End Sub

In a recent program I made two kinds of selection, ALL and Window, so I made two function procedures to handle this task and return an AcadSelectionSet object. These functions call addss above. The way these work are documented and easily found with VBA ACADSelectionSets. Think of this as the second layer of abstraction, a function to make and return a set according to your selection method.

Function sset_all() As AcadSelectionSet
'returns a selection set ALL
    addss ("All_Entities")
    Set sset_all = acadDoc.SelectionSets.Item("All_Entities")
     sset_all.Select acSelectionSetAll
End Function

 Function sset_win(x1 As Double, y1 As Double, x2 As Double, y2 As Double) As AcadSelectionSet
 'returns a selection set with window selection
    Dim pt1(0 To 2) As Double
    Dim pt2(0 To 2) As Double
    
    Call initpt(pt1, x1, y1, 0)
    Call initpt(pt2, x2, y2, 0)
    
    'items not visible do not select
    acadApp.Update
    acadApp.ZoomAll

    addss ("Win_Entities")
    Set sset_win = acadDoc.SelectionSets.Item("Win_Entities")
    sset_win.Select acSelectionSetWindow, pt1, pt2
End Function

Sub initpt(ByRef ptn() As Double, val1 As Double, val2 As Double, val3 As Double)
ptn(0) = val1: ptn(1) = val2: ptn(2) = val3
End Sub

initpt is a little helper I made. You don’t need the ByRef keyword, I put it in there to remind that arrays always pass by reference. It would not work otherwise.

Now we have, when properly called, a selection set of our choosing. We want to make sub-procedures for MOVE, COPY, ROTATE, MIRROR and SCALE which accept a selection set as an argument and whatever other basic parameters required, such as a displacement for MOVE. This is the third level of abstraction. We are calling these methods with a selection set previously selected by whatever method.

Erase is the simplest case. it doesnt require a loop.

Sub erase_ss(sset As AcadSelectionSet)
    sset.Erase 'erases the autocad entities in the drawing
    sset.Delete 'deletes the selection set
    Set sset = Nothing
        'call by reference will set to nothing in calling program
End Sub

now finally here is the code to MOVE a selection set using a loop to go thru the set for each item. It takes the set itself as argument and the displacement in x and y. You can select items with either of the subs above by window or all or your program with Crossing or Filters. Deleting the selection set at the end of the routine is optional and may not always be desired, say if you wanted to move and rotate.

Sub move_ss(sset As AcadSelectionSet, x1 As Double, y1 As Double)
'x1 y1 is the displacement
    Dim objent As AcadEntity
    Dim pt0(0 To 2) As Double
    Dim pt1(0 To 2) As Double
    
    Call initpt(pt0, 0, 0, 0)
    Call initpt(pt1, x1, y1, 0)
    
    If 0 <> sset.Count Then
    For Each objent In sset
    objent.Move pt0, pt1
    Next
    End If

    sset.Delete 'deletes the selection set
    Set sset = Nothing
        'call by reference will set to nothing in calling program
End Sub

At this point these sub-procedures still do not change per program requirements. They are basic tools.
Here are mirror and scale (I have not needed COPY yet).

Sub mirror_ss(sset As AcadSelectionSet, pt1() As Double, pt2() As Double)
  'deletes old copy, pt1 pt2 are axis
    Dim objent As AcadEntity
    Dim objent_mirrored As AcadEntity

   If 0 <> sset.Count Then
    For Each objent In sset
    Set objent_mirrored = objent.Mirror(pt1, pt2)
    objent.Delete
    Next
  End If
         sset.Delete
    Set sset = Nothing
 End Sub
 
 Sub scale_ss(sset As AcadSelectionSet, x1 As Double, y1 As Double, sc As Integer)
'x1 y1 is the scale from point, sc is the scale factor
    Dim objent As AcadEntity
    Dim pt0(0 To 2) As Double
    Call initpt(pt0, x1, y1, 0)

    If 0 <> sset.Count Then
    For Each objent In sset
    objent.ScaleEntity pt0, sc
    Next
    End If
    
    acadApp.Update
    acadApp.ZoomAll

    sset.Delete 'deletes the selection set
    Set sset = Nothing
        'call by reference will set to nothing in calling program
End Sub

Now to some extent, we have hidden the loops, we don’t have to duplicate them, and we can call them with simple programs. Here are some upper level calling programs. You will need to write your own according to the method and selection you want to use.

Sub erase_all()
    Dim sset As AcadSelectionSet
    Set sset = sset_all
    Call erase_ss(sset)
End Sub

Sub move_all(x1 As Double, y1 As Double)
    Dim sset As AcadSelectionSet
    Set sset = sset_all
    Call move_ss(sset, x1, y1)
End Sub

Sub scale_w(x1 As Double, y1 As Double, x2 As Double, y2 As Double, sc As Integer)
 'scales from pt 0,0
    Dim sset As AcadSelectionSet
    Set sset = sset_win(x1, y1, x2, y2)
    Call scale_ss(sset, 0, 0, sc)
 End Sub

Sub mirror_all(pt1() As Double, pt2() As Double)
    Dim sset As AcadSelectionSet
    Set sset = sset_all
    Call mirror_ss(sset, pt1, pt2)
 End Sub

those get called rather simply by your top level, where you can see what you are doing without having to dive in to the details.

Call erase_all
Call move_all (0,20)
Call scale_w(-1, -1, 12, 9.5, sc)
Call mirror_all(vt1, vt4)

when you draw with xy data starting at the origin, this is how you move and position the piece onto your drawing assembly or border.

Excel VBA – > Autocad Basics

Microsoft “deprecated” VBA and then Autodesk made the VBA module not a part of their massive install, convincing just about everybody it was no longer a viable platform to write any code. I am not going to write code for other people if i have to go sit at their computer and download and install a 100 mb file and do it on every release of autocad. But two things happened. Microsoft recanted. There must be a million people worldwide who code VBA excel. And it was never necessary to download the VBA module for autocad to run VBA code anyway. The download is just the code editor. The VBA objects are there. The code editor in excel works fine and in fact better because excel can hold data such as parameters, bills of material and cut-lists. For a few years now I have been making it a point not to download the autocad VBA module just to make sure other people could run my programs without adding anything.

To begin writing your Autocad VBA code in excel – start excel. Most of the time you have to add the developer tab to the ribbon. That is done with the File tab, Options, Customize Ribbon. Add the Developer tab. Start the Visual Basic editor. When you save an excel file with visual basic code, save it with XLSM file extension. In the visual basic editor, important first step, you must add a reference for excel to see autocad programming objects. This is under Tools, References. Look for Autocad Type Library. Move it up in the list as high as it will go.

2018-01-28_2.jpg

now you need a standard module to connect to autocad. insert a module, add two public variables at the top.

Public acadApp As AcadApplication
Public acadDoc As AcadDocument

start your sub procedure by typing
sub connect_acad()
and hit return

generally you will want to start autocad yourself the way you always do. if autocad is running the vba code to obtain a reference to it is

Set acadApp = GetObject(, "AutoCAD.Application")

notice we use our global variable. type this in to your sub procedure. I find this works fine but most online help shows it with a version dependent string like this.

Set acadApp = GetObject(, "AutoCAD.Application.22")
22 is the version that autocad is using to designate version 2018

to demystify this, what is GetObject, why is there a comma, where does this come from, open up the Object Browser. you can double click the word GetObject, right click, and pick Definition. if you dont find it that way, search the VBA library, top box, for GetObject –

The Object Browser shows its parent, VBA.Interaction and it shows the parameter list PathName comma Class. Right click on GetObject in the Object Browser and click Help to open MS online help.

2018-01-28_5.jpg

2018-01-28_3.jpg

If Autocad is not running, GetObject will return an error. The code to start autocad in VBA is CreateObject or New AcadApplication. They both work for me, just as the version independent and dependent string both seem to work equally well.

We need to handle the error, then deal with either autocad running or not. Autodesk has the logic and a file to do it here.

https://knowledge.autodesk.com/search-result/caas/CloudHelp/cloudhelp/2018/ENU/AutoCAD-ActiveX/files/GUID-73EC319D-9D7D-43FF-91B7-78CF36284028-htm.html

this file is also in the Autodesk AutoCAD 2018: ActiveX Developer’s Guide, or whatever year you have, which is file acad_aag.chm somewhere in your autocad installation. find that and also acadauto.chm and copy them where you want them.

First we have to add the essential statement
acadApp.Visible = True
otherwise we will not see any autocad.

Autodesk has the commands and logic but not the best form. We have to make some improvements. The code to start autocad needs to be in its own sub procedure with the code to reference the active drawing. We want to call connect_acad once and we want to obtain a global variable for the active drawing.

When autocad opens, it probably opens to a blank drawing, or maybe its already open to a drawing, but we have to get that drawing into a VBA object. Generally I want it to be a blank drawing because I am going to use it. The connect_acad sub procedure will not run until we want it to, so it just gets the activedocument which is a property of AcadApplication. Those are our two global variables, the application and the active drawing, and active drawing is the main one we use.

Put connect_acad in your module as a stand-alone. Anytime you want to write a program in excel vba to draw or interact with autocad, the first thing in the program is

call connect_acad

at that point you have a global variable AcadDoc that you use for all of autocad’s vba objects.

here is the full acad_connect

Option Explicit
 
 Public acadApp As AcadApplication
 Public acadDoc As AcadDocument
 
 
 Sub Connect_Acad()
    
    On Error Resume Next
        
    Set acadApp = Interaction.GetObject(, "AutoCAD.Application")
    'Set acadApp = Interaction.GetObject(, "AutoCAD.Application.22")
    'both statements above behave without any discernible difference
    
    If Err Then
        Debug.Print "ERROR " & Err.Number
        Debug.Print Err.Description
        Debug.Print "starting autocad"
                
        Err.Clear
                      
         Set acadApp = New AcadApplication
         'Set acadApp = Interaction.CreateObject("AutoCAD.Application.22")
         'both statements above behave without any discernible difference
        
        'essential statement
        acadApp.Visible = True
        
        If Err Then
             MsgBox Err.Description
             Exit Sub
        End If
    End If
    
    Debug.Print "Now running " + acadApp.Name + " version " + acadApp.Version
         
    Set acadDoc = acadApp.ActiveDocument
        If acadDoc Is Nothing Then
            Set acadDoc = acadApp.Documents.Add
        End If
  
    If acadDoc.ActiveSpace = 0 Then
       acadDoc.ActiveSpace = 1
    End If
   
End Sub

in bricscad, try these (i dont have bricscad loaded currently but these worked a couple releases back)

Set acadApp = GetObject(, "BricscadApp.AcadApplication")

Set acadApp = New AcadApplication

using autodesk’s example to draw a single line would be modified like this. I made no other changes except adding connect_acad

Sub testline()

Call Connect_Acad

Dim lineObj As AcadLine
Dim startPoint(0 To 2) As Double
Dim endPoint(0 To 2) As Double
startPoint(0) = 1
startPoint(1) = 1
startPoint(2) = 0
endPoint(0) = 5
endPoint(1) = 5
endPoint(2) = 0

Set lineObj = acadDoc.ModelSpace.AddLine(startPoint, endPoint)
ZoomAll

End Sub

Using this method, any code on autodesk help website that uses Thisdrawing.object can be run from excel by adding connect_acad at the top and replacing the word Thisdrawing with AcadDoc.

Specific method for parametric drawing programs

The hard part of coding parametric drawing program whether in lisp or VBA is managing the large number of points. The program turns into many lines of hard to read data apparently randomly named. A sketch has to be made with points labeled and equations or formulas entered. It all might make sense during the coding, but probably won’t a few weeks later when a change has to be made even if the sketch(s) is found. It won’t be obvious how the points are calculated or why lines are drawn from pt7 to pt21 to pt3. There is no one right way but I have recently worked on both lisp and vba programs and have some specific but not comprehensive suggestions. This is a special theory for creating the xy data but not a general theory for the entire program.

There are two basic ways to manage your drawing subroutine. It can accept points or xy data. Try both ways. Both methods need xy data.

In Lisp I use Visual Lisp objects rather than the “command” method. The object method can draw directly in to a block definition, and it can directly change the layer property. It requires a point object, but that can be created and passed as a parameter or the xy data can be passed and the point created in the subroutine.

For lisp I made a point creation routine and passed points to the subroutine which runs the Addline method.

(defun pt ( x y ) (vlax-3d-point x y 0))

In a very simple box example this gets called as

(setq pt1 (pt 0 0) pt2 (pt L 0) pt3 (pt L W) pt4 (pt 0 W))

Then the line routine would be

(defun linep (pt1 pt2 obj lyr / lineobj)
(setq lineobj (vla-AddLine obj pt1 pt2))
(vla-put-layer lineobj lyr) )

And be called as

(linep pt1 pt2 ms "hidden")

Or you could pass xy data

(defun line (x1 y1 x2 y2 obj lyr / pt1 pt2 lineobj)
(setq pt1 (vlax-3d-point x1 y1 0)
pt2 (vlax-3d-point x2 y2 0))
(setq lineobj (vla-AddLine obj pt1 pt2))
(vla-put-layer lineobj lyr) )

In VBA every variable has to be declared previous to use, so you might lean towards passing xy data. Assume you want to draw a notched rectangle and make it a polyline. You make a sub specifically for this purpose. After setting the xy data coordinates, any six vertex closed polyline can be drawn with

Call p6_box(x1, y1, x2, y1, x2, y2, x3, y2, x3, y3, x1, y3)

Sub p6_box(p1 As Double, p2 As Double, p3 As Double, p4 As Double, p5 As Double, p6 As Double, _
p7 As Double, p8 As Double, p9 As Double, p10 As Double, p11 As Double, p12 As Double)

Dim objent As AcadLWPolyline
Dim pt(0 To 11) As Double
pt(0) = p1: pt(1) = p2
pt(2) = p3: pt(3) = p4
pt(4) = p5: pt(5) = p6
pt(6) = p7: pt(7) = p8
pt(8) = p9: pt(9) = p10
pt(10) = p11: pt(11) = p12
Set objent = acadDoc.ModelSpace.AddLightWeightPolyline(pt)
objent.Closed = True
Set obj_Acad_Entity = objent
End Sub

This makes no sense without a sketch but the sub p6_box can draw any closed polyline with 6 points configured any way you need it.

2018-01-13_2.jpg

Our notched box is L X W with an A X B notch, drawn with the lower left corner at 0,0. There are 3 X coordinates and 3 Y coordinates.
X1=0 , X2=L-B , X3=L
Y1=0 , Y2=A , Y3=W

You can turn this box around any way you wish, move the notch to the middle, put a hole in the middle. Just label xy coordinates as needed in order from the origin. This is how you organize your xy data without duplication in a straightforward way. Sometimes its convenient to also label points, sometimes its not required, but the xy data must always be figured from the parameters as the first step.

In VBA we would probably draw in counterclockwise order.

Call p6_box(x1, y1, x2, y1, x2, y2, x3, y2, x3, y3, x1, y3)

Now it should make sense. The xydata starts at the origin. Subroutines can be written so declared point variables are not required, or required. If you have a lot of sub-routines, just declare your x1, x2, etc as public to avoid re-declaring.

In programming 101 they strongly suggest that your subroutines be simple and single purpose. Just about every autocad parametric program I have seen or written has been a mess at the actual geometry creation level. For instance in this example, the parameters A and B, L and W may need to have complicated formulas behind them. Put those upstream of the actual sub-routine that draws the geometry. Make the geometry creation as simple as possible. Pass the actual parameters if possible, do not develop them. Interface is top down thinking, but geometry is bottom up.
Such as

Sub draw_notch_box(W As Double, L As Double, A As Double, B As Double)
x1 = 0
x2 = L - B
x3 = L
y1 = 0
y2 = A
y3 = W
Call p6_box(x1, y1, x2, y1, x2, y2, x3, y2, x3, y3, x1, y3)
End Sub

You will be able to read that next year if you remember that xy data starts at the origin.