Importing Excel data and draw lines (Data is "From" "To" ponts of Line or length of lines

[prasadcivil]

Dear All my well wishers...please solve my typical problem..please..my data as below(From Excel)

S.No. Length(m)
From To Remarks
1. 10 11.5 soil
2. 13 14 soil
3. 10 11.5 concrete strata
4. 10 12 Bitumen Strata


How to draw lines from above data(From Excel) by importing, using visual lisp.PLEASE RESPOND POSITIVELYY.PLZZZZ

[MICHAEL.JONES]

You're posting in the VBA forum, not the LISP forum...

I've done what you're asking in VBA, but not in VLISP.

Fixo from the theswamp.org supplied the following code, which checks for a valid AutoCAD install.


' require references to:

'Windows Script Host Object model

'AutoCAD 20XX Type Library

'AutoCAD Focus Control for VBA Type Library

'in the Tools -> Options -> General -> Error Trapping box -> Check "Break on Unhandled Errors"

Function acadVerNum() As String
Dim verNum As String

verNum = "HKEY_CLASSES_ROOT\AutoCAD.Drawing\CurVer\"
Dim wsh As Object

On Error GoTo ErrorHandler
'access Windows scripting
Set wsh = CreateObject("WScript.Shell")
'read key from registry
Dim resKey As String
resKey = wsh.RegRead(verNum)

acadVerNum = Right(resKey, 2)
Exit Function

ErrorHandler:
'key was not found
acadVerNum = ""

End Function

Here's some VBA code which runs in Excel and creates a graph in AutoCAD...you _should_ be able to leverage the code to create a solution for your project.

Good luck!


Sub DrawChart(MaxHor As Single, MaxVert As Single, VertLbl As String, HorScale As Single, VertScale As Single, AxisStep)

Dim Txt0LayClr As Integer, Txt1LayClr As Integer, GridColor As Integer

Dim LineTypeObject As AcadLineType
Dim GraphLineHor As AcadLine, GraphLineVer As AcadLine, GridLineHor As AcadLine
Dim GridLineVer As AcadLine, TickLine As AcadLine, ChartLine As AcadLine

Dim TickLabel As AcadText
Dim AxixLabel As AcadText, TempText As AcadText

Dim TextString As String, LineType As String, LayerName As String
Dim TxtLayName As String, BrdrLayName As String, GridLayName As String
Dim Zero As String, TxtHdrLayName As String

Dim ticklength As Double
Dim MaxX As Double, MaxY As Double
Dim Xscale As Double, Yscale As Double

Dim LabelTxtPt(0 To 2) As Double
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

Dim BigTxt As Double, MedTxt As Double, SmallTxt As Double

Dim acad As AutoCAD.AcadApplication
Dim adoc As AutoCAD.AcadDocument
Dim aspace As AcadBlock
Dim Alayer As AcadLayer
Dim entArray() As AcadEntity

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

' Setup Layers for text, grids, and borders
TxtLayName = "Text0"
TxtHdrLayName = "Text1"
Txt0LayClr = 11
Txt1LayClr = 10

BrdrLayName = "P0C"
GridLayName = "GRID"
GridColor = 253

MaxX = MaxHor ' Passed into the routine
MaxY = MaxVert ' Passed into the routine

Call MakeSetLayer(TxtLayName, 11)
Call MakeSetLayer(BrdrLayName, 1)
Call MakeSetLayer(GridLayName, 253)

If adoc.ActiveLayer.Lock Then
adoc.ActiveLayer.Lock = False
End If

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

' Note: The chart is drawn in Autocad based on 1 = 1

Xscale = HorScale: Yscale = VertScale

' Setup the x-axis and y-axis scaling based on the HorScale variable
Xscale = HorScale: Yscale = VertScale

'If HorScale >= 1# Then
' Xscale = 1 / HorScale: Yscale = 1#
'Else
' Xscale = 1#: Yscale = HorScale
'End If

' Setup the values for the text height
BigTxt = 12 ' Axis labels
MedTxt = 10 ' Tick labels
SmallTxt = 8 ' Data series labels

' Size the 'tick'
ticklength = 10

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

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

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

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

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

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

' Label Vertical Axis
TextPoint(1) = (MaxY * Yscale) / 2
TextPoint(0) = -5# * BigTxt
TextPoint(2) = 0#
TextString = VertLbl
Set TempText = aspace.AddText(TextString, TextPoint, BigTxt)
With TempText
.Rotation = pi() / -2
.Alignment = acAlignmentTopCenter
.TextAlignmentPoint = TextPoint
End With

' Place and label the tick marks and grid lines
Dim i As Integer
' Draw ticks and label for the horizontal axis
For i = 0 To MaxX * Xscale Step (AxisStep / 2)
Select Case (i Mod AxisStep) ' need to have the scale correct
Case 0
MakeSetLayer (BrdrLayName)
TickPtStart(0) = CDbl(i): TickPtStart(1) = 0#: TickPtStart(2) = 0#
TickPtEnd(0) = CDbl(i): TickPtEnd(1) = (-1 * ticklength): TickPtEnd(2) = 0#
Set TickLine = aspace.AddLine(TickPtStart, TickPtEnd)
MakeSetLayer (TxtLayName)
TextString = CStr(i / Xscale)
TickPtEnd(1) = (-1.1 * ticklength)
Set TickLabel = aspace.AddText(TextString, TickPtEnd, MedTxt)
With TickLabel
.Alignment = acAlignmentTopCenter
.TextAlignmentPoint = TickPtEnd
End With
Case Else
MakeSetLayer (BrdrLayName)
TickPtStart(0) = CDbl(i): TickPtStart(1) = 0#: TickPtStart(2) = 0#
TickPtEnd(0) = CDbl(i): TickPtEnd(1) = (-0.5 * ticklength): TickPtEnd(2) = 0#
Set TickLine = aspace.AddLine(TickPtStart, TickPtEnd)
End Select
Next i

' Draw the vertical grid lines
MakeSetLayer (GridLayName)
For i = 10 To (MaxX * Xscale) Step (10)
MakeSetLayer (GridLayName)
GridStart(0) = CDbl(i): GridStart(1) = 0#: GridStart(2) = 0#
GridEnd(0) = CDbl(i): GridEnd(1) = Round(MaxY * Yscale, 0): GridEnd(2) = 0#
Set GridLineVer = aspace.AddLine(GridStart, GridEnd)
Next i

' Draw the ticks for the vertical axis
MakeSetLayer (BrdrLayName)
For i = 0 To MaxY * Yscale Step (AxisStep / 2)
' Only label the 100's
Select Case i Mod (AxisStep)
Case 0
' Label the ticks
MakeSetLayer (BrdrLayName)
TickPtStart(1) = CDbl(i): TickPtStart(0) = 0#: TickPtStart(2) = 0#
TickPtEnd(1) = CDbl(i): TickPtEnd(0) = (-1 * ticklength): TickPtEnd(2) = 0#
LabelTxtPt(1) = CDbl(i): LabelTxtPt(0) = -1.5 * MedTxt: LabelTxtPt(2) = 0#
Set TickLine = aspace.AddLine(TickPtStart, TickPtEnd)
MakeSetLayer (TxtLayName)
TextString = CStr(Round(i / Yscale, 0))
Set TickLabel = aspace.AddText(TextString, LabelTxtPt, MedTxt)
With TickLabel
.Rotation = 0
.Alignment = acAlignmentMiddleRight
.TextAlignmentPoint = LabelTxtPt
End With
Case Else
MakeSetLayer (BrdrLayName)
TickPtStart(1) = CDbl(i): TickPtStart(0) = 0#: TickPtStart(2) = 0#
TickPtEnd(1) = CDbl(i): TickPtEnd(0) = (-0.5 * ticklength): TickPtEnd(2) = 0#
Set TickLine = aspace.AddLine(TickPtStart, TickPtEnd)
End Select
Next i

' Draw the horizontal gridlines
MakeSetLayer (GridLayName)
For i = 10 To MaxY * Yscale Step (10)
GridStart(0) = 0#: GridStart(1) = i: GridStart(2) = 0#
GridEnd(0) = MaxX * Xscale: GridEnd(1) = CDbl(i): GridEnd(2) = 0#
Set GridLineHor = aspace.AddLine(GridStart, GridEnd)
Next i

adoc.Activate
ZoomExtents

' Lock the grid layer
adoc.ActiveLayer.Lock = True

Zero = "0"
MakeSetLayer (Zero)

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

End Sub

[RICVBA]

Hi Mike
I'd like to test the DrawChart routine you posted
but it lacks the MakeSetLayer sub
I guess it takes care of creating/setting a specific layer, but I'm not sure of the second (optional) parameter meaning
can you post it? thanks

[MICHAEL.JONES]

That routine came form theswamp.org. Great forum resource, seems to get a bit more traffic than these AUGI forums (which seem dead to me).



' Routine to switch to a layer or create a layer it it does not already exist in the autocad drawing
'
Sub MakeSetLayer(ByRef strLayer As String, Optional Lcolor As Integer, Optional Ltype As String)

Dim acad As AcadApplication
Set acad = GetObject(, "Autocad.Application")
Dim adoc As AcadDocument
Set adoc = acad.ActiveDocument
Dim aspace As AcadBlock
Set aspace = adoc.ActiveLayout.Block
Dim layCurrent As AcadLayer

On Error Resume Next

Set layCurrent = adoc.Layers(strLayer)

If layCurrent Is Nothing Then
Set layCurrent = adoc.Layers.Add(strLayer)

If layCurrent Is Nothing Then
MsgBox "Error creating layer " & strLayer & "."
Exit Sub
End If
End If

If Lcolor <> "" Then
layCurrent.Color = Lcolor
End If
If Ltype = "" Then
layCurrent.LineType = Ltype
End If
adoc.ActiveLayer = layCurrent

End Sub

[RICVBA]

thank you
I also joined the swamp recentely
but will keep an open eye on this one and some others too.