VBA图案填充
夏威夷群岛我编写了一个VBA,它绘制一个矩形条,并对其进行分割和填充,就像dr.dwg一样。当我运行代码时,程序的这部分返回一个错误:运行时错误“483”:
对象不支持此属性或方法
请任何人写信给我,为什么这个错误发生,我必须如何修复它?
谢谢
这是我的代码:
Dim LayerBJ7作为AcadLayer
设置layerObj7=此图形。层。添加(“ELEVATIONS\u ID\u BAR”)
layerObj7.color=acWhite
Dim lineObj7作为AcadLine
将起始点7(0到2)变暗为双精度
将端点7(0到2)调整为双精度
Dim objEnt1作为AcadHatch
Dim Outer1作为身份
尺寸p(14)为双精度
尺寸plineObj1为AcadPolyline
fc=固定((最大-最小+5)*10)+(最小-4))
起始点7(0)=minx-5-0.25:起始点7(1)=minh-4:起始点7(2)=0
端点7(0)=minx-5-0.25:端点7(1)=fc:端点7(2)=0
设置lineObj7=此图形。模型空间。AddLine(起点7,终点7)
起始点7(0)=minx-5+0.25:起始点7(1)=minh-4:起始点7(2)=0
端点7(0)=minx-5+0.25:端点7(1)=fc:端点7(2)=0
设置lineObj7=此图形。模型空间。AddLine(起点7,终点7)
起始点7(0)=minx-5-0.25:起始点7(1)=fc:起始点7(2)=0
端点7(0)=minx-5+0.25:端点7(1)=fc:端点7(2)=0
设置lineObj7=此图形。模型空间。AddLine(起点7,终点7)
而((fc Mod 5)0)
fc=fc+1
温德
v=1
而(((minh-4)+(v*5))
p(0)=minx-5-0.25:p(1)=((minh-4)+(v*5)):p(2)=0
p(3)=minx-5+0.25:p(4)=((minh-4)+(v*5)):p(5)=0
p(6)=最小值-5+0.25:p(7)=((最小值-4)+(2*v*5)):p(=0
p(9)=minx-5-0.25:p(10)=((minh-4)+(2*v*5)):p(11)=0
p(12)=minx-5-0.25:p(13)=((minh-4)+(v*5)):p(14)=0
设置plineObj1=此图形。模型空间。添加多段线(p)
plineObj1.Closed=True
设置objEnt1=ThisDrawing。模型空间。AddHatch(acHatchPatternTypePreDefined,“SOLID”,True)
objEnt1.AppendOuterLoop(plineObj1)
objEnt1.评估
objEnt1.更新
v=v+2
温德 AppendOuterLoop方法适用于实体数组,请尝试以下操作:
. . . . . . .
Dim Outer1(0) As AcadEntity
. . . . . . .
Set Outer1(0) = plineObj1
objEnt1.AppendOuterLoop Outer1
我更改了它,但我的输出图形没有所需的图案填充,请参见dy dr2。图纸
另一个问题是:
如果我想制作一个写90度文本的styletext,我必须做什么?
Dr2.dwg
正如肖特所说,对这个代码块进行更改:
While (((minh - 4) + (v * 5)) < fc)
p(0) = minx - 5 - 0.25: p(1) = ((minh - 4) + (v * 5)): p(2) = 0
p(3) = minx - 5 + 0.25: p(4) = ((minh - 4) + (v * 5)): p(5) = 0
p(6) = minx - 5 + 0.25: p(7) = ((minh - 4) + (2 * v * 5)): p( = 0
p(9) = minx - 5 - 0.25: p(10) = ((minh - 4) + (2 * v * 5)): p(11) = 0
p(12) = minx - 5 - 0.25: p(13) = ((minh - 4) + (v * 5)): p(14) = 0
Set plineObj1 = ThisDrawing.ModelSpace.AddPolyline(p)
plineObj1.Closed = True
Dim outerLoop(0) As AcadEntity
Set outerLoop(0) = plineObj1
Set objEnt1 = ThisDrawing.ModelSpace.AddHatch(acHatchPatternTypePreDefined, "SOLID", True)
objEnt1.AppendOuterLoop (outerLoop)
objEnt1.Evaluate
objEnt1.Update
v = v + 2
Wend
~'J'~
嗨,亲爱的fixo
我读了这篇文章,我测试了所有这些代码,你的代码和seant代码结果是一样的,我看到了dr2。dwg和我认为nima1376需要图案填充立面条,以便内部矩形填充其中一个(一个图案填充-一个空白-一个图案填充…等等)。
啊哈,现在我明白了——他需要类似的东西
在虚线上(实心矩形后跟空矩形等)
谢谢,卡德曼
~'J'~
尊敬的fixo:
我改变了多段线点的定义,如下图所示,并绘制了一个像虚线一样的高程栏,请检查它,如果我只是告诉,请写信给我。
非常感谢亲爱的主人
而(((minh-4)+(v*5))
p(0)=minx-5-0.25:p(1)=((minh-4)+(v*5)):p(2)=0
p(3)=minx-5+0.25:p(4)=((minh-4)+(v*5)):p(5)=0
p(6)=minx-5+0.25:p(7)=((minh-4)+((v+1)*5)):p(=0
p(9)=minx-5-0.25:p(10)=((minh-4)+((v+1)*5)):p(11)=0
p(12)=minx-5-0.25:p(13)=((minh-4)+(v*5)):p(14)=0
设置plineObj1=此图形。模型空间。添加多段线(p)
plineObj1.Closed=True
设置OuterLoop(0)=plineObj1
设置objEnt1=ThisDrawing。模型空间。AddHatch(acHatchPatternTypePreDefined,“SOLID”,True)
objEnt1.AppendOuterLoop(OuterLoop)
objEnt1.评估
objEnt1.更新
哇,你已经解决了,对我来说很好
嘿,凯德曼,请不要花
快乐计算
~'J'~
页:
[1]