Nima1376 发表于 2022-7-6 12:07:32

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
温德

SEANT 发表于 2022-7-6 12:21:20

AppendOuterLoop方法适用于实体数组,请尝试以下操作:
 
. . . . . . .

Dim Outer1(0) As AcadEntity
. . . . . . .

Set Outer1(0) = plineObj1
objEnt1.AppendOuterLoop Outer1

Nima1376 发表于 2022-7-6 12:29:19

 
我更改了它,但我的输出图形没有所需的图案填充,请参见dy dr2。图纸
另一个问题是:
如果我想制作一个写90度文本的styletext,我必须做什么?
Dr2.dwg

fixo 发表于 2022-7-6 12:35:25

 
正如肖特所说,对这个代码块进行更改:
 

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'~

cadman2009 发表于 2022-7-6 12:49:05

 
嗨,亲爱的fixo
 
我读了这篇文章,我测试了所有这些代码,你的代码和seant代码结果是一样的,我看到了dr2。dwg和我认为nima1376需要图案填充立面条,以便内部矩形填充其中一个(一个图案填充-一个空白-一个图案填充…等等)。

fixo 发表于 2022-7-6 12:56:05

 
啊哈,现在我明白了——他需要类似的东西
在虚线上(实心矩形后跟空矩形等)
谢谢,卡德曼
 
~'J'~

cadman2009 发表于 2022-7-6 13:05:33

 
 
尊敬的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.更新

fixo 发表于 2022-7-6 13:09:40

 
哇,你已经解决了,对我来说很好
嘿,凯德曼,请不要花
快乐计算
 
~'J'~
页: [1]
查看完整版本: VBA图案填充