VBA Hatch

[Nima1376]

HI

I wrote a VBA that draw a rectangle bar and divid it and hatch it like dr.dwg , when I run our code this part of program return an error that : Run time error '483':

Object dosen't support this property or method

please anyone write me that why this error ocurrse and how I must repaire it ?

thanks

 

Here is my code :

Dim layerObj7 As AcadLayer

Set layerObj7 = ThisDrawing.Layers.Add("ELEVATIONS_ID_BAR")

 

layerObj7.color = acWhite

Dim lineObj7 As AcadLine

Dim startPoint7(0 To 2) As Double

Dim endPoint7(0 To 2) As Double

Dim objEnt1 As AcadHatch

Dim Outer1 As AcadEntity

Dim p(14) As Double

Dim plineObj1 As AcadPolyline

 

fc = Fix(((maxh - minh + 5) * 10) + (minh - 4))

 

startPoint7(0) = minx - 5 - 0.25: startPoint7(1) = minh - 4: startPoint7(2) = 0

endPoint7(0) = minx - 5 - 0.25: endPoint7(1) = fc: endPoint7(2) = 0

Set lineObj7 = ThisDrawing.ModelSpace.AddLine(startPoint7, endPoint7)

startPoint7(0) = minx - 5 + 0.25: startPoint7(1) = minh - 4: startPoint7(2) = 0

endPoint7(0) = minx - 5 + 0.25: endPoint7(1) = fc: endPoint7(2) = 0

Set lineObj7 = ThisDrawing.ModelSpace.AddLine(startPoint7, endPoint7)

 

startPoint7(0) = minx - 5 - 0.25: startPoint7(1) = fc: startPoint7(2) = 0

endPoint7(0) = minx - 5 + 0.25: endPoint7(1) = fc: endPoint7(2) = 0

Set lineObj7 = ThisDrawing.ModelSpace.AddLine(startPoint7, endPoint7)

 

While ((fc Mod 5) 0)

fc = fc + 1

Wend

v = 1

 

While (((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) + (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

 

Set objEnt1 = ThisDrawing.ModelSpace.AddHatch(acHatchPatternTypePreDefined, "SOLID", True)

objEnt1.AppendOuterLoop (plineObj1)

objEnt1.Evaluate

objEnt1.Update

 

v = v + 2

Wend

[SEANT]

The AppendOuterLoop method works with an entity array, so try something like this:

 

. . . . . . .

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

Set Outer1(0) = plineObj1
objEnt1.AppendOuterLoop Outer1

[Nima1376]

  SEANT said:

The AppendOuterLoop method works with an entity array, so try something like this:

 

. . . . . . .

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

Set Outer1(0) = plineObj1
objEnt1.AppendOuterLoop Outer1

 

I change it but my output drawing don't have desired hatch , please see dy dr2.dwg

and another problem is :

if I want make a styletext that write 90 degree text what must I do ?

Dr2.dwgFetching info...

[fixo]

  Nima1376 said:

I change it but my output drawing don't have desired hatch , please see dy dr2.dwg

and another problem is :

if I want make a styletext that write 90 degree text what must I do ?

 

Change on this code block as SEANT said:

 

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]

  fixo said:

Change on this code block as SEANT said:

 

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

 

Hi dear fixo

 

I read this post and I test all these codes , your code and seant code results are the same , I see dr2.dwg and I think that nima1376 want hatches elevation bar so that inner rectangles be filled be one among , (one hatch - one empty - one hatch ... and so on) .

[fixo]

  cadman2009 said:

Hi dear fixo

 

I read this post and I test all these codes , your code and seant code results are the same , I see dr2.dwg and I think that nima1376 want hatches elevation bar so that inner rectangles be filled be one among , (one hatch - one empty - one hatch ... and so on) .

 

Aha, now I understand - he need something similar

on dashed lines (filled rectangle follows by empty rectangle etc)

Thanks, cadman

 

~'J'~

[cadman2009]

  fixo said:

Aha, now I understand - he need something similar

on dashed lines (filled rectangle follows by empty rectangle etc)

Thanks, cadman

 

~'J'~

 

 

Dear fixo

I change polyline points definition like below and was drawn an elevation bar like a dashed line , please check it and if I just tell ,write me .

 

very thanks dear master

 

While (((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

Set plineObj1 = ThisDrawing.ModelSpace.AddPolyline(p)

plineObj1.Closed = True

Set OuterLoop(0) = plineObj1

Set objEnt1 = ThisDrawing.ModelSpace.AddHatch(acHatchPatternTypePreDefined, "SOLID", True)

objEnt1.AppendOuterLoop (OuterLoop)

 

objEnt1.Evaluate

objEnt1.Update

[fixo]

  cadman2009 said:

Dear fixo

I change polyline points definition like below and was drawn an elevation bar like a dashed line , please check it and if I just tell ,write me .

 

 

Wow, you have solved it, worked nice for me

And, hey, cadman, no flowers please

Happy computing

 

~'J'~