最近用vb编程画图发现同样是一个矩形框(全屏幕可见,闭合)用自定义的填充图案在cad 中用填充命令能填充上,而用vb编程却不能填充,小的矩形编程可以填充,一旦矩形上下长度超过某个值就填充不上,用cad自带的“ansi31”没有这种问题,由此判断是自定义填充图案的问题,后面有自定义填充图案,代码如下: Private Sub Command1_Click() Dim point0(3) As Double Dim point1(3) As Double Dim Acadapp As AcadApplication On Error Resume Next Set Acadapp = GetObject(, "AutoCAD.application") If Err Then Err.Clear Set Acadapp = CreateObject("autocad.application") If Err Then MsgBox ("不能运行AutoCAD") Exit Sub End If End If Acadapp.WindowState = acMax Acadapp.Visible = True Dim a As Single, b As Single Dim lineobj As AcadLWPolyline Dim points(0 To 9) As Double Dim objlist(0) As AcadEntity Dim objhatch As AcadHatch a = Val(Text1.Text) '矩形长 b = Val(Text2.Text) '矩形宽,即高,将该值调高比如>20,即填充不上,这是为什么呢? point0(0) = 0: point0(1) = 0: point0(2) = 0 point1(0) = a: point1(1) = b: point1(2) = 0 points(0) = 0: points(1) = 0 points(2) = points(0) + a: points(3) = points(1) points(4) = points(2): points(5) = points(3) + b points(6) = points(0): points(7) = points(5) points(8) = 0: points(9) = 0 Set lineobj = Acadapp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points) Acadapp.ActiveDocument.ZoomWindow point0, point1 Set objhatch = Acadapp.ActiveDocument.ModelSpace.AddHatch(2, "s200", True, 0) Set objlist(0) = lineobj objhatch.AppendOuterLoop (objlist) objhatch.Evaluate ThisDrawing.Regen True End Sub 附上自定义的填充图案"s200",这个自定义填充图案有什么问题呢? |