T
tombates
The following keeps incrementing the variable dist such that the text
that should start where the inspt (text insertion point) is instead
starts a multiple of dist from the inspt
For example if my excel begrow is 10, the text in autocad is starting
(dist * begrow row + 1).
Help
Mary
------------------------
Dim rownum As Long
Dim textstring As String
Dim height1 As Double
Dim excel As Object
Dim inspt As Variant
Dim lastrow As Long
Dim rng As Range
Dim endrow As Long
Dim endcol As Long
Dim begrow As Long
Dim begcol As Long
Dim acad As Object
Private Sub CommandButton1_Click()
Set excel = GetObject(, "Excel.Application")
If Err <> 0 Then
Err.Clear
Set excel = CreateObject("Excel.Application")
If Err <> 0 Then
MsgBox "Could not load Excel.", vbExclamation
End
End If
End If
On Error GoTo 0
excel.Visible = True
excel.Application.WindowState = xlMaximized
'excel.Sheets("Sheet1").Select
Set excelsheet = excel.ActiveWorkbook.Sheets("Sheet1")
Set rng = excel.Application.InputBox(Prompt:="Select range", Type:=8)
begrow = rng(1).Row
begcol = rng(1).Column
endrow = rng(rng.Count).Row
endcol = rng(rng.Count).Column
MsgBox begrow
MsgBox endrow
excelacadform.Hide
excel.Application.WindowState = xlMinimized
excel.Visible = False
Dim dist As Double
Dim dist1 As Double
Set acad = GetObject(, "autocad.Application")
height1 = ThisDrawing.Utility.GetReal("text height: ")
dist1 = ThisDrawing.Utility.GetReal("space between lines: ")
PtFlag1 = True
col = begcol
rownum = begrow
'dist = 0
While PtFlag1 = True
inspt = ThisDrawing.Utility.GetPoint(, "Enter a point: ")
inspt(1) = inspt(1) - dist
PtFlag = True
rownum = 1
dist = 0
While PtFlag = True
textstring = excelsheet.Cells(rownum, col).Value
'inspt(1) = inspt(1) - dist
Set textObj = ThisDrawing.ModelSpace.AddText(textstring, inspt,
height1)
textObj.HorizontalAlignment = acHorizontalAlignmentMiddle
textObj.TextAlignmentPoint = inspt
'MsgBox dist & dist1
inspt(1) = inspt(1) - dist
rownum = rownum + 1
dist = dist1
'inspt(1) = inspt(1) - dist
If rownum = (endrow + 1) Then PtFlag = False
'inspt(1) = inspt(1) - dist
Wend
col = col + 1
'inspt(1) = inspt(1) - dist
If col = (endcol + 1) Then PtFlag1 = False
'inspt(1) = inspt(1) - dist
Wend
excel.Visible = True
End Sub
that should start where the inspt (text insertion point) is instead
starts a multiple of dist from the inspt
For example if my excel begrow is 10, the text in autocad is starting
(dist * begrow row + 1).
Help
Mary
------------------------
Dim rownum As Long
Dim textstring As String
Dim height1 As Double
Dim excel As Object
Dim inspt As Variant
Dim lastrow As Long
Dim rng As Range
Dim endrow As Long
Dim endcol As Long
Dim begrow As Long
Dim begcol As Long
Dim acad As Object
Private Sub CommandButton1_Click()
Set excel = GetObject(, "Excel.Application")
If Err <> 0 Then
Err.Clear
Set excel = CreateObject("Excel.Application")
If Err <> 0 Then
MsgBox "Could not load Excel.", vbExclamation
End
End If
End If
On Error GoTo 0
excel.Visible = True
excel.Application.WindowState = xlMaximized
'excel.Sheets("Sheet1").Select
Set excelsheet = excel.ActiveWorkbook.Sheets("Sheet1")
Set rng = excel.Application.InputBox(Prompt:="Select range", Type:=8)
begrow = rng(1).Row
begcol = rng(1).Column
endrow = rng(rng.Count).Row
endcol = rng(rng.Count).Column
MsgBox begrow
MsgBox endrow
excelacadform.Hide
excel.Application.WindowState = xlMinimized
excel.Visible = False
Dim dist As Double
Dim dist1 As Double
Set acad = GetObject(, "autocad.Application")
height1 = ThisDrawing.Utility.GetReal("text height: ")
dist1 = ThisDrawing.Utility.GetReal("space between lines: ")
PtFlag1 = True
col = begcol
rownum = begrow
'dist = 0
While PtFlag1 = True
inspt = ThisDrawing.Utility.GetPoint(, "Enter a point: ")
inspt(1) = inspt(1) - dist
PtFlag = True
rownum = 1
dist = 0
While PtFlag = True
textstring = excelsheet.Cells(rownum, col).Value
'inspt(1) = inspt(1) - dist
Set textObj = ThisDrawing.ModelSpace.AddText(textstring, inspt,
height1)
textObj.HorizontalAlignment = acHorizontalAlignmentMiddle
textObj.TextAlignmentPoint = inspt
'MsgBox dist & dist1
inspt(1) = inspt(1) - dist
rownum = rownum + 1
dist = dist1
'inspt(1) = inspt(1) - dist
If rownum = (endrow + 1) Then PtFlag = False
'inspt(1) = inspt(1) - dist
Wend
col = col + 1
'inspt(1) = inspt(1) - dist
If col = (endcol + 1) Then PtFlag1 = False
'inspt(1) = inspt(1) - dist
Wend
excel.Visible = True
End Sub