绘制坐标轴的VBA程序，有窗体，实用
<P class=MsoNormal style="MARGIN: 0cm 0cm 0pt 21pt; TEXT-INDENT: 21pt">绘制如下图所示的坐标轴<P class=MsoNormal style="MARGIN: 0cm 0cm 0pt 21pt; TEXT-INDENT: 21pt">
<P class=MsoNormal style="MARGIN: 0cm 0cm 0pt 21pt; TEXT-INDENT: 21pt">100┫
<P class=MsoNormal style="MARGIN: 0cm 0cm 0pt 21pt; TEXT-INDENT: 21pt; mso-para-margin-left: 2.0gd"> ┃<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
<P class=MsoNormal style="MARGIN: 0cm 0cm 0pt 21pt; TEXT-INDENT: 21pt">10 ┫
<P class=MsoNormal style="MARGIN: 0cm 0cm 0pt 21pt; TEXT-INDENT: 21pt"> ┗━┳━┳━┳<o:p></o:p>
<P class=MsoNormal style="MARGIN: 0cm 0cm 0pt 21pt; TEXT-INDENT: 21pt"><FONT face="Times New Roman"> 0 10 20 30</FONT>
<P class=MsoNormal style="MARGIN: 0cm 0cm 0pt 21pt; TEXT-INDENT: 21pt">
<P class=MsoNormal style="MARGIN: 0cm 0cm 0pt 21pt; TEXT-INDENT: 21pt">Public Sub xlabel()
<P class=MsoNormal style="MARGIN: 0cm 0cm 0pt 21pt; TEXT-INDENT: 21pt"> '在模型空间中创建文字对象<BR> '坐标轴刻度<BR> <BR> Dim insPoint(0 To 2) As Double '声明插入点<BR> Dim textHeight As Double '声明文字高度<BR> Dim textStr As String '声明字符串<BR> Dim textObj As AcadText '声明文字对象<BR> <BR> Dim textrot As Single '文字旋转<BR> textrot = Val(UserForm1.TextBox10.text) * 0.017453292<BR> <BR> Dim j As Integer<BR> <BR> Dim i As Long '点距<BR> i = Val(UserForm1.TextBox3.text)<BR> <BR> Dim textlabelend As Long '终点<BR> textlabelend = Val(UserForm1.TextBox2.text)
<P class=MsoNormal style="MARGIN: 0cm 0cm 0pt 21pt; TEXT-INDENT: 21pt"> Dim textlabel As Long '起点<BR> textlabel = Val(UserForm1.TextBox1.text)<BR> <BR> Dim xdist As Long<BR> xdist = textlabelend - textlabel<BR> <BR> Dim labelnum As Long<BR> labelnum = xdist / i<BR> <BR> textHeight = 2 '文字高度设置为 2.0<BR> textStr = Str$(textlabel)<BR> <BR> '设置字符串
<P class=MsoNormal style="MARGIN: 0cm 0cm 0pt 21pt; TEXT-INDENT: 21pt"> insPoint(0) = -1 '设置插入点的 x 坐标<BR> insPoint(1) = -6 '设置插入点的 y 坐标<BR> insPoint(2) = 0 '设置插入点的 z 坐标
<P class=MsoNormal style="MARGIN: 0cm 0cm 0pt 21pt; TEXT-INDENT: 21pt"> For j = 0 To labelnum Step 1
<P class=MsoNormal style="MARGIN: 0cm 0cm 0pt 21pt; TEXT-INDENT: 21pt"> '创建 Text 对象<BR> Set textObj = ThisDrawing.ModelSpace.AddText _<BR> (textStr, insPoint, textHeight)<BR> <BR> textObj.ObliqueAngle = 0<BR> textObj.Rotation = textrot<BR> textObj.Update<BR> <BR> insPoint(0) = insPoint(0) + i<BR> textlabel = textlabel + i<BR> textStr = Str$(textlabel)<BR> <BR> Next j<BR>
<P class=MsoNormal style="MARGIN: 0cm 0cm 0pt 21pt; TEXT-INDENT: 21pt"><BR> ' 在模型空间中添加一条直线作为坐标轴<BR> <BR> Dim lineObj As AcadLine<BR> Dim startPoint(0 To 2) As Double<BR> Dim endPoint(0 To 2) As Double<BR> <BR> ' 定义直线的起点<BR> ' 和端点<BR> startPoint(0) = 0<BR> startPoint(1) = 0<BR> startPoint(2) = 0<BR> endPoint(0) = xdist<BR> endPoint(1) = 0<BR> endPoint(2) = 0<BR> <BR> ' 在模型空间中创建直线<BR> Set lineObj = ThisDrawing. _<BR> ModelSpace.AddLine _<BR> (startPoint, endPoint)<BR>
<P class=MsoNormal style="MARGIN: 0cm 0cm 0pt 21pt; TEXT-INDENT: 21pt"> ' 在模型空间中添加短直线作为刻度线<BR> <BR> Dim k As Integer<BR> Dim slineObj As AcadLine<BR> Dim sstartPoint(0 To 2) As Double<BR> Dim sendPoint(0 To 2) As Double<BR> <BR> ' 定义直线的起点<BR> ' 和端点<BR> sstartPoint(0) = 0<BR> sstartPoint(1) = 0<BR> sstartPoint(2) = 0<BR> sendPoint(0) = 0<BR> sendPoint(1) = -4<BR> sendPoint(2) = 0<BR> <BR> ' 在模型空间中创建短直线<BR> <BR> For k = 0 To labelnum Step 1<BR> <BR> Set slineObj = ThisDrawing. _<BR> ModelSpace.AddLine _<BR> (sstartPoint, sendPoint)<BR> <BR> sstartPoint(0) = sstartPoint(0) + i<BR> sendPoint(0) = sendPoint(0) + i<BR> <BR> Next k<BR> <BR>End Sub
<P class=MsoNormal style="MARGIN: 0cm 0cm 0pt 21pt; TEXT-INDENT: 21pt">
页:
[1]