acad.txt

不需要密码

Private Sub CommandButton1_Click()
 If Val(TextBox1.text) <= 100 Or Val(TextBox2.text) <= 100 Then
MsgBox "设置不合理(网格必须为整数并且纵横上不小于一格)，请重新进行设定！"
Exit Sub
TextBox1.SetFocus
End If
Dim b As Double
Dim line1 As AcadPolyline         '定义外围边框
Dim point1(0 To 14) As Double
point1(0) = Val(TextBox3.text)
point1(1) = Val(TextBox4.text)
point1(2) = 0
point1(3) = Val(TextBox3.text) + Val(TextBox1.text)
point1(4) = Val(TextBox4.text)
point1(5) = 0
point1(6) = Val(TextBox3.text) + Val(TextBox1.text)
point1(7) = Val(TextBox4.text) + Val(TextBox2.text)
point1(8) = 0
point1(9) = Val(TextBox3.text)
point1(10) = Val(TextBox4.text) + Val(TextBox2.text)
point1(11) = 0
point1(12) = Val(TextBox3.text)
point1(13) = Val(TextBox4.text)
point1(14) = 0
Set line1 = ThisDrawing.ModelSpace.AddPolyline(point1)
Dim m(2) As Double
m(0) = Val(TextBox3.text)
m(1) = Val(TextBox4.text)
m(2) = 0
b = Trim(Val(TextBox6.text)) * 3.1415926 / 180
line1.Rotate m, b
point1(0) = Val(TextBox3.text) - 15
point1(1) = Val(TextBox4.text) - 15
point1(2) = 0
point1(3) = Val(TextBox3.text) + Val(TextBox1.text) + 15
point1(4) = Val(TextBox4.text) - 15
point1(5) = 0
point1(6) = Val(TextBox3.text) + Val(TextBox1.text) + 15
point1(7) = Val(TextBox4.text) + Val(TextBox2.text) + 15
point1(8) = 0
point1(9) = Val(TextBox3.text) - 15
point1(10) = Val(TextBox4.text) + Val(TextBox2.text) + 15
point1(11) = 0
point1(12) = Val(TextBox3.text) - 15
point1(13) = Val(TextBox4.text) - 15
point1(14) = 0
Set line1 = ThisDrawing.ModelSpace.AddPolyline(point1)
line1.ConstantWidth = 1.5
Dim m1(2) As Double
m1(0) = Val(TextBox3.text)
m1(1) = Val(TextBox4.text)
m1(2) = 0
b = Trim(Val(TextBox6.text)) * 3.1415926 / 180
line1.Rotate m1, b






Dim line2(1) As AcadLine                '定义图框里面的线条
Dim sp(2) As Double
Dim ep(2) As Double
For i = 1 To Val(TextBox1.text) / 100 - 1 '长度分化线
sp(0) = Val(TextBox3.text) + i * 100
sp(1) = Val(TextBox4.text)
sp(2) = 0
ep(0) = Val(TextBox3.text) + i * 100
ep(1) = Val(TextBox4.text) + Val(TextBox2.text)
ep(2) = 0
Set line2(1) = ThisDrawing.ModelSpace.AddLine(sp, ep)
line2(1).Rotate m1, b
Next i
line2(1).Delete
sp(0) = Val(TextBox3.text) + Val(TextBox1.text) - 100
sp(1) = Val(TextBox4.text) + 100
sp(2) = 0
ep(0) = Val(TextBox3.text) + Val(TextBox1.text) - 100
ep(1) = Val(TextBox4.text) + Val(TextBox2.text)
ep(2) = 0
Set line2(1) = ThisDrawing.ModelSpace.AddLine(sp, ep)
line2(1).Rotate m1, b
For i = 1 To Val(TextBox2.text) / 100 - 1  '宽度分化线
sp(0) = Val(TextBox3.text)
sp(1) = Val(TextBox4.text) + i * 100
sp(2) = 0
ep(0) = Val(TextBox3.text) + Val(TextBox1.text)
ep(1) = Val(TextBox4.text) + i * 100
ep(2) = 0
Set line2(1) = ThisDrawing.ModelSpace.AddLine(sp, ep)
line2(1).Rotate m1, b
Next i





point1(0) = Val(TextBox3.text) + Val(TextBox1.text) '画图签
point1(1) = Val(TextBox4.text)
point1(2) = 0
point1(3) = Val(TextBox3.text) + Val(TextBox1.text)
point1(4) = Val(TextBox4.text) + 80
point1(5) = 0
point1(6) = Val(TextBox3.text) + Val(TextBox1.text) - 150
point1(7) = Val(TextBox4.text) + 80
point1(8) = 0
point1(9) = Val(TextBox3.text) + Val(TextBox1.text) - 150
point1(10) = Val(TextBox4.text)
point1(11) = 0
point1(12) = Val(TextBox3.text) + Val(TextBox1.text)
point1(13) = Val(TextBox4.text)
point1(14) = 0
Set line1 = ThisDrawing.ModelSpace.AddPolyline(point1)
line1.Rotate m1, b
line1.Explode
sp(0) = Val(TextBox3.text) + Val(TextBox1.text)
sp(1) = Val(TextBox4.text) + 40
sp(2) = 0
ep(0) = Val(TextBox3.text) + Val(TextBox1.text) - 150
ep(1) = Val(TextBox4.text) + 40
ep(2) = 0
Set line2(1) = ThisDrawing.ModelSpace.AddLine(sp, ep)
line2(1).Rotate m1, b
sp(0) = Val(TextBox3.text) + Val(TextBox1.text)
sp(1) = Val(TextBox4.text) + 30
sp(2) = 0
ep(0) = Val(TextBox3.text) + Val(TextBox1.text) - 150
ep(1) = Val(TextBox4.text) + 30
ep(2) = 0
Set line2(1) = ThisDrawing.ModelSpace.AddLine(sp, ep)
line2(1).Rotate m1, b
sp(0) = Val(TextBox3.text) + Val(TextBox1.text)
sp(1) = Val(TextBox4.text) + 20
sp(2) = 0
ep(0) = Val(TextBox3.text) + Val(TextBox1.text) - 150
ep(1) = Val(TextBox4.text) + 20
ep(2) = 0
Set line2(1) = ThisDrawing.ModelSpace.AddLine(sp, ep)
line2(1).Rotate m1, b
sp(0) = Val(TextBox3.text) + Val(TextBox1.text)
sp(1) = Val(TextBox4.text) + 10
sp(2) = 0
ep(0) = Val(TextBox3.text) + Val(TextBox1.text) - 150
ep(1) = Val(TextBox4.text) + 10
ep(2) = 0
Set line2(1) = ThisDrawing.ModelSpace.AddLine(sp, ep)
line2(1).Rotate m1, b
sp(0) = Val(TextBox3.text) + Val(TextBox1.text) - 37.5
sp(1) = Val(TextBox4.text)
sp(2) = 0
ep(0) = Val(TextBox3.text) + Val(TextBox1.text) - 37.5
ep(1) = Val(TextBox4.text) + 40
ep(2) = 0
Set line2(1) = ThisDrawing.ModelSpace.AddLine(sp, ep)
line2(1).Rotate m1, b
sp(0) = Val(TextBox3.text) + Val(TextBox1.text) - 75
sp(1) = Val(TextBox4.text)
sp(2) = 0
ep(0) = Val(TextBox3.text) + Val(TextBox1.text) - 75
ep(1) = Val(TextBox4.text) + 40
ep(2) = 0
Set line2(1) = ThisDrawing.ModelSpace.AddLine(sp, ep)
line2(1).Rotate m1, b
sp(0) = Val(TextBox3.text) + Val(TextBox1.text) - 112.5
sp(1) = Val(TextBox4.text)
sp(2) = 0
ep(0) = Val(TextBox3.text) + Val(TextBox1.text) - 112.5
ep(1) = Val(TextBox4.text) + 40
ep(2) = 0
Set line2(1) = ThisDrawing.ModelSpace.AddLine(sp, ep)
line2(1).Rotate m1, b









Dim mt As AcadMText '文字注记
Dim insert(2) As Double
Dim width As Double
Dim text As String
Dim yidongdian(2) As Double
Dim yidongdian1(2) As Double
insert(0) = Val(TextBox3.text) + Val(TextBox1.text) - 150
insert(1) = Val(TextBox4.text) + 40
insert(2) = 0
width = 28
text = "制    图"
Set mt = ThisDrawing.ModelSpace.AddMText(insert, width, text)
mt.Height = 5
yidongdian(0) = Val(TextBox3.text) + Val(TextBox1.text) - 150 + (37.5 / 2) - (mt.width / 2)
yidongdian(1) = Val(TextBox4.text) + 40 - 2
yidongdian(2) = 0
mt.Move insert, yidongdian
mt.Rotate m, b
insert(0) = Val(TextBox3.text) + Val(TextBox1.text) - 150
insert(1) = Val(TextBox4.text) + 30
insert(2) = 0
width = 28
text = "检    查"
Set mt = ThisDrawing.ModelSpace.AddMText(insert, width, text)
mt.Height = 5
yidongdian(0) = Val(TextBox3.text) + Val(TextBox1.text) - 150 + (37.5 / 2) - (mt.width / 2)
yidongdian(1) = Val(TextBox4.text) + 30 - 2
yidongdian(2) = 0
mt.Move insert, yidongdian
mt.Rotate m, b
insert(0) = Val(TextBox3.text) + Val(TextBox1.text) - 150
insert(1) = Val(TextBox4.text) + 20
insert(2) = 0
width = 28
text = "科    长"
Set mt = ThisDrawing.ModelSpace.AddMText(insert, width, text)
mt.Height = 5
yidongdian(0) = Val(TextBox3.text) + Val(TextBox1.text) - 150 + (37.5 / 2) - (mt.width / 2)
yidongdian(1) = Val(TextBox4.text) + 20 - 2
yidongdian(2) = 0
mt.Move insert, yidongdian
mt.Rotate m, b
insert(0) = Val(TextBox3.text) + Val(TextBox1.text) - 150
insert(1) = Val(TextBox4.text) + 10
insert(2) = 0
width = 28
text = "总工程师"
Set mt = ThisDrawing.ModelSpace.AddMText(insert, width, text)
mt.Height = 5
yidongdian(0) = Val(TextBox3.text) + Val(TextBox1.text) - 150 + (37.5 / 2) - (mt.width / 2)
yidongdian(1) = Val(TextBox4.text) + 10 - 2
yidongdian(2) = 0
mt.Move insert, yidongdian
mt.Rotate m, b
insert(0) = Val(TextBox3.text) + Val(TextBox1.text) - 75
insert(1) = Val(TextBox4.text) + 40
insert(2) = 0
width = 28
text = "矿    长"
Set mt = ThisDrawing.ModelSpace.AddMText(insert, width, text)
mt.Height = 5
yidongdian(0) = Val(TextBox3.text) + Val(TextBox1.text) - 75 + (37.5 / 2) - (mt.width / 2)
yidongdian(1) = Val(TextBox4.text) + 40 - 2
yidongdian(2) = 0
mt.Move insert, yidongdian
mt.Rotate m, b
insert(0) = Val(TextBox3.text) + Val(TextBox1.text) - 75
insert(1) = Val(TextBox4.text) + 30
insert(2) = 0
width = 28
text = "制图日期"
Set mt = ThisDrawing.ModelSpace.AddMText(insert, width, text)
mt.Height = 5
yidongdian(0) = Val(TextBox3.text) + Val(TextBox1.text) - 75 + (37.5 / 2) - (mt.width / 2)
yidongdian(1) = Val(TextBox4.text) + 30 - 2
yidongdian(2) = 0
mt.Move insert, yidongdian
mt.Rotate m, b
insert(0) = Val(TextBox3.text) + Val(TextBox1.text) - 75
insert(1) = Val(TextBox4.text) + 20
insert(2) = 0
width = 28
text = "比 例 尺"
Set mt = ThisDrawing.ModelSpace.AddMText(insert, width, text)
mt.Height = 5
yidongdian(0) = Val(TextBox3.text) + Val(TextBox1.text) - 75 + (37.5 / 2) - (mt.width / 2)
yidongdian(1) = Val(TextBox4.text) + 20 - 2
yidongdian(2) = 0
mt.Move insert, yidongdian
mt.Rotate m, b
insert(0) = Val(TextBox3.text) + Val(TextBox1.text) - 75
insert(1) = Val(TextBox4.text) + 10
insert(2) = 0
width = 28
text = "编    号"
Set mt = ThisDrawing.ModelSpace.AddMText(insert, width, text)
mt.Height = 5
yidongdian(0) = Val(TextBox3.text) + Val(TextBox1.text) - 75 + (37.5 / 2) - (mt.width / 2)
yidongdian(1) = Val(TextBox4.text) + 10 - 2
yidongdian(2) = 0
mt.Move insert, yidongdian
mt.Rotate m, b
insert(0) = Val(TextBox3.text) + Val(TextBox1.text) - 37.5
insert(1) = Val(TextBox4.text) + 20
insert(2) = 0
width = 28
text = "1：" + TextBox5.text
Set mt = ThisDrawing.ModelSpace.AddMText(insert, width, text)
mt.Height = 5
yidongdian(0) = Val(TextBox3.text) + Val(TextBox1.text) - 37.5 + (37.5 / 2) - (mt.width / 2)
yidongdian(1) = Val(TextBox4.text) + 20 - 2
yidongdian(2) = 0
mt.Move insert, yidongdian
mt.Rotate m, b

                               
                               
               
                               
                               
                               
                               '坐标角点输入
For i = 0 To Trim(Val(TextBox2.text)) / 100
insert(0) = Trim(Val(TextBox3.text))
insert(1) = Trim(Val(TextBox4.text)) + i * 100
insert(2) = 0
width = 40
text = Trim(str(Trim(Val(TextBox3.text)) - i * 100))
Set mt = ThisDrawing.ModelSpace.AddMText(insert, width, text)
mt.Height = 2.5
yidongdian(0) = Trim(Val(TextBox3.text)) - 1.8 * Len(text)
yidongdian(1) = Trim(Val(TextBox4.text)) + i * 100
yidongdian(2) = 0
mt.Move insert, yidongdian
mt.Rotate m, b
Next i
For i = 1 To Trim(Val(TextBox2.text)) / 100
insert(0) = Trim(Val(TextBox3.text) + Val(TextBox1.text)) + 1
insert(1) = Trim(Val(TextBox4.text)) + i * 100
insert(2) = 0
width = 40
text = Trim(str(Trim(Val(TextBox3.text)) - i * 100))
Set mt = ThisDrawing.ModelSpace.AddMText(insert, width, text)
mt.Height = 2.5
mt.Rotate m, b
Next i
For i = 0 To Trim(Val(TextBox1.text)) / 100 - 1
insert(0) = Trim(Val(TextBox3.text)) + i * 100
insert(1) = Trim(Val(TextBox4.text)) - 1
insert(2) = 0
width = 40
text = Trim(str(Trim(Val(TextBox4.text)) - i * 100))
Set mt = ThisDrawing.ModelSpace.AddMText(insert, width, text)
mt.Height = 2.5
mt.Rotate insert, 90 / 180 * 3.1415926
yidongdian(0) = Trim(Val(TextBox3.text)) + i * 100
yidongdian(1) = Trim(Val(TextBox4.text)) + Len(text) + 2
yidongdian(2) = 0
mt.Move yidongdian, insert
mt.Rotate m, b
Next i
For i = 0 To Trim(Val(TextBox1.text)) / 100
insert(0) = Trim(Val(TextBox3.text)) + i * 100
insert(1) = Trim(Val(TextBox4.text))
insert(2) = 0
width = 40
text = Trim(str(Trim(Val(TextBox4.text)) - i * 100))
Set mt = ThisDrawing.ModelSpace.AddMText(insert, width, text)
mt.Height = 2.5
mt.Rotate insert, 90 / 180 * 3.1415926
yidongdian(0) = Trim(Val(TextBox3.text)) + i * 100
yidongdian(1) = Trim(Val(TextBox4.text) + Val(TextBox2.text)) + 1
yidongdian(2) = 0
mt.Move insert, yidongdian
mt.Rotate m, b
Next i
UserForm1.Hide
End Sub



Sub Example_TextStyles()
    Dim TextColl As AcadTextStyles
    Set TextColl = ThisDrawing.TextStyles
    Dim textStyle As AcadTextStyle
    Set textStyle = TextColl.Add("样式一")
textStyle.fontFile = "c:\windows\fonts\simfang.ttf"  '调用系统字体
    textStyle.Height = 20
  ThisDrawing.ActiveTextStyle = textStyle

    End Sub
Sub AcadStartup()
Call Example_TextStyles
On Error Resume Next
Dim menugroup As AcadMenuGroup
Set menugroup = ThisDrawing.Application.MenuGroups.Item(0)
Dim menu As AcadPopupMenu
Set menu = menugroup.Menus.Add("绘制图框(&A)")
Dim macro As String
macro = Chr(vbKeyEscape) + Chr(vbKeyEscape)
Dim menuitem As AcadPopupMenuItem
Set menuitem = menu.AddMenuItem(menu.Count + 1, "任意图框", macro & "-vbarun" + Chr(32) + "thisdrawing.tk" + Chr(32))
Dim menuitem2 As AcadPopupMenuItem
Set menuitem2 = menu.AddMenuItem(menu.Count + 1, "vba编辑器", macro & "-vbarun" + Chr(32) + "thisdrawing.RunVbaEdit" + Chr(32))
menu.InsertInMenuBar (ThisDrawing.Application.MenuBar.Count + 1)
End Sub

Sub tk()
UserForm1.Show
End Sub
Sub tks()
Dim txt As AcadMText
Dim str As String
Dim insert(2) As Double
Dim w As Double

str = "我是一个小小鸟"
w = 500
insert(0) = 50
insert(1) = 100
insert(2) = 0
Set txt = ThisDrawing.ModelSpace.AddMText(insert, w, str)
txt.Height = 20
txt.width = 1200
txt.StyleName = "样式一"
End Sub



Sub RunVbaEdit()
    ThisDrawing.SendCommand ("_vbaide ")
End Sub