TheSwamp

Code Red => VB(A) => Topic started by: DEVITG on March 25, 2017, 02:07:39 PM

Title: to make a DWG , from an XLS, by VBA , from the VBA editor at xls
Post by: DEVITG on March 25, 2017, 02:07:39 PM
I have a:
1st
xls with columns block-name att1-tag to attn-tag could be about 15 att. and columns ,at the same row with att-values. last colummn to set order number or empty , to insert the block. All data at the same row

2nd
a dwt template , modelspace empty
the block collection at Adoc
all features by user

3rd Populate the modelsapce with blocks in a row as wide has paper space wide , and a line conecting each block with subsecuent block .

Itīs kind of a unifilar circuit , no branchs

4th save as phat/project.dwg
Hope it is clear
5th print the dwg as pdf file
6th Open the pdf file
The user will never manipulate the dwg , it is a commercial person , no ACAD skill.
Hope it is clear


Or at least I need to see xls-VBA to dwg from XLS , NOT acad-VBA to dwg.
Iīm proficient in VLISP, I want to start in this new task.
Thank in advance

Its a project in my mind , not materialized neither in XLS and DWT

I just want to know if it is possible , and the first step on XLS VBA to ACAD .

Off course the user station hold XLS, itīs ACAD VBA complements , and ACAD,

Thanks in advance.

Quote
The longest journey, start with the first step, No matter how short the step is.
Title: Re: to make a DWG , from an XLS, by VBA , from the VBA editor at xls
Post by: Yosso on April 18, 2017, 10:22:09 AM
Some old code I utilized to create a graph in ACAD from data contained in an Excel workbook.

Code: [Select]
Sub Draw_Lines()

Dim selRng As Range

Dim lineData As Variant

Dim DataStart, DataEnd, DataRange

Dim WorkSheetInput As String, DataInput As String, ChartInput As String

Dim i As Integer, j As Integer, NumRows As Integer
Dim numcols As Integer, StartRow As Integer, EndRow As Integer, StartCol As Integer, EndCol As Integer

Dim MinY As Double, MaxY As Double, MinX As Double, MaxX As Double, MaxWidth As Double

' Switch to AutoCAD

Dim acad As AutoCAD.AcadApplication
Dim adoc As AutoCAD.AcadDocument
Dim aspace As AcadBlock

Dim appNum As String

On Error GoTo ErrorHandler
appNum = acadVerNum

If appNum = "" Then
    Exit Sub
End If

On Error Resume Next
Set acad = GetObject(, "Autocad.Application." & appNum)
If Err.Number = 429 Then
Err.Clear

On Error GoTo 0
Set acad = CreateObject("Autocad.Application." & appNum)
If Err Then
Exit Sub
End If
End If

acad.WindowState = acMax

Set adoc = acad.ActiveDocument
Set aspace = adoc.ActiveLayout.Block

' Get the chart data from Excel

Application.ScreenUpdating = False

' Need to selection the chart data from the worksheet
DataInput = "INSULATOR_SWING"
ChartInput = "CHART_DATA"

Worksheets(ChartInput).Activate

StartRow = 5 ' Need to have method to verify start location with other program
StartCol = 1

EndRow = LastRow(Worksheets(ChartInput))
EndCol = LastCol(Worksheets(ChartInput))

'EndRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
'EndCol = ActiveSheet.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count

DataStart = Cells(StartRow, StartCol).Address(False, False)
DataEnd = Cells(EndRow, EndCol).Address(False, False)

DataRange = DataStart + ":" + DataEnd

Set selRng = Worksheets(ChartInput).Range(DataRange)

'Set selRng = Selection

lineData = selRng.Value2

MaxX = Worksheets(DataInput).Cells(8, 11)
MinX = Worksheets(DataInput).Cells(7, 11)

NumRows = UBound(lineData, 1) ' Number of Rows
numcols = UBound(lineData, 2) ' Number of Columns

MaxY = 0 ' Reset MaxY Value

For j = 2 To numcols
    If lineData(NumRows, j) > MaxY Then
        MaxY = lineData(NumRows, j)
    End If
Next j

adoc.SetVariable "LTSCALE", (MaxX / 40)

Dim LineTypeObject As AcadLineType
Dim oSpline As AcadSpline
Dim oLWPline As AcadPolyline
Dim GraphLineHor, GraphLineVer, GridLineHor, GridLineVer, TickLine, ChartLine As AcadLine
Dim TickLabel As AcadText
Dim AxixLabel, TempText As AcadText

Dim TextString As String
Dim LineType As String
Dim LayerName As String
Dim TxtLayName As String
Dim BrdrLayName As String
Dim GridLayName As String

Dim Xscale As Double
Dim ticklength As Double

Xscale = 1#  ' 2.5  need to add as an input ?  On the excel sheet?

Dim TextPoint(0 To 2) As Double
Dim GridStart(0 To 2) As Double
Dim GridEnd(0 To 2) As Double
Dim GraphStartPt(0 To 2) As Double
Dim GraphXEndPt(0 To 2) As Double
Dim GraphYEndPt(0 To 2) As Double
Dim TickPtStart(0 To 2) As Double
Dim TickPtEnd(0 To 2) As Double

' Setup Layers for text, grids, and borders
TxtLayName = "Text"
BrdrLayName = "Border"
GridLayName = "Grid"

MakeSetLayer (TxtLayName)
MakeSetLayer (BrdrLayName)
MakeSetLayer (GridLayName)

'Set LineTypeObject = AcadLineType.Load(LineType, LineTypeFileName)
On Error Resume Next
adoc.Linetypes.Load "DOT", "acad.lin"

'--------------------------------------------------------------------
' TO DO.....
' Draw the Grid lines and axis lines
' Need to: Create layers for the various items
'           1. Grid lines with appropriate color
'           2. Graph borders ""
'           3. Text ""
'           4. Graphed data ""
'
' Need to give the user the option for scaling the
' horizontal data?
'
' Label the chart data series
' Draw a border around the graph
' Added the Title information at the top of the graph
'
'--------------------------------------------------------------------

' Round up to the nearest 100 to obtain the
' extents of the chart border

MaxX = (100 * Int(MaxX / 100)) * Xscale
MaxY = (100 * Int(MaxY / 100)) + 100

' Size the 'tick' and text
ticklength = 0.02 * (MaxX / Xscale)
If ticklength > 10 Then ticklength = 10

' Set the polyline width
MaxWidth = (MaxX / 200) / Xscale

' Set the layer for the border and ticks
'MakeSetLayer (BrdrLayName)

aspace.ActiveLayer = BrdrLayName

' Define the border of the chart
GraphStartPt(0) = 0#: GraphStartPt(1) = 0#: GraphStartPt(2) = 0#
GraphXEndPt(0) = MaxX: GraphXEndPt(1) = 0#: GraphXEndPt(2) = 0#
GraphYEndPt(0) = 0#: GraphYEndPt(1) = MaxY: GraphYEndPt(2) = 0#

' Horizontal Axis Line
Set GraphLineHor = aspace.AddLine(GraphStartPt, GraphXEndPt) ' need to change the color
With GraphLineHor
    .Color = 1
    .LineType = "BYLAYER"
End With

'Vertical Axis Line
Set GraphLineVer = aspace.AddLine(GraphStartPt, GraphYEndPt)
With GraphLineVer
    .Color = 1
    .LineType = "BYLAYER"
End With

' Set the current layer to "Text" for the labels
MakeSetLayer (TxtLayName)

' Label Horizontal Axis
TextPoint(0) = MaxX / 2
TextPoint(1) = -2.1 * ticklength * Xscale
TextPoint(2) = 0#
TextString = "HORIZONTAL SPAN"
Set TempText = aspace.AddText(TextString, TextPoint, ticklength * 1.5 * Xscale)
With TempText
    .Alignment = acAlignmentTopCenter
    .TextAlignmentPoint = TextPoint
    .Color = 2#
End With

' Label Vertical Axis
TextPoint(1) = MaxY / 2
TextPoint(0) = -2.1 * ticklength * Xscale
TextPoint(2) = 0#
TextString = "VERTICAL SPAN"
Set TempText = aspace.AddText(TextString, TextPoint, ticklength * 1.5 * Xscale)
With TempText
    .Rotation = pi() / 2
    .Alignment = acAlignmentBottomCenter
    .TextAlignmentPoint = TextPoint
    .Color = 2#
End With

' Place and label the tick marks and grid lines

' Draw ticks and lable for the horizontal axis
For i = 1 To MaxX / (100 * Xscale)
    MakeSetLayer (BrdrLayName)
    TickPtStart(0) = CDbl(i * Xscale * 100): TickPtStart(1) = 0#: TickPtStart(2) = 0#
    TickPtEnd(0) = CDbl(i * Xscale * 100): TickPtEnd(1) = (-1 * ticklength): TickPtEnd(2) = 0#
    Set TickLine = aspace.AddLine(TickPtStart, TickPtEnd)
   
    With TickLine
        .Color = 1#
        .LineType = "BYLAYER"
    End With
       
    ' Label the ticks
    MakeSetLayer (TxtLayName)
    TextString = CStr(i * 100)
    TickPtEnd(1) = (-1.1 * ticklength)
    Set TickLabel = aspace.AddText(TextString, TickPtEnd, ticklength * 0.8 * Xscale)
     
    With TickLabel
        .Alignment = acAlignmentTopCenter
        .TextAlignmentPoint = TickPtEnd
        .Color = 2#
    End With
   
    GridStart(0) = TickPtStart(0): GridStart(1) = TickPtStart(1): GridStart(2) = TickPtStart(2)
    GridEnd(0) = CDbl(i * Xscale * 100): GridEnd(1) = MaxY: GridEnd(2) = 0#
    Set GridLineVer = aspace.AddLine(GridStart, GridEnd)
    With GridLineVer
        .Color = 1#
        .LineType = "DOT"
    End With
         
Next i

' Draw the ticks for the vertical axis
For i = 1 To MaxY / 100
    MakeSetLayer (BrdrLayName)
    TickPtStart(1) = CDbl(i * 100): TickPtStart(0) = 0#: TickPtStart(2) = 0#
    TickPtEnd(1) = CDbl(i * 100): TickPtEnd(0) = (-1 * ticklength): TickPtEnd(2) = 0#
    Set TickLine = aspace.AddLine(TickPtStart, TickPtEnd)
   
    With TickLine
        .Color = 1#
        .LineType = "BYLAYER"
    End With
       
    ' Label the ticks
    MakeSetLayer (TxtLayName)
    TextString = CStr(i * 100)
    Set TickLabel = aspace.AddText(TextString, TickPtEnd, ticklength * 0.8 * Xscale)
     With TickLabel
        .Rotation = pi() / 2
        .Alignment = acAlignmentBottomCenter
        .TextAlignmentPoint = TickPtEnd
        .Color = 2#
    End With
   
    GridStart(0) = 0#: GridStart(1) = TickPtStart(1): GridStart(2) = 0#
    GridEnd(0) = MaxX: GridEnd(1) = CDbl(i * 100): GridEnd(2) = 0#
    Set GridLineHor = aspace.AddLine(GridStart, GridEnd)
    With GridLineHor
        .Color = 1#
        .LineType = "DOT"
    End With
Next i

' Draw the insulator swing graph
'=================================
' example of of creating a spline
'ReDim ptarr(0 To (UBound(lineData, 1) * 3) - 1) As Double
'Dim n

'For i = 1 To UBound(lineData, 1)
'    ptarr(n) = CDbl(lineData(i, 1)): ptarr(n + 1) = CDbl(lineData(i, 2)): ptarr(n + 2) = 0#
'    n = n + 3
'Next i

Dim startPt(0 To 2) As Double
Dim endPt(0 To 2) As Double

'startPt(0) = 0.5: startPt(1) = 0.5: startPt(2) = 0#
'endPt(0) = 0.5: endPt(1) = 0.5: endPt(2) = 0#
'Set oSpline = aspace.AddSpline(ptarr, startPt, endPt)

'=================================
endPt(2) = 0# ' Z coordinate is always zero
startPt(2) = 0#
Dim N
For j = 2 To numcols
   
    ' Create layer for each graph line
   
    ReDim PTARR(0 To (NumRows * 3) - 1) As Double
    PTARR(N) = CDbl(lineData(1, 1) * Xscale)
    PTARR(N + 1) = CDbl(lineData(1, j))
    PTARR(N + 2) = 0#
    N = N + 3
    'startPt(0) = lineData(1, 1): startPt(1) = lineData(1, j)
   
    For i = 1 To NumRows - 1
        endPt(0) = lineData(i + 1, 1) * Xscale: endPt(1) = lineData(i + 1, j)
        PTARR(N) = endPt(0)
        PTARR(N + 1) = endPt(1)
        PTARR(N + 2) = endPt(2)
       
        ' Draw as multiple line segments
        'If startPt(1) >= 0 Then
        '    Set ChartLine = aspace.AddLine(startPt, endPt)
        '    With ChartLine
        '        .Color = 3 + j
        '        .LineType = "BYLAYER"
        '    End With
        'End If
        'startPt(0) = endPt(0): startPt(1) = endPt(1)
       
        N = N + 3
       
    Next i
   
    LayerName = CStr(j - 1) + "-series"
   
    MakeSetLayer (LayerName)
   
    Set oLWPline = aspace.AddPolyline(PTARR)
    With oLWPline
        .Color = 3 + j
        .LineType = "BYLAYER"
        .ConstantWidth = MaxWidth
               
    End With
   
    N = 0
Next j

'' if you need to draw the closed spline then add this line:
'' oSpline.Closed=True
ZoomExtents

Set aspace = Nothing
Set adoc = Nothing
Set acad = Nothing

Application.ScreenUpdating = True
Worksheets(DataInput).Activate ' return to main screen

ErrorHandler:
    If Err.Number <> 0 Then
        'MsgBox Err.Description
    End If
   
End Sub

Title: Re: to make a DWG , from an XLS, by VBA , from the VBA editor at xls
Post by: DEVITG on April 18, 2017, 03:38:10 PM
Hi Yosso . Seem to the light shine at my eyes. It the first time I see some so good.
I will try and ask you if need. Thanks again
Title: Re: to make a DWG , from an XLS, by VBA , from the VBA editor at xls
Post by: BIGAL on April 20, 2017, 11:21:07 PM
Two others ways you can get at excel using lisp reading individual cell values look at getexel.lsp, the other alternative is to make a csv file and again using lisp create dwg. For me its more comfortable to use lisp.