Author Topic: acad hatch with vba  (Read 4324 times)

0 Members and 1 Guest are viewing this topic.

wessel

  • Guest
acad hatch with vba
« on: November 18, 2005, 02:07:10 AM »
Hello Iam doing a project for school and my assignment is to draw a elevator in acad with a vba program.

Iam nearly finisched but i got one problem. I want to hatch some of the items i have drawn. I got one program that works but it only works on circles and rectangles. How can i modify this code to a code that makes it possible to select multiple lines or a point within a closed area and then hatch that selection.

or do i need to make the object a block?


Sub Ch05_AddHatch()
Dim objHatch As AcadHatch
Dim PatternName As String
Dim PatternType As Long
Dim Associativity As Boolean
Dim objOutLoop(0 To 0) As AcadObject
Dim varPickPt As Variant
' Turn off errors.
On Error Resume Next
' Hatch definition.
PatternName = "ANSI32"
PatternType = acHatchPatternTypePreDefined
Associativity = True
' Create the associative Hatch object in model space.
Set objHatch = ThisDrawing.ModelSpace.AddHatch(PatternType, PatternName, Associativity)
' Get the object to hatch.
ThisDrawing.Utility.GetEntity objOutLoop(0), varPickPt, "Select object: "
' Make sure the user selected something.
If Err.Number = 0 Then
' Append the hatch outer boundary to hatch object.
objHatch.AppendOuterLoop (objOutLoop)
' Evaluate the hatch for display.
objHatch.Evaluate
 Regenerate the drawing.
ThisDrawing.Regen True
Else
Clear the error.
Err.Clear
End If
End Sub


Jürg Menzi

  • Swamp Rat
  • Posts: 597
  • Oberegg, Switzerland
Re: acad hatch with vba
« Reply #1 on: November 18, 2005, 04:41:51 AM »
Quote
How can i modify this code to a code that makes it possible to select multiple lines (...)
Use a selectionset instead of GetEntity, convert the selectionset into the 'objOutLoop' array...

Quote
(...) a point within a closed area and then hatch that selection.
You can't create a hatch by selecting a point with VBA methods.
The only way to do that is by SendCommand.
A computer's human touch is its unscrupulousness!
MENZI ENGINEERING GmbH
Current A2k14... A2k18 - Start R2.18