VBA图案填充

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

夏威夷群岛
我编写了一个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方法适用于实体数组，请尝试以下操作：

copy

. . . . . . .
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

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

copy


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
[color=red]Dim outerLoop(0) As AcadEntity
Set outerLoop(0) = plineObj1
Set objEnt1 = ThisDrawing.ModelSpace.AddHatch(acHatchPatternTypePreDefined, "SOLID", True)
objEnt1.AppendOuterLoop (outerLoop)[/color]
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'~

[编程交流] VBA图案填充

发表回复

精选推荐