area 31

Autodesk Labs

2006-09-22T08:37:00.000-05:00

Ever wondered what Autodesk is doing between releases? Check out the Autodesk Labs site to have a sneak peek at what might be coming in the next release. The feature recognition function looks very promising.

Error 1406 During Install - A Better Solution

2006-04-07T08:16:00.000-05:00

Autodesk has come up with a simple solution to the 1406 error that's been annoying many Autodesk customers lately.

Early in the installation of Autodesk Inventor products, some customers may experience Error 1406:

This error occurs if you have Macromedia Flash Player 8a installed on your system. Flash Player 8a was just recently released, so it is newer than version 8 that gets installed by Autodesk Inventor. You may already have version 8a without knowing.

You should uninstall Flash Player 8a before installing Autodesk Inventor. Since Autodesk Inventor automatically installs Flash Player 8 during installation; you will always have a working version of Flash Player. Future upgrades to Flash Player should not adversely affect your Autodesk Inventor environment.

Please complete the following if you encounter this error:

Cancel the installation of Autodesk Inventor
Close all Internet Explorer and other internet browsers
Run C:\WINDOWS\system32\Macromed\Flash\UninstFl.exe to clean all Flash 8a registries
Remove Macromedia Flash Player 8 from Add/remove programs
Note: Although Flash Player 8 is listed, this is really version 8a
Retry installation of Autodesk Inventor

If you are not successful in completing the above steps, please contact Product Support for further assistance.

...thanks Adobe.

Error 1406 During Install

2006-04-04T11:11:00.000-05:00

I've had a number of customers contact me lately about errors during new product installs and updates. The error they are receiving is 1406. Initially, Autodesk had no clue what was going on and kept directing me to the Microsoft MSDN article(link)

Seems there's a bit of a bug in the Macromedia Flash player used in the install screen of Autodesk applications. Macromedia is apparently working on it but there is no known fix yet. Two methods I have found that have fairly good results are as follows:

1. If you get a 1406 error message when installing Inventor, keep hitting 'Ignore' when installing and the install will complete. Start Inventor and if the Content Center is broken or not there at all, do a Repair install from the Add/Remove Programs screen. One customer has had success with this method.

2. The preferred method is listed below and was sent to me from Autodesk Support:

We have seen a rash of 1406 errors recently.

We have noticed that there could be a mistake in the permissions for this registry key; on the affected computers the group 'Everyone' has special permissions: they are DENIED for Read en Change.
-Administrators have full control but the 'denied' rights are higher in level, so the administrator is denied.
-Also on other similar registry keys we don't see the 'everyone, special permissions'.
If you change the permissions of the folder (for this registry key) for this user group (everyone) to 'Full Control' the problem is solved; you can click retry and the installation continues until the next error (you receive 3 errors in total).

Example of affected registry keys:

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\{D27CDB70-AE6D-11cf-96B8-444553540000}] :@="Macromedia Flash Factory Object" and [HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\{1171A62F-05D2-11D1-83FC-00A0C9089C5A}] :@="FlashProp Class"

If I get a more definitive answer I will update this article.

CAD Insider

2006-04-01T06:56:00.000-05:00

Roopinder Tara, the Editor of TenLinks has started a CAD blog entitled CAD Insider. The name fits pretty well too, I don't know anyone that has access to more CAD related news than Roopinder. Be sure to check it out.

Inventor 10 Super-clean Un-install

2006-03-14T20:06:00.000-05:00

Platform: Inventor 10

With Inventor 11 right around the corner, I thought I'd post a step-by-step list of things required to properly remove Inventor 10. Now, I'm not suggesting you move to Inventor 11 as soon as it comes out. Most people wait for the first service pack but having a clean computer is a great starting point.

To do a super-clean un-install try the following. You will lose any customization you've made as deleting the registry keys removes all traces of the Inventor program except for the licensing:

Un-install "Autodesk Inventor10" using Add/Remove programs
Un-install "Microsoft SQL Server Desktop Engine (INVENTORCONTENT)" using Add/Remove programs
Delete the "Inventor 10" folder
Delete the C:\Program Files\Microsoft SQL Server\MSSQL$INVENTORCONTENT folder
Empty your "Temp" folder
Go to Start-->Programs-->Run-->type Regedit
Delete the folder HKEY_CURRENT_USER\Software\Autodesk\Inventor\RegistryVersion10.0
Delete the folder HKEY_LOCAL_MACHINE\SOFTWARE\Autodesk\Inventor\RegistryVersion10.0
Delete the folder HKEY_CURRENT_USER\Software\Autodesk\Inventor\Current Version
Delete the folder HKEY_LOCAL_MACHINE\SOFTWARE\Autodesk\Inventor\Current Version
Reboot
Install the version of Inventor you want, then all required hot fixes and service packs

Linking AutoCAD VBA to a VB DLL

2006-01-13T14:04:00.000-05:00

Platform: AutoCAD 2006

Platform: Required VB 6

Visual Basic for Applications (VBA) is a great tool for quick routines or even large projects that have no budget. However, if the project requires any controls that VBA does not include, like a listview, a full Visual Basic application might be required. Linking a VB application to AutoCAD is not that easy and is usually left to C++ or .Net programmers with ObjectARX.

Fortunately, we can reference a Visual Basic Dynamic Link Library (DLL) within AutoCAD VBA.

Start a Visual Basic project with the ActiveX Dll template and copy the code below into the class module.

Public Function HelloWorld() As Boolean
On Error GoTo ErrorHandler
  MsgBox "Hello World!", vbOKOnly + vbExclamation, "Hello"

  HelloWorld = True
ErrorHandler:

End Function

Rename the class module to "Sample" and rename the project to "vb2vba". Save the project as "vb2vba" as well. Compile the application as "vb2vba.dll".

In AutoCAD 2006, open the VBA Interface and add the code block below to the "ThisDrawing" module.

Public Sub ShowDialog()
' Show the Hello World message box
On Error GoTo ErrorHandler
  Dim objSample As vb2vba.Sample

  Set objSample = New vb2vba.Sample
  If Not objSample.HelloWorld = True Then Err.Raise vbObjectError + 1, , "Error calling HelloWorld from ShowDialog"

  Set objSample = Nothing

  Exit Sub
ErrorHandler:
  Set objSample = Nothing
End Sub

Click on the "Tools" menu in the VBA IDE and select "References...". Find "vb2vba" and click the check mark on.

You should now be able to run the "ShowDialog" subroutine in AutoCAD VBA. It will call the VB Dll and display a message box with the famous "Hello World!" message.

New Blog on the Block

2006-01-04T12:35:00.000-05:00

I thought I should post a quick note about a new blog some of you might be interested in. CADgneto focuses on the Autodesk mechanical products with extra emphasis on AutoCAD Electrical. CADgneto is maintained by Steve McCarthy, an Applicaitons Specialist (and coworker) with SolidCAD.

Steve usualy knows more about AutoCAD Electrical than the Autodesk support desk so he's a good reference for those annoying little quirks AutoCAD Electrical sometimes has.

How to Improve Large Assembly Performance in Autodesk Inventor®

2005-10-06T15:23:00.000-05:00

Platform: Inventor
Download: Inventor_Performance.pdf

I've been supporting Autodesk Inventor® for a while now and about seventy percent of the support calls I receive are from users having problems with 80% resource warnings or complete system crashes while working on large or very complex models.

While there is no sure-fire way to completely protect your CAD system from crashing, there are a few tips and tricks you can do to hold your system together a bit longer. If you're having problems with Inventor, download the PDF file listed above and see if some of the suggestions can help you out. This document is a work in progress and is in no way complete. If I’ve missed anything please let me know.

Add-In Versioning In Autodesk Inventor

2005-07-13T16:05:00.000-05:00

Platform: Inventor 10
Download: n/a

I've recently been developing an Add-In for Inventor to bring together all the utilities I've developed over the last few years. One of the utilities requires a new toolbar in Inventor whenever a part or assembly document is open. The API help files are pretty good but they have an issue with version skew. Page 6 of the UI Customization overview explains AddIn Versioning in depth but Page 3 of the Add-In overview doesn't have the Version entry added to the registry file example.

If you are developing an Add-In that deals with CommandBar creation or attaching buttons to a command bar listen up! The FirstTime variable will never be set to False in the ApplicationAddInServer_Activate event if you compile and run your Add-In. This means that you have ONE CHANCE to get it right.

I posted this dilemma on the Inventor customization newsgroup (http://discussion.autodesk.com/forum.jspa?forumID=120) and was quickly supplied with an answer from Sanjay Ramaswamy at Autodesk:

The FirstTime argument will be true only when your Add-In is being loaded for 
the very first time after registration. User interface items such as command 
bars & controls need to be created only during the first time and they will 
be persisted by Inventor. Please see page 6 of the UI Customization overview 
in Programming Help for a detailed explanation regarding this.

In order to work around your present situation, you can force the FirstTime 
flag to True by changing the value of the "Version" entry in your Add-In's 
registry (the same place where you set things such as LoadOnStartUp, 
SupportedSoftwareVersionEqualTo, etc. Just increment the value of the 
Version entry to 1 (and 2,3,4,.... for each time you want to change the way 
your user interface looks).

Here's a link to the full discussion thread:

http://discussion.autodesk.com/thread.jspa?threadID=415210

Here's the Registry file I'm currently using and it seems to be working just fine:

REGEDIT4

[HKEY_CLASSES_ROOT\CLSID\{57E6E593-2CAE-4016-AE01-74BB752C670E}]
@="SolidCAD ToolBox"

[HKEY_CLASSES_ROOT\CLSID\{57E6E593-2CAE-4016-AE01-74BB752C670E}\Description]
@="A collection of useful routines supplied by SolidCAD Inc."

[HKEY_CLASSES_ROOT\CLSID\{57E6E593-2CAE-4016-AE01-74BB752C670E}\Implemented Categories\{39AD2B5C-7A29-11D6-8E0A-0010B541CAA8}]

[HKEY_CLASSES_ROOT\CLSID\{57E6E593-2CAE-4016-AE01-74BB752C670E}\Required Categories]
[HKEY_CLASSES_ROOT\CLSID\{57E6E593-2CAE-4016-AE01-74BB752C670E}\Required Categories\{E357129B-DB40-11D2-B783-0060B0F159EF}]

[HKEY_CLASSES_ROOT\CLSID\{57E6E593-2CAE-4016-AE01-74BB752C670E}\Settings]
"LoadOnStartUp"="1"
"Type"="Standard"
"Version"="10"
"SupportedSoftwareVersionEqualTo"="10.."

You're really missing out on a great resource if you haven't checked out the Autodesk Discussion Groups.

Thanks again Sanjay.

Extracting All Blocks In a Drawing

2005-06-28T10:44:00.000-05:00

Platform: AutoCAD 2004-2006
Download: Extract All.zip

Well here I am after a VERY long break! I promise to be adding a few new articles in the near future, including some for Inventor.

A while ago I had the need to individually wblock out every block in a very large file, around 1500 blocks...The prospect of having to find and export every one by hand was not very appealing so I decided to whip up the bit of code below. Be sure to add all of this into a new module:

Public Function ExtractBlocks(strDestDir As String, _
                              Optional OverwriteExisting As Boolean = False) As Boolean
On Error GoTo ErrorHandler
  Dim objSS As AcadSelectionSet
  Dim objBlock As AcadBlockReference
  Dim retVal As Variant
  Dim i As Long

  ' Append backslash if required
  If Not Right(strDestDir, 1) = "\" Then strDestDir = strDestDir & "\"

  ' Create destination directory if it doesn't exist
  MakeSureDirectoryPathExists strDestDir

  ' Delete existing selection set
  For Each objSS In ThisDrawing.SelectionSets
    If StrComp(objSS.Name, "EXTRACT_BLOCKS", vbTextCompare) = 0 Then
      objSS.Delete
      Exit For
    End If
  Next

  ' Create a new selection set
  Set objSS = ThisDrawing.SelectionSets.Add("EXTRACT_BLOCKS")

  For i = 0 To ThisDrawing.ModelSpace.Count - 1
    ' Clear current selection set
    objSS.Clear

    If TypeOf ThisDrawing.ModelSpace.Item(i) Is AcadBlockReference Then
      ' PLace blockreference in the selection array
      Set objBlock = ThisDrawing.ModelSpace.Item(i)

      ' Explode the block into a variant array of entities
      retVal = objBlock.Explode

      ' Add the object into the selection set
      objSS.AddItems retVal

      ' Check to see if the file exists
      If Not Dir(strDestDir & objBlock.Name & ".dwg") = "" Then
        ' Check if we can overwrite an existing file and write if allowed
        If OverwriteExisting = True Then
          ThisDrawing.Wblock strDestDir & objBlock.Name & ".dwg", objSS
        End If
      Else
        ' Output the selection set to a new file
        ThisDrawing.Wblock strDestDir & objBlock.Name & ".dwg", objSS
      End If

      DoEvents
    End If
  Next

  ' Remove our selection set
  objSS.Delete

  Set objSS = Nothing
  Set objBlock = Nothing
  Erase retVal

  ExtractBlocks = True

  Exit Function
ErrorHandler:
  Set objSS = Nothing
  Set objBlock = Nothing
  Erase retVal
End Function

Add the following to the top of the module. It is a really neat API call that will create entire directory structures if they don't exist. For example: C:\Foo\Bar. If the following path does not exist, it will create each subdirectory as required.

Public Declare Function MakeSureDirectoryPathExists Lib "IMAGEHLP.DLL" (ByVal DirPath As String) As Long

Be sure to add in the IsDimArray function which checks to see if an array has been dimensioned before we try to clear it.

Public Function IsDimArray(arr As Variant) As Boolean
On Error GoTo ErrorHandler
  Dim i As Long

  i = UBound(arr)
  If Not i = -1 Then IsDimArray = True

  Exit Function
ErrorHandler:
  IsDimArray = False
End Function

Finally, add the following subroutine which calls the main routine. Be sure you have a drawing open that has a few blocks in it before running the ExtractAllBlocks sub.

Public Sub ExtractAllBlocks()
  If Not ExtractBlocks("C:\temp\allblocks") Then Stop
End Sub

The only real trick is exploding eahk block you find and exporting the entities in it. If we did not explode the block before writing it ou, we end up with a DWG file that has a block inside of it with the same name as the file...and this can not be inserted into another file.

Extracting a BOM from blocks

2005-03-03T18:34:00.000-05:00

Platform: AutoCAD 2004
Download: ExtractBOM.zip

Creating and maintaining Bill of Material lists or BOMs have always been a tedious task in AutoCAD. Many of the Autodesk vertical products (Mechanical, MDT, Inventor) have inherent tools to help but if you're stuck with vanilla AutoCAD like me, you know the pain and suffering involved in creating an accurate BOM list.

The company I currently work for has instituted the standard of blocking every item in their assembly drawings with intelligent names; this really speeds up the detailer's jobs and allows for easy reuse in later projects. Most of the drawings I work with are plan-view layouts, so I only have one view to worry about. I've taken a bit of my own time and expanded on their idea, what if one could extract a first level BOM (no sub-assemblies or sub objects listed) and export it to a CSV file? CSV files are great because they open natively in Microsoft Excel without all the hassle of programming a hook into Excel. Before anyone asks, yes, I know using a collection would be quicker when searching for duplicate items but VBA has a few quirks with collections so I opted to use a for-next loop, just to be safe.

There are a couple of neat tricks in this article, for one the 'GetAttrValue' function is a nicely encapsulated function to extract a single known attribute value. Also, most people seem to miss the fact that you can search for multiple strings while creating a selection set. Simply separate each string by a comma and end each term with an asterisk wild card. For example, to search for all blocks that start with the words 'TEST' or 'HARDWARE', use the following:

CreateSelectionSet(objSS, DXF_NAME, "TEST*,HARDWARE*")

This article is far from a complete BOM solution; it simply asks you to select items on screen, extracts an item number from each block name and a description from an attribute named 'DESC'. The code for this article is quite extensive (about 260 lines) so please download it from the link above. The zip file also includes a sample drawing I whipped together to show you how it works.

Once you have the DVB extracted and loaded, open the Macros window (press Alt+F8) and run the 'CreateBOM' macro to get things started. If for some reason the macro is not showing up, go to the VBAIDE and run the CreateBOM subroutine.

Here are some thoughts for future development:

Filter out alternate views (top, side, front) of the same object

Create the BOM in the drawing instead of exporting to a CSV

Sort the BOM before exporting it to screen or file

Create the BOM as an AutoCAD table entity (AutoCAD 2005 or greater required)

If you enjoyed this article and would like to see an example of exporting the BOM to the screen, drop me a line.

Inserting Point Data into AutoCAD

2005-02-10T06:53:00.000-05:00

Platform: AutoCAD 2004
Download: InsertPointData.zip

Many times throughout my career I've been required to insert point data into AutoCAD. I've dealt with raw DXF data; reverse engineered the extremely old DR2 file format from 2D Catia; teach point data from industrial robots and most recently 2D point data from an Excel chart. All of these require the same thing, take 2D or 3D points consisting of X, Y and possibly Z coordinates and place them in a CAD file. With vanilla AutoCAD, this is an extremely time consuming and error prone manual task; with a bit of programming it takes seconds.

I'll show two methods of bringing in 2D data, as points and as a lightweight polyline. The sample data I'll be using is tab separated, but you can easily change the code to work with any delimiter character. With both routines, I have hard coded the path to "C:\", either place the "pointdata.txt" file here or modify the path as you require.

Let's look at inserting the data as AutoCAD point objects. First, we load the file into a string variable. Using the Split command, the data is broken down into rows; then it's a matter of looping through the rows in the "ptArray" array and splitting each value into the "pt" array as Variant/Strings. AutoCAD will only accept point data as Variant/Doubles so we have to type cast the string data into the "point" array and then add the point to model space.

Public Sub Insert2DPointDataAsPoints()
On Error GoTo ErrorHandler
  Dim oPoint As AcadPoint
  Dim pt As Variant
  Dim point(0 To 2) As Double
  Dim ptArray As Variant
  Dim fileNumber As Long
  Dim strFile As String
  Dim i As Long
  
  ' Open the text file and store it in strFile
  fileNumber = FreeFile
  Open "C:\pointdata.txt" For Binary Access Read As #fileNumber
    strFile = String(LOF(fileNumber), " ")
    If Not Len(strFile) = 0 Then Get #fileNumber, , strFile
  Close #fileNumber

  ' Make sure we have some data to work with
  ' Also checks to see if user cancelled the dialog
  If Len(Trim(strFile)) = 0 Then GoTo ErrorHandler

  ' Split the file into rows
  ptArray = Split(strFile, vbCrLf)

  For i = 0 To UBound(ptArray)
    ' Set the point
    pt = Split(ptArray(i), vbTab)

    ' Convert the string data to doubles
    point(0) = CDbl(pt(0))
    point(1) = CDbl(pt(1))

    ' Add the point to Modelspace
    Set oPoint = ThisDrawing.ModelSpace.AddPoint(point)
  Next i

  ' Clean up
  Set oPoint = Nothing

  If IsDimArray(pt) Then Erase pt
  If IsDimArray(point) Then Erase point
  If IsDimArray(ptArray) Then Erase ptArray
  
  Exit Sub
ErrorHandler:
  Set oPoint = Nothing

  If IsDimArray(pt) Then Erase pt
  If IsDimArray(point) Then Erase point
  If IsDimArray(ptArray) Then Erase ptArray
End Sub

Adding a lightweight polyline isn't that different. Instead of breaking down the string data into doubles, we dimension one large array for all the 2D data "points" and use a counter "cnt" to fill in the values with our loop. Once all the data is loaded into the point array, the lightweight polyline is added to Modelspace.

Public Sub Insert2DPointDataAsLWPolyline()
On Error GoTo ErrorHandler
  Dim oLWPline As AcadLWPolyline
  Dim pt As Variant
  Dim points() As Double
  Dim ptArray As Variant
  Dim fileNumber As Long
  Dim strFile As String
  Dim i As Long
  Dim cnt As Long
  
  ' Open the text file and store it in strFile
  fileNumber = FreeFile
  Open "C:\pointdata.txt" For Binary Access Read As #fileNumber
    strFile = String(LOF(fileNumber), " ")
    If Not Len(strFile) = 0 Then Get #fileNumber, , strFile
  Close #fileNumber

  ' Make sure we have some data to work with
  ' Also checks to see if user cancelled the dialog
  If Len(Trim(strFile)) = 0 Then GoTo ErrorHandler

  ' Split the file into rows
  ptArray = Split(strFile, vbCrLf)

  ' Resize the points array for the lightweight polyline
  ReDim points((UBound(ptArray) * 2) + 1)

  ' Set the counter
  cnt = 0

  For i = 0 To UBound(ptArray)
    ' Set the point
    pt = Split(ptArray(i), vbTab)

    ' Convert the string data to doubles
    points(cnt) = CDbl(pt(0))
    points(cnt + 1) = CDbl(pt(1))

    cnt = cnt + 2
  Next i

  ' Add the Light Weight Polyline to Modelspace
  Set oLWPline = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)

  ' Clean up
  Set oLWPline = Nothing

  If IsDimArray(pt) Then Erase pt
  If IsDimArray(points) Then Erase points
  If IsDimArray(ptArray) Then Erase ptArray
  
  Exit Sub
ErrorHandler:
  Set oLWPline = Nothing

  If IsDimArray(pt) Then Erase pt
  If IsDimArray(points) Then Erase points
  If IsDimArray(ptArray) Then Erase ptArray
End Sub

Before I forget again, add the helper routine "IsDimArray" used to clean up the arrays that were used.

Public Function IsDimArray(arr As Variant) As Boolean
On Error GoTo ErrorHandler
  Dim i As Long

  i = UBound(arr)
  If Not i = -1 Then IsDimArray = True

  Exit Function
ErrorHandler:
  IsDimArray = False
End Function

Changing these routines to insert 3D data is as simple as splitting the point data into 3 doubles (for the Z coordinate) or using a polyline instead of a lightweight polyline. If you have any trouble with your own data, let me know; I'd be happy to lend a hand. A few other things that should be included for a fully useful routine:

Watch for blank lines in the point data

Check all the data to be sure it is numeric before adding the point

Add code to make sure the point data file exists before trying to open it

Drawing the Golden Ratio

2005-02-06T11:58:00.000-05:00

Platform: AutoCAD 2004
Download: GoldenRatio.zip

The Golden Ratio has always fascinated me. I'm no math wizard but the Golden Ration (also known as Phi) has a tendency to turn up in a great number of places: the spiral of a sea shell, the swirl of milk in coffee, clouds, crop circles, and the list goes on. I highly recommend a movie directed by Darren Aronofsky, a very odd but interesting movie from 1998 entitled Pi (IMDB link) that touches on Phi and Fibonacci sequences.

Fibonacci sequences occur when any term after the first two can be found by summing the two previous terms. Here's an example: 1, 1, 2, 3, 5, 8, 13, ...

I'll point you to the two links below for full details on Phi and Fibonacci sequences:

http://jwilson.coe.uga.edu/.../goldenratio.html

http://mathworld.wolfram.com/GoldenRatio.html

We can calculate a Fibonacci sequence with this function:

Public Function Fibonacci(ByVal lngNumber As Long) As Long
On Error GoTo ErrorHandler
  If lngNumber <= 1 Then ' ignore negatives
    Fibonacci = 0
  ElseIf lngNumber = 2 Then
    Fibonacci = 1
  Else ' return the fibonacci number
    Fibonacci = Fibonacci(lngNumber - 1) + Fibonacci(lngNumber - 2)
  End If

  Exit Function
ErrorHandler:
End Function

The trickiest part of the routine was resetting the start point for the arc as it moves every iteration of the loop. First, Add a constant for PI, then add the routine below.

Public Const PI = 3.14159265358979          ' 3.1415926535897932384626433832795 or atn(1.0)*4

Public Sub AddGoldenRatio(lngQuads As Long)
' Draw the golden ratio (PHI) starting at 0,0 and spiral out
On Error GoTo ErrorHandler
  Dim objArc As AcadArc
  Dim pt1(0 To 2) As Double
  Dim lngCorner As Long       ' Start corner: 0=SW, 1=SE, 2=NE, 3=NW
  Dim dblLength As Double     ' Length of a side.
  Dim dblLast As Double       ' Last Length
  Dim dblAngleStart As Double ' Start angle of arc
  Dim dblAngleEnd As Double   ' End angle of arc
  Dim i As Long

  lngCorner = 0                   ' Draw first square from 0,0
  dblLength = 1                   ' Start with a 1x1 square
  pt1(0) = 0#: pt1(1) = 0#        ' Center point of arc
  dblAngleStart = 0#              ' Start at 0 deg
  dblAngleEnd = 90# * (PI / 180#) ' Start at 90 deg (converted to radians)

  ' Start at 4 to skip duplicates in Fibonacci sequence
  ' Add 3 to compensate
  For i = 4 To lngQuads + 3
    ' Add arc to modelspace

    Set objArc = ThisDrawing.ModelSpace.AddArc(pt1, dblLength, dblAngleStart, dblAngleEnd)

    ' Update angles
    dblAngleStart = dblAngleEnd
    dblAngleEnd = dblAngleEnd + 90# * (PI / 180#)

    ' Set lengths
    dblLast = dblLength
    dblLength = Fibonacci(i)

    ' Move our startpoint
    Select Case lngCorner
      Case 0
        pt1(0) = pt1(0)
        pt1(1) = pt1(1) - (dblLength - dblLast)
      Case 1
        pt1(0) = pt1(0) + (dblLength - dblLast)
        pt1(1) = pt1(1)
      Case 2
        pt1(0) = pt1(0)
        pt1(1) = pt1(1) + (dblLength - dblLast)
      Case 3
        pt1(0) = pt1(0) - (dblLength - dblLast)
        pt1(1) = pt1(1)
    End Select

    ' Incerement our corner
    lngCorner = lngCorner + 1
    If lngCorner = 4 Then lngCorner = 0
  Next i

  ' Clean up
  Set objArc = Nothing
  If IsDimArray(pt1) Then Erase pt1

  Exit Sub
ErrorHandler:
  Set objArc = Nothing
  If IsDimArray(pt1) Then Erase pt1
End Sub

Update: I forgot to add the IsDimArray function. You can thank Jimmy Bergmark for catching my mistake. The IsDimArray function checks to see if an array has been dimensioned yet and reurns a boolean.

Public Function IsDimArray(arr As Variant) As Boolean
On Error GoTo ErrorHandler
  Dim i As Long

  i = UBound(arr)
  If Not i = -1 Then IsDimArray = True

  Exit Function
ErrorHandler:
  IsDimArray = False

End Function

Not sure if you can find any technical use for this, but I hope I have peaked you interest into this interesting corner of mathematics. To call the routine add a sub like below:

Private Sub DrawGoldenRatio()
  Call AddGoldenRatio(8)
End Sub

The six laws of new software

2005-02-03T21:40:00.000-05:00

This is an article every programmer should read, especially those just starting to enter the world of software development:

http://www.changethis.com/12.SixLawsSoftware

It's common sense for those of us who have been around long enough to learn the hard way; hindsight is 20/20. Always a good idea to remember the real reason we're writing code, to help the end users.

I hate CAD standards. Part 2

2005-02-03T18:07:00.000-05:00

Platform: AutoCAD 2004
Download: IHateCADStandards.zip

Continuing from Part 1, we'll start by setting our units.

Public Function setUnits() As Boolean
' Set base drawing units
On Error GoTo ErrorHandler
  ' Set system variables
  With ThisDrawing
    .SetVariable "LUNITS", 2 ' Sets linear units to Decimal
    .SetVariable "LUPREC", 3 ' Sets the # of decimal places displayed for all read-only linear units

    .SetVariable "AUNITS", 0 ' Sets units for angles to Decimal degrees
    .SetVariable "AUPREC", 3 ' Sets the number of decimal places for all read-only angular units

    .SetVariable "MEASUREMENT", 0 'Sets units as imperial or metric for the current drawing only

    .SetVariable "ANGDIR", 0 'Sets the direction of positive angles. Set to Counterclockwise
 
    .SetVariable "ANGBASE", 0# ' Sets the base angle to 0 with respect to the current UCS.
 
    .SetVariable "INSUNITS", 1 ' Specifies units for drag & dropped blocks or images. Set to Inches
  End With

  setUnits = True

  Exit Function
ErrorHandler:
  ' Insert error handler here
End Function

No real magic here, we're just setting a few system variables. Call the above routine with the following line:

If Not setUnits Then GoTo ErrorHandler

Now we can focus on layer modification. Layers can get a bit tricky so we have to be careful what we do. I found out the hard way that you can set a layer's colour to black and it will be invisible if your workspace background is black. Note to self: make a routine that loops through all layers and sets their colours to black to annoy coworkers. We'll also create a few helper routines to set a layer current, check if a layer already exists and if it is locked.

Public Function CreateLayer(strLay As String, _
                       strLineType As String, _
                       Optional setColor As Boolean = False, _
                       Optional lngRed As Long, _
                       Optional lngGreen As Long, _
                       Optional lngBlue As Long, _
                       Optional lyrLineWeight As ACAD_LWEIGHT = acLnWtByLayer, _
                       Optional booPlottable As Boolean = True, _
                       Optional booLock As Boolean = False, _
                       Optional booFreeze As Boolean = False, _
                       Optional booLayerOn As Boolean = True) As Boolean
On Error GoTo ErrorHandler
  Dim newLayer As AcadLayer
  Dim objLineType As AcadLineType
  Dim objColor As AcadAcCmColor
  Dim booFound As Boolean

  Set newLayer = ThisDrawing.Layers.Add(strLay)

  With newLayer
    If setColor Then
      Set objColor = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16")

      If (lngRed = 0 And lngGreen = 0 And lngBlue = 0) Or _
         (lngRed = 255 And lngGreen = 255 And lngBlue = 255) Then
        objColor.ColorIndex = acWhite
      Else
        Call objColor.SetRGB(lngRed, lngGreen, lngBlue)
      End If

      .TrueColor = objColor
    End If

    .Lineweight = lyrLineWeight
    .Plottable = booPlottable
    .Lock = booLock
    If Not StrComp(ThisDrawing.ActiveLayer.Name, strLay, vbTextCompare) = 0 Then .Freeze = booFreeze
    .LayerOn = booLayerOn

    For Each objLineType In ThisDrawing.Linetypes
      If StrComp(objLineType.Name, strLineType, vbTextCompare) = 0 Then
        booFound = True
        Exit For
      End If
    Next

    If Not booFound Then ThisDrawing.Linetypes.Load strLineType, "acadiso.lin"

    .Linetype = strLineType
  End With

  Set newLayer = Nothing
  Set objLineType = Nothing
  If setColor Then Set objColor = Nothing

  CreateLayer = True

  Exit Function
ErrorHandler:
  Set newLayer = Nothing
  Set objLineType = Nothing
  If setColor Then Set objColor = Nothing
End Function

It seems more complicated than it should be (and it might be) but it works well. If you only use the base 16 or 255 colours, you can rip out the entire "setColor" section and just pass the routine a colour code. Call the above routine with the following line:

  If Not CreateLayer("Building-Columns", _
                     "Continuous", _
                     True, _
                     255, 191, 0, _
                     acLnWtByLwDefault, _
                     True, False, False, True) Then GoTo ErrorHandler

  If Not CreateLayer("Building", _
                     "Continuous", _
                     True, _
                     204, 51, 0, _
                     acLnWtByLwDefault, _
                     True, False, False, True) Then GoTo ErrorHandler

  If Not CreateLayer("Building-Columns", _
                     "Continuous", _
                     True, _
                     255, 191, 0, _
                     acLnWtByLwDefault, _
                     True, False, False, True) Then GoTo ErrorHandler

  If Not CreateLayer("Building-Column-Lines", _
                     "Continuous", _
                     True, _
                     102, 204, 0, _
                     acLnWtByLwDefault, _
                     True, False, False, True) Then GoTo ErrorHandler

  If Not CreateLayer("Building-Drains", _
                     "Continuous", _
                     True, _
                     132, 132, 132, _
                     acLnWtByLwDefault, _
                     True, False, False, True) Then GoTo ErrorHandler

Be sure to use the helper routines I mentioned earlier whenever you need to create or modify a layer.

Public Function LayerExists(strLay As String) As Boolean
On Error GoTo ErrorHandler
  Dim oLayers As AcadLayers
  Dim oLayer As AcadLayer

  Set oLayers = ThisDrawing.Layers

  For Each oLayer In oLayers
    If StrComp(oLayer.Name, strLay, vbTextCompare) = 0 Then
      LayerExists = True
      Exit For
    End If
  Next

  Set oLayers = Nothing
  Set oLayer = Nothing

  Exit Function
ErrorHandler:
  Set oLayers = Nothing
  Set oLayer = Nothing
End Function

Public Function LayerLocked(strLay As String) As Boolean
On Error GoTo ErrorHandler
  Dim oLayers As AcadLayers
  Dim oLayer As AcadLayer

  Set oLayers = ThisDrawing.Layers

  For Each oLayer In oLayers
    If StrComp(oLayer.Name, strLay, vbTextCompare) = 0 Then
      If oLayer.Lock = True Then LayerLocked = True
      Exit For
    End If
  Next

  Set oLayers = Nothing
  Set oLayer = Nothing

  Exit Function
ErrorHandler:
  Set oLayers = Nothing
  Set oLayer = Nothing
End Function

One final pitfall to watch out for, don't try to lock or delete the current layer.

I hate CAD standards. Part 1

2005-02-01T20:26:00.000-05:00

Platform: AutoCAD 2004
Download: IHateCADStandards.zip

I have a confession; I hate CAD standards. It's not that I don't like following rules, I hate all the steps involved in having to add the standards.

I deal with a lot of third party drawings, about 95% or more of the drawings I work in come from a customer or consultant so having a perfect template to start from isn't a luxury I can work with. Now before anyone says “but Autodesk has given us many tools to enforce standards”, I know…but I'm very lazy when it comes to adding standards, like I mentioned, I hate them.

So, instead of complaining, I've made a single-click solution. I can now add all of my text styles, dimension styles, layers and units with a single click of a button. If you find yourself in the same situation, read on for some invaluable routines.

The first routine will add a new text style with RomanS as the font and the width specified in dblWidth:

Public Function AddTextStyle(dblWidth As Double) As Boolean
On Error GoTo ErrorHandler
  Dim oTextStyle As AcadTextStyle

  Set oTextStyle = ThisDrawing.TextStyles.Add("MY_ROMANS")

  With oTextStyle
    .fontFile = "C:/Program Files/AutoCAD 2004/Fonts/romans.shx"
    .Width = dblWidth
  End With

  ThisDrawing.ActiveTextStyle = oTextStyle

  Set oTextStyle = Nothing

  AddTextStyle = True

  Exit Function
ErrorHandler:
  Set oTextStyle = Nothing
End Function

Be sure to add in some code to confirm that "romans.shx" exists. Call the above routine with the following line:

If Not AddTextStyle(1#) Then GoTo ErrorHandler

Now that we have our required text styles added into the drawing, we can add our dimension styles. The problem with creating a dimension style is that we don't know the status of any of the variables, so we have to set EVERY variable.

Private Function createDimStyle(dblScale As Double) As Boolean
On Error GoTo ErrorHandler
  ' Create dimension style
  Dim oDimStyle As AcadDimStyle
  Dim oTextStyle As AcadTextStyle

  ' Set system variables
  With ThisDrawing
    .SetVariable "DIMCLRD", 140
    .SetVariable "DIMLWD", -2
    .SetVariable "DIMDLI", 0.08
    .SetVariable "DIMCLRE", 140
    .SetVariable "DIMLWE", -2
    .SetVariable "DIMEXE", 0.08
    .SetVariable "DIMEXO", 0.08
    .SetVariable "DIMASZ", 0.08
    .SetVariable "DIMSD1", 0
    .SetVariable "DIMSD2", 0
    .SetVariable "DIMSE1", 0
    .SetVariable "DIMSE2", 0

    .SetVariable "DIMBLK1", "."
    .SetVariable "DIMBLK2", "."
    .SetVariable "DIMLDRBLK", "."
    .SetVariable "DIMCEN", 0

    .SetVariable "DIMTIH", 1
    .SetVariable "DIMTOH", 1
    .SetVariable "DIMTMOVE", 0

    ' Confirm that my TestStyle is there before setting
    For Each oTextStyle In .TextStyles
      If StrComp(oTextStyle.Name, "MY_ROMANS", vbTextCompare) = 0 Then
        .SetVariable "DIMTXSTY", "MY_ROMANS"
        Exit For
      End If
    Next

    .SetVariable "DIMCLRT", 120
    .SetVariable "DIMTXT", 0.08
    
    .SetVariable "DIMATFIT", 3
    .SetVariable "DIMTIX", 0
    .SetVariable "DIMSOXD", 0

    .SetVariable "DIMUPT", 0
    .SetVariable "DIMTOFL", 0

    .SetVariable "DIMTAD", 0
    .SetVariable "DIMJUST", 0
    .SetVariable "DIMGAP", 0.08

    .SetVariable "DIMLUNIT", 2
    .SetVariable "DIMTFAC", 1
    .SetVariable "DIMDEC", 3
    .SetVariable "DIMFRAC", 0
    .SetVariable "DIMDSEP", "."
    .SetVariable "DIMRND", 0
    .SetVariable "DIMPOST", ""

    .SetVariable "DIMLFAC", 1
    .SetVariable "DIMZIN", 0

    .SetVariable "DIMAUNIT", 0
    .SetVariable "DIMADEC", 3
    .SetVariable "DIMAZIN", 0
    
    .SetVariable "DIMALT", 0
    
    .SetVariable "DIMTOL", 0
    .SetVariable "DIMLIM", 0
    .SetVariable "DIMTDEC", 3
    .SetVariable "DIMTP", 0
    .SetVariable "DIMTM", 0
    .SetVariable "DIMTFAC", 1
    .SetVariable "DIMTOLJ", 1

    .SetVariable "DIMALTTD", 2
    .SetVariable "DIMALTTZ", 0
  
    ' Set scale to dblScale
    .SetVariable "DIMSCALE", dblScale

    ' Create Descon dimstyle
    Set oDimStyle = .DimStyles.Add("MyDimStyle" & CStr(CLng(dblScale)))
    oDimStyle.CopyFrom ThisDrawing
    .ActiveDimStyle = oDimStyle
  End With

  Set oDimStyle = Nothing
  Set oTextStyle = Nothing

  createDimStyle = True

  Exit Function
ErrorHandler:
  Set oDimStyle = Nothing
  Set oTextStyle = Nothing
End Function

Just to clarify, all we've done with the routine above is set a whole bunch of style overrides on the current dimension style and then copied our modified style into a new dimension style. Odd way of doing it, but we work with the tools we have. Call the above routine with the following line:

If Not createDimStyle(48#) Then GoTo ErrorHandler

This will create a dimension style, the way we like with a scale appropriate for a 1/4"=1'-0" PaperSpace viewport.

Check out Part 2 of this article to find out how to create layers and set the default units in your drawing.

Going Off on a Tangent

2005-01-27T10:58:00.000-05:00

Platform: AutoCAD 2004
Download: DrawInsideTangent.zip

I recently had a problem where I needed to find the inside tangent points between two circles. See the image to the right for clarity. I knew where the two centers were (X and Y) and I knew the radius of both circles...but how to find the tangents. The other problem I had was that I needed a routine that was flexible enough to handle a wide range of values, point X and point Y can vary in position and the two radii can vary. The only thing I knew for sure was that point Y was below point X.

The AutoCAD API didn't have much to help me out so I headed to the web in search of an answer. There was one very descriptive article on how to solve this problem but the solution was written in C++ and was simply too complex to be ported to VB.

In the end a co-worker pointed me down the right path (thanks Mike!). Take a look at the code below; if you have any questions after trying it out, let me know.

Public Const PI = 3.14159265358979 ' 3.1415926535897932384626433832795 or atn(1.0)*4

Public Sub DrawTangent()
  Dim objLine As AcadLine
  Dim objArc As AcadArc

  Dim pt1(0 To 2) As Double
  Dim pt2(0 To 2) As Double
  Dim pt3 As Variant
  Dim pt4 As Variant

  Dim rad1 As Double
  Dim rad2 As Double

  Dim dblLength As Double
  Dim dblOffset As Double
  Dim dblValue As Double
  Dim dblAngle As Double
  Dim dblTanAngle As Double
  Dim dblStartAngle As Double

  ' Center of first circle
  pt1(0) = 0#
  pt1(1) = 0#

  ' Center of second circle
  pt2(0) = 30#
  pt2(1) = -3#

  ' Radius of first circle
  rad1 = 10#

  ' Radius of second circle
  rad2 = 1.5

  ' Distance between two centers (hypotenuse of triangle)
  dblLength = GetDistance(pt1, pt2)

  ' Add both radii (opposite length of triangle)
  dblOffset = rad1 + rad2

  ' Length of the adjacent side of the triangle between centers
  dblValue = Sqr((dblLength ^ 2) - (dblOffset ^ 2))

  ' Angle between hypotenuse and adjacent side
  dblTanAngle = Atn(dblOffset / dblValue)

  ' Add hypotenuse side of triangle
  Set objLine = ThisDrawing.ModelSpace.AddLine(pt1, pt2)

  ' Angle of hypotenuse from zero
  dblStartAngle = ThisDrawing.Utility.AngleFromXAxis(pt1, pt2)

  ' Angle of adjacent from zero
  If pt2(1) >= pt1(0) Then
    dblAngle = (360# * (PI / 180#)) - Abs(dblStartAngle - dblTanAngle)
  Else
    dblAngle = dblStartAngle - dblTanAngle
  End If

  ' Find end point of adjacent side
  pt3 = ThisDrawing.Utility.PolarPoint(pt1, dblAngle, dblValue)

  ' Add adjacent side of triangle
  Set objLine = ThisDrawing.ModelSpace.AddLine(pt1, pt3)

  ' Add opposite side of triangle
  Set objLine = ThisDrawing.ModelSpace.AddLine(pt3, pt2)

  ' Angle from zero to first tangent
  dblAngle = dblAngle + (90# * (PI / 180#))

  ' Start of infeed angle
  pt3 = ThisDrawing.Utility.PolarPoint(pt1, dblAngle, rad1 + rad2)

  ' Add start arc
  Set objArc = ThisDrawing.ModelSpace.AddArc(pt1, rad1 + rad2, dblAngle, 90# * (PI / 180#))

  ' Start of end angle
  pt4 = ThisDrawing.Utility.PolarPoint(pt2, dblAngle + (180# * (PI / 180#)), rad2)

  ' Add end arc
  Set objArc = ThisDrawing.ModelSpace.AddArc(pt2, rad2, dblAngle + (180# * (PI / 180#)), 270# * (PI / 180#))

  ' Add line between arcs
  Set objLine = ThisDrawing.ModelSpace.AddLine(pt3, pt4)
End Sub

You'll also need the "GetDistance" function. It calculates the distance between two points in all three axis of AutoCAD space.

Public Function GetDistance(distPnt1 As Variant, distPnt2 As Variant) As Double
  Dim Xval  As Double
  Dim Yval  As Double
  Dim Zval  As Double

  Xval = distPnt1(0) - distPnt2(0) 'Difference between x values
  Yval = distPnt1(1) - distPnt2(1) 'Difference between y values
  Zval = distPnt1(2) - distPnt2(2) 'Difference between z values

  ' Calc distance using Pythagorean Theorum
  GetDistance = Sqr((Sqr((Xval ^ 2) + (Yval ^ 2)) ^ 2) + (Zval ^ 2))
End Function

Try copying both functions into VBA and run the "DrawTangent" routine you should see two arcs with a perfect tangent between them. It also draws the triangle we needed to calculate the tangent points. If you need to draw tangents in other directions, the angles will have to be modified to suit but the theory above will work for any two circles as long as they don't overlap.

Welcome

2005-01-26T20:01:00.000-05:00

Hello to new friends and old. This is my second attempt at a blog focusing on creating custom code for AutoCAD and Inventor by Autodesk. For the next little while, most articles will focus on AutoCAD, as that is what I'm currently working in. If things go well, I'll be joining the ADN later this year and then the real fun will begin. (insert evil laughter here). If you have any bits of code you're having trouble with or ideas for posts, let me know. I'll try to post something every couple of days (or more) but no guarantees.

And now a bit about me: I've been working in drafting/CAD since 1998. Like a few others here, I started out on paper and moved to CAD as quickly as possible. A few systems I've worked with over the years are AutoCAD (r9 to current), SolidWorks, Inventor, ACAD MDT, ACAD Mechanical, ACAD Electrical, ADH800 (no mouse required, don't even ask!), VisionAEL, ME10 and One Space Designer.

Despite the list above, my true love is programming... still not sure why I went for Mech. Eng. in college. I program in numerous languages (16 last time I counted) and have been customizing and extending various CAD systems for more than a decade.

I've worked in a wide range of industries including (but not limited to) automotive, beef processing, telecommunications, safe/vault manufacturing and was even an AE for an Autodesk VAR for a stint before I was enticed back into the real world to automate conveyor systems.

If anyone is interested, I am available for after-hours freelance work/training/etc.