Return to index: [Subject] [Thread] [Date] [Author]

Re: '97 UBC Spreadsheet Macro -- ExtractAcadLineCoords

[Subject Prev][Subject Next][Thread Prev][Thread Next]
title from merrick's macro ?AcadModules.ExtractAcadLineCoords
Following is the macro for extracting the coordinates from acad14 to the
excel spreadsheet. I hear that acad2000 has a more direct and simpler way
of doing this. Dennis Wish never got this working. I have used it on
several projects. But not since I have updated to acad2000i. 

****** Watch for my next email, where I will demonstrate a spread sheet 
method for distributing forces for a flexible diaphragm that can be
expanded at will, takes up one line and can have division lines with no
shear wall. It is an iteration similar to  the moment distribution method
for continuous beams and frames. 

*****My next project is a two dimensional iteration for rigid diaphragms
that can expand to what ever size one needs. A piece of diaphragm has no
way of knowing where the shear walls are. So why couldn't a mathematical
module be made that can be stacked, as needed, like Legos, to work out
diaphragm responses of any shape?

*****I need programs that lets me make my own program with my own design
decisions. I still don't fully know how sold programs are managing design
decisions. It used to be that we could get, study and alter program codes
for our designs. With out that access just how liable are you for errors?
How liable are programmers that hold secrete and are the only ones that
control their proprietary codes for their programs?

*****And now the macro.

' ExtractLineCoords
' By Hans Kellner - Feb. 1999
' Hans gave David Merrick permission to share this with others on April, 20
' This is to be merged into James Rigid Diaphragm Program.
' The intent is to merge this in with the
' This subroutine extracts the startpoint and endpoint coordinates
' of all line entities in the current AutoCAD  acad14 document selection
' It places these coordinates in a new worksheet.
Public Sub ExtractAcadLineCoords()

    ' Get the running version of AutoCAD
    Dim acadApp As Object
    On Error Resume Next    ' Defer error trapping.
    Set acadApp = GetObject(, "AutoCAD.Application")
    Err.Clear   ' Clear Err object in case error occurred.
    If acadApp Is Nothing Then
        MsgBox "AutoCAD is not running.  Please run AutoCAD, load drawing,
and select lines."
        Exit Sub
    End If
    acadApp.Visible = True
    ' Get the active document
    Dim acadDoc As Object
    Set acadDoc = acadApp.ActiveDocument
    If acadDoc Is Nothing Then
        MsgBox "Unable to find AutoCAD document.  Unable to continue."
        Exit Sub
    End If
    ' Get the selection set from the document
    Dim acadSSet As Object
    Set acadSSet = acadDoc.ActiveSelectionSet
    If acadSSet Is Nothing Or acadSSet.Count = 0 Then
        MsgBox "There is no selection.  Please select lines first."
        Exit Sub
    End If
    ' Now we need to create a new worksheet to insert the extracted
    ' line coordinates.  Start by checking if there is an existing
    ' workbook.
    Dim xlWb As Workbook
    If ActiveWorkbook Is Nothing Then
        ' Nope, so create a new workbook
        Set xlWb = Workbooks.Add(xlWBATWorksheet)
        ' use active workbook
        Set xlWb = ActiveWorkbook
    End If
    ' get the new worksheet and make it visible
    Dim xlWs As Worksheet
    Set xlWs = xlWb.ActiveSheet
    xlWs.Visible = xlSheetVisible
    ' Set the title of the sheet
    xlWs.Cells(1, 1).Value = "Coordinates of Selected Lines for shearwalls:
" & acadDoc.Name
    xlWs.Cells(1, 1).Font.Bold = True
    ' Set the captions for the columns
    xlWs.Cells(3, 1).Value = "X"
    xlWs.Cells(3, 2).Value = "Y"
    xlWs.Cells(3, 3).Value = "Z"
    ' Change the format of the captions.
    With xlWs.Rows("3:3")
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
    End With
    ' Now we will iterate over the selection set and fill the table
    ' with the coordinates of all lines in the set.
    Dim startPt As Variant, endPt As Variant
    Dim acadEntity As Object
    Dim iRow As Integer
    Dim jRow As Integer
    iRow = 4
    jRow = 5
    For Each acadEntity In acadSSet
        With acadEntity
            ' Is this a line?
            If .EntityName = "AcDbLine" Then
                ' Yes, so we can grab the information
                ' Place these coordinates in the table
                startPt = .startPoint
                endPt = .endPoint
                xlWs.Cells(iRow, 1).Value = startPt(0) / 12
                xlWs.Cells(iRow, 2).Value = startPt(1) / 12
                xlWs.Cells(iRow, 3).Value = startPt(2) / 12
                xlWs.Cells(jRow, 1).Value = endPt(0) / 12
                xlWs.Cells(jRow, 2).Value = endPt(1) / 12
                xlWs.Cells(jRow, 3).Value = endPt(2) / 12
                ' Next row
                jRow = jRow + 2
                iRow = iRow + 2
            End If
        End With
    Next acadEntity
    xlWs.Activate   ' Now we activate the sheet
End Sub