TheSwamp
Code Red => VB(A) => Topic started 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.
The longest journey, start with the first step, No matter how short the step is.
-
Some old code I utilized to create a graph in ACAD from data contained in an Excel workbook.
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
-
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
-
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.