VBA中编写块命令的问题

dage23wo

在CAD中编程块，每次运行一次，在CAD中多增加一个图形，请大神看看程序。谢谢啦。

2. Private Sub CommandButton1_Click()
   
3. 
   
4. 
   
5. 
   
6. Dim PtPick As Variant
   
7. UserForm1.hide
   
8. PtPick = ThisDrawing.Utility.GetPoint(, "请在屏幕上选择起点:")
   
9. TextBox1.Text = PtPick(0)
   
10. TextBox2.Text = PtPick(1)
    
11. UserForm1.Show
    
12. 
    
13. 
    
14. Dim blkObj As AcadBlock
    
15. Dim insPnt(0 To 2) As Double
    
16.    
    
17.     '设定图块对象的原点坐标
    
18.     insPnt(0) = 0: insPnt(1) = 0: insPnt(2) = 0
    
19.     '在Blocks集合中创建名为TestBlock1的块对象
    
20.     Set blkObj = ThisDrawing.Blocks.Add(insPnt, "TestBlock1")
    
21.    
    
22.    
    
23.    
    
24.     '-------------------------------------------------------------
    
25. 
    
26. 
    
27. Dim cirObj As AcadCircle
    
28. Dim center(0 To 2) As Double
    
29. Dim radius As Double
    
30. 
    
31. 
    
32. center(0) = TextBox1.Text: center(1) = TextBox2.Text: center(2) = 0
    
33. 
    
34. 
    
35. radius = 0
    
36. 
    
37. 
    
38. radius = Val(TextBox3.Text)
    
39. 
    
40.     Set cirObj = blkObj.AddCircle(center, radius)
    
41. 
    
42.     cirObj.color = acRed
    
43.    
    
44.    
    
45.     Dim lineObj As AcadLine
    
46.     Dim sPnt(0 To 2) As Double, ePnt(0 To 2) As Double
    
47.    
    
48.     sPnt(0) = center(0): sPnt(1) = center(1): sPnt(2) = 0
    
49.     ePnt(0) = center(0) + 60: ePnt(1) = center(1) + 80: ePnt(2) = 0
    
50.    
    
51.     '创建一条直线
    
52.     Set lineObj = blkObj.AddLine(sPnt, ePnt)
    
53. 
    
54. 
    
55. 
    
56. '-------------------------------------------------------------
    
57.     '本段代码将把TestBlock1块对象插入到模型空间
    
58.    
    
59.     Dim blkRefObj As AcadBlockReference
    
60.    
    
61.    
    
62.     Dim insertPnt(0 To 2) As Double
    
63.    
    
64.     '指定模型空间的插入点
    
65.     insertPnt(0) = 120: insertPnt(1) = 100: insertPnt(2) = 0
    
66.    
    
67.     '插入图块
    
68.     Set blkRefObj = ThisDrawing.ModelSpace.InsertBlock(insertPnt, "TestBlock1", 1#, 1#, 1#, 0#)
    
69.    
    
70.    
    
71.     blkRefObj.Update
    
72. 
    
73. 
    
74. 
    
75. End Sub
    

Private Sub CommandButton1_Click()<br /> <br /> <br /> <br /> Dim PtPick As Variant<br /> UserForm1.hide<br /> PtPick = ThisDrawing.Utility.GetPoint(, "请在屏幕上选择起点:")<br /> TextBox1.Text = PtPick(0)<br /> TextBox2.Text = PtPick(1)<br /> UserForm1.Show<br /> <br /> <br /> Dim blkObj As AcadBlock<br /> Dim insPnt(0 To 2) As Double<br />     <br />     '设定图块对象的原点坐标<br />     insPnt(0) = 0: insPnt(1) = 0: insPnt(2) = 0<br />     '在Blocks集合中创建名为TestBlock1的块对象<br />     Set blkObj = ThisDrawing.Blocks.Add(insPnt, "TestBlock1")<br />     <br />     <br />     <br />     '-------------------------------------------------------------<br /> <br /> <br /> Dim cirObj As AcadCircle<br /> Dim center(0 To 2) As Double<br /> Dim radius As Double<br /> <br /> <br /> center(0) = TextBox1.Text: center(1) = TextBox2.Text: center(2) = 0<br /> <br /> <br /> radius = 0<br /> <br /> <br /> radius = Val(TextBox3.Text)<br /> <br />     Set cirObj = blkObj.AddCircle(center, radius)<br /> <br />     cirObj.color = acRed<br />     <br />     <br />     Dim lineObj As AcadLine<br />     Dim sPnt(0 To 2) As Double, ePnt(0 To 2) As Double<br />     <br />     sPnt(0) = center(0): sPnt(1) = center(1): sPnt(2) = 0<br />     ePnt(0) = center(0) + 60: ePnt(1) = center(1) + 80: ePnt(2) = 0<br />     <br />     '创建一条直线<br />     Set lineObj = blkObj.AddLine(sPnt, ePnt)<br /> <br /> <br /> <br /> '-------------------------------------------------------------<br />     '本段代码将把TestBlock1块对象插入到模型空间<br />     <br />     Dim blkRefObj As AcadBlockReference<br />     <br />     <br />     Dim insertPnt(0 To 2) As Double<br />     <br />     '指定模型空间的插入点<br />     insertPnt(0) = 120: insertPnt(1) = 100: insertPnt(2) = 0<br />     <br />     '插入图块<br />     Set blkRefObj = ThisDrawing.ModelSpace.InsertBlock(insertPnt, "TestBlock1", 1#, 1#, 1#, 0#)<br />     <br />     <br />     blkRefObj.Update<br /> <br /> <br /> <br /> End Sub<br />

zzyong00

你的问题是什么？