Public Sub bug() On Error Resume Next Dim Circ2(0) As AcadCircle,shu as double Insertpoint(0) = Insertpoint(1) = Insertpoint(2) = 0 Set Blockobj = ThisDrawing.Blocks.Add(Insertpoint, "bu" & shu) Set Hatchobj = Blockobj.AddHatch(0, "ANSI31", True) Hatchobj.Layer = "0" ThisDrawing.Linetypes.Load "DASHED", "acad.lin" Hatchobj.Linetype = "DASHED" If shu <= 4 Then Hatchobj.PatternScale = 0.1 ElseIf shu > 4 And shu <= 10 Then Hatchobj.PatternScale = 0.4 Else Hatchobj.PatternScale = 1 End If If shu < 6 Then Hatchobj.LinetypeScale = 0.7 Else Hatchobj.LinetypeScale = 6 End If Set Circ2(0) = Blockobj.AddCircle(Insertpoint, shu / 2) Circ2(0).Layer = "0" Circ2(0).Linetype = "DASHED" Circ2(0).LinetypeScale = 6.5 Hatchobj.AppendOuterLoop (Circ2) Hatchobj.Evaluate ThisDrawing.Regen True End Sub 管理员,以上程序我怎么实现在每次打幵一个newdrawing后不需做任何动作,直接
在命令行输 "i" ,然后在弹出的对话框输入块名 bu8即可直接插入这个块 |