请看如下程序，如何实现这些功能？
本帖最后由 作者 于 2003-8-29 12:56:46 编辑Private Sub CommandButton1_Click()
Dim a As AcadText
Dim P1(2) As Double
Dim I As Integer,j as integer
I = 1
P1(0) = 0
P1(1) = 0
P1(2) = 0
Do While I < 21
P1(1) = P1(1) + 13
j=3
do while j>0
Set a = ThisDrawing.ModelSpace.AddText("F" & I & "-A" & j & "/4.2dBm" , P1, 3.5)
ThisDrawing.Application.Update
j=j-1
loop
I = I + 1
Loop
End Sub
1。如何在每次CAD运行时就加载本程序。
2。如何利用鼠标在屏幕上拾取获得文字间距。
3。是否可以在复制的同时实现文字F1-F21的系列 给你个回车继续填写，取消则退出的程序：
'判断某一键盘键自上次调用该函数以来是否被按过的API函数
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Const VK_ESCAPE = &H1B
Sub DimNum()
On Error Resume Next
Dim ESC As Long
GetAsyncKeyState VK_ESCAPE
Dim kk As String
Dim a As AcadText
Dim P1 As Variant
Dim I As Integer
P1 = ThisDrawing.Utility.GetPoint(, vbCrLf & " 请选择标注点：")
Dim Dist As Double
Dist = ThisDrawing.Utility.GetDistance(P1, vbCrLf & " 请输入距离：")
I = ThisDrawing.Utility.GetInteger(vbCrLf & " 请输入起始的楼层号：")
Do
kk = ThisDrawing.Utility.GetKeyword(vbCrLf & " 按回车标注第" & I & "层，按取消键退出标注")
ESC = GetAsyncKeyState(VK_ESCAPE)
If ESC <> 0 Then
Exit Do
Else
Set a = ThisDrawing.ModelSpace.AddText("F" & I & "层", P1, 3.5)
ThisDrawing.Application.Update
I = I + 1
P1(1) = P1(1) + Dist
End If
Loop
End Sub
页:
[1]