请看如下程序，如何实现这些功能？

XJ_HE · 发表于 2003-8-29 09:46:00

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 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 Sub1。如何在每次CAD运行时就加载本程序。
2。如何利用鼠标在屏幕上拾取获得文字间距。
3。是否可以在复制的同时实现文字F1-F21的系列

mccad · 发表于 2003-8-29 10:26:00

给你个回车继续填写，取消则退出的程序：

copy


'判断某一键盘键自上次调用该函数以来是否被按过的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

请看如下程序，如何实现这些功能？

发表回复

精选推荐