VBA中编写块命令的问题
在CAD中编程块，每次运行一次，在CAD中多增加一个图形，请大神看看程序。谢谢啦。Private Sub CommandButton1_Click()Dim PtPick As Variant
UserForm1.hide
PtPick = ThisDrawing.Utility.GetPoint(, "请在屏幕上选择起点:")
TextBox1.Text = PtPick(0)
TextBox2.Text = PtPick(1)
UserForm1.Show
Dim blkObj As AcadBlock
Dim insPnt(0 To 2) As Double
'设定图块对象的原点坐标
insPnt(0) = 0: insPnt(1) = 0: insPnt(2) = 0
'在Blocks集合中创建名为TestBlock1的块对象
Set blkObj = ThisDrawing.Blocks.Add(insPnt, "TestBlock1")
'-------------------------------------------------------------
Dim cirObj As AcadCircle
Dim center(0 To 2) As Double
Dim radius As Double
center(0) = TextBox1.Text: center(1) = TextBox2.Text: center(2) = 0
radius = 0
radius = Val(TextBox3.Text)
Set cirObj = blkObj.AddCircle(center, radius)
cirObj.color = acRed
Dim lineObj As AcadLine
Dim sPnt(0 To 2) As Double, ePnt(0 To 2) As Double
sPnt(0) = center(0): sPnt(1) = center(1): sPnt(2) = 0
ePnt(0) = center(0) + 60: ePnt(1) = center(1) + 80: ePnt(2) = 0
'创建一条直线
Set lineObj = blkObj.AddLine(sPnt, ePnt)
'-------------------------------------------------------------
'本段代码将把TestBlock1块对象插入到模型空间
Dim blkRefObj As AcadBlockReference
Dim insertPnt(0 To 2) As Double
'指定模型空间的插入点
insertPnt(0) = 120: insertPnt(1) = 100: insertPnt(2) = 0
'插入图块
Set blkRefObj = ThisDrawing.ModelSpace.InsertBlock(insertPnt, "TestBlock1", 1#, 1#, 1#, 0#)
blkRefObj.Update
End Sub
你的问题是什么？
页:
[1]