楼主的意思桩号是不是要旋转90度,并且所有的桩号在一条水平线上,所有的桩号等间距?
按此思路编的dvb程序如下:
Option Base 1
Option Explicit
Private Sub CommandButton1_Click()
UserForm1.Hide
On Error Resume Next
Dim excelApp As Excel.Application
Set excelApp = GetObject(, "Excel.Application")
If Err Then
MsgBox Err.Description
Exit Sub
End If
ForceForegroundWindow excelApp.hWnd
Dim myRange As Range
Set myRange = excelApp.InputBox(Prompt:="选择要求的单元格区域:", Type:=8)
If Err Then
MsgBox Err.Description
Exit Sub
End If
Dim M As Long
Dim N As Long
M = myRange.Rows.Count
N = myRange.Columns.Count
ReDim textObj(M, N) As AcadText
ReDim TextStr(M, N) As String
Dim i As Long
Dim j As Long
For i = 1 To M
For j = 1 To N
TextStr(i, j) = myRange.Cells(i, j).Text
Next
Next
ForceForegroundWindow AcadApplication.hWnd
Dim InsertPnt As Variant
InsertPnt = ThisDrawing.Utility.GetPoint(, "指定插入点: ")
Dim VDistOfText As Double
Dim HDistOfText As Double
Dim TextHeight As Double
VDistOfText = Val(TextBox1.Text)
HDistOfText = Val(TextBox2.Text)
TextHeight = Val(TextBox3.Text)
Dim Pnt As Variant
For i = 1 To M
For j = 1 To N
If TextStr(i, j) <> "" Then
Set textObj(i, j) = ThisDrawing.ModelSpace.AddText(TextStr(i, j), InsertPnt, TextHeight)
Pnt = textObj(i, j).InsertionPoint
Pnt(0) = InsertPnt(0) + (j - 1) * HDistOfText
Pnt(1) = InsertPnt(1) - (i - 1) * VDistOfText
textObj(i, j).InsertionPoint = Pnt
textObj(i, j).Rotation = 4 * Atn(1) * Val(TextBox4.Text) / 180
End If
Next
Next
ThisDrawing.Regen acActiveViewport
UserForm1.Show
End Sub
Private Sub CommandButton2_Click()
End
End Sub
Private Sub UserForm_Initialize()
TextBox1.Text = 0
TextBox2.Text = 50
TextBox3.Text = 5
TextBox4.Text = 90
End Sub
程序运行界面:
列偏移为桩号文字在cad图中的间距,桩号文字横放在excel表格中。