XY Axis – Blocks – Part 3

Blocks are a fundamental object in Autocad – a collection of drawing entities that can be copied, moved, or scaled as one unit. The Block is the definition, the group of entities, and the specific instance is the BlockReference. The collection of blocks is the parent object and it has the typical methods Add, Count and Item. Generally the Add method creates the block and returns the handle that the program uses. The Item method is also used to return a handle of an existing block in the drawing to the program object.

If a block name does not exist and you try to reference you will get an error. If a block does exist and you try to add it you will not get an error but get a reference to the existing block.

To create a new block

On Error Resume Next
Dim objBlock As AcadBlock
Set objBlock = acadDoc.Blocks.Item(strname)
‘returns a silent error if block does not exist
objBlock.Delete
On Error GoTo 0
‘at this point we are sure the block does not exist
Set objBlock = acadDoc.Blocks.Add(pt0, strname)

the help
Blocks Collection
Blocks Property
Block Object

once a block is created, you can draw directly in the block, just as you draw in model space. all of these work.

objBlock.AddLine pt1, pt2
acadDoc.ModelSpace.AddLine pt2, pt3
Set lineobj = objBlock.AddLine(pt1, pt2)
Set lineobj = acadDoc.ModelSpace.AddLine(pt2, pt3)

running this in a new drawing with no blocks available to insert
Dim objblk As AcadBlock
Dim objblks As AcadBlocks
Set objblks = acadDoc.Blocks
For Each objblk In objblks
Debug.Print objblk.Name
Next

will print this to the immediate window.
*Model_Space
*Paper_Space
*Paper_Space0

Autocad Object Model

Block, ModelSpace, and PaperSpace all directly reference the geometry commands.

However, to populate a block with the contents of a selection set, there is a method which copies an array of autocad objects directly into a block, the Document CopyObjects method.

Dim Obj() As AcadObject
ReDim Obj(sset.Count - 1)
'Copy each object in the selection set into the array of acad objects
'which is the format required by CopyObjects
For i = 0 To sset.Count - 1
Set Obj(i) = sset(i)
Next i
acadDoc.CopyObjects Obj, objBlock

the full and no doubt not final XY Axis routine. The final routine will take data from a user form and that will suggest other code additions.

Public g_sset As AcadSelectionSet
Const pi As Double = 3.14159265359

Sub draw_std_axis()
Call draw_xy_axis(-12, 12, 1, 0.5, -12, 12, 1, 0.5, "std_xy_axis")
End Sub

Sub draw_trig_axis()
Call draw_xy_axis(-pi * 2, pi * 2, pi / 4, pi / 8, -6, 6, 1, 0.25, "trig_xy_axis")
End Sub
Sub draw_xy_axis(Xmin As Double, Xmax As Double, Xscl As Double, Xtick As Double, _
                 Ymin As Double, Ymax As Double, Yscl As Double, Ytick As Double, _
                 strblkname As String)
'starts a new clean selection set
'and initializes a global var so all subroutines can use it
Call add_ss(strblkname)
Set g_sset = acadDoc.SelectionSets.Item(strblkname)

Call x_axis(Xmin, Xmax, Xscl, Xtick)
Call y_axis(Ymin, Ymax, Yscl, Ytick)

Call makeblk(g_sset, strblkname)
g_sset.Erase
g_sset.Delete
acadDoc.ModelSpace.InsertBlock pt0, strblkname, 1, 1, 1, 0

Update
Call get_axis_extents
End Sub

Sub x_axis(Xmin As Double, Xmax As Double, Xscl As Double, Xtick As Double)
Dim X As Double
Dim i As Integer, numpts As Integer

numpts = (Xmax - Xmin) / Xscl 'this is the number of line segments
numpts = numpts + 1  'there is always one more pt than line segment
Call line(Xmin, 0, Xmax, 0)
g_sset.Select acSelectionSetLast

For i = 1 To numpts
X = Xmin + ((i - 1) * Xscl)
If X <> 0 Then
Call draw_x_tick(X, Xtick)
g_sset.Select acSelectionSetLast
End If
Next i

Update
End Sub

Sub y_axis(Ymin As Double, Ymax As Double, Yscl As Double, Ytick As Double)
Dim Y As Double
Dim i As Integer, numpts As Integer

numpts = (Ymax - Ymin) / Yscl
numpts = numpts + 1
Call line(0, Ymin, 0, Ymax)
g_sset.Select acSelectionSetLast

For i = 1 To numpts
Y = Ymin + ((i - 1) * Yscl)
If Y <> 0 Then
Call draw_y_tick(Y, Ytick)
g_sset.Select acSelectionSetLast
End If
Next i
Update

End Sub

Sub line(p1 As Double, p2 As Double, p3 As Double, p4 As Double)
'a line wrapper to draw a line with one line of code
' call line (2,3,5,6)
Dim lineobj As AcadLine
Dim pt1(0 To 2) As Double, pt2(0 To 2) As Double
pt1(0) = p1: pt1(1) = p2: pt1(2) = 0
pt2(0) = p3: pt2(1) = p4: pt2(2) = 0
Set lineobj = acadDoc.ModelSpace.AddLine(pt1, pt2)
End Sub

Sub draw_x_tick(X As Double, Xtick As Double)
'line from (X, 0-Xtick/2) to (X, 0+Xtick/2)
Dim lineobj As AcadLine
Dim pt1(0 To 2) As Double, pt2(0 To 2) As Double

pt1(0) = X: pt1(1) = -Xtick / 2: pt1(2) = 0
pt2(0) = X: pt2(1) = Xtick / 2: pt2(2) = 0
Set lineobj = acadApp.ActiveDocument.ModelSpace.AddLine(pt1, pt2)
End Sub

Sub draw_y_tick(Y As Double, Ytick As Double)
'line from (0-Ytick/2,y) to (0+Ytick/2,y)
Dim lineobj As AcadLine
Dim pt1(0 To 2) As Double
Dim pt2(0 To 2) As Double

pt1(0) = -Ytick / 2: pt1(1) = Y: pt1(2) = 0
pt2(0) = Ytick / 2: pt2(1) = Y: pt2(2) = 0
Set lineobj = acadApp.ActiveDocument.ModelSpace.AddLine(pt1, pt2)
End Sub

Sub add_ss(strname As String)
'adds a new empty named selection set
Dim s_set As AcadSelectionSet

On Error Resume Next
Set s_set = acadDoc.SelectionSets.Item(strname)
s_set.Clear
s_set.Delete
On Error GoTo 0

Set s_set = acadDoc.SelectionSets.Add(strname)
End Sub

Sub makeblk(sset As AcadSelectionSet, strname As String)
Dim i As Integer
Dim blockdef As AcadBlock

On Error Resume Next
Set blockdef = acadDoc.Blocks.Item(strname)
blockdef.Delete
On Error GoTo 0

Set blockdef = acadDoc.Blocks.Add(pt0, strname)

Dim Obj() As AcadObject
ReDim Obj(sset.Count - 1)
'Copy each object selected in the block
For i = 0 To sset.Count - 1
Set Obj(i) = sset(i)
Next i
acadDoc.CopyObjects Obj, blockdef

End Sub

Advertisements

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 )

Twitter picture

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

Facebook photo

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

Google+ photo

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

Connecting to %s