Can I find the angle of a line contained in a hatch pattern?

her you go...it's dirty but will work for now. will do a version that
iterates .Pat later if I have a chance.

Option Explicit
Sub hatchAngle()

Dim ssHatch As AcadSelectionSet
Dim ssLine As AcadSelectionSet
Dim myLine As AcadLine
Dim lineAngle As Variant
Dim I As Integer: I = 0

Set ssHatch = ThisDrawing.SelectionSets.Add("hatch")
Set ssLine = ThisDrawing.SelectionSets.Add("line")

ThisDrawing.SendCommand "UNDO" & vbCr & "MARK" & vbCr
ssHatch.SelectOnScreen
ThisDrawing.SendCommand "EXPLODE" & vbCr & "L" & vbCr & vbCr
ssLine.SelectOnScreen

For I = 0 To ssLine.Count - 1
Set myLine = ssLine.Item(I)
lineAngle = myLine.Angle
Next I

ThisDrawing.SendCommand "UNDO" & vbCr & "BACK" & vbCr
End Sub

 

the explode method returns the array of objects to you,
then you have control of them and can delete when you're done
that's why it was suggested as a workaround
however in trying to make a test i found hatch doesn't support the explode
method so never mind
sorry

 

Oops..quick change "P" not "L" unless us just made the hatch to test...ha

ThisDrawing.SendCommand "EXPLODE" & vbCr & "P" & vbCr & vbCr

 

Sorry, Paul. Didn't mean that post to sound snotty.

I haven't been following this thread thoroughly, just
scanning..........interesting topic.

Thanks for the answers.

 

tks, didn't take it as such. going to wirte the version the iterates the
..PAT later. almost has to be done at this point. ha.

 

If I'm reading it right you have to select manually all the exploded hatch
entitles!!

No way would I write/use this code.

It's quicker to rotate the text manually.

Dave F.

 

cool part is....I would and did write it. fun too. ha. good luck with it.
|

 

i would....
Good Luck
Paul
'STARTCODE**************************************************************
Option Explicit
Sub hatchAngle()

Dim ssHatch As AcadSelectionSet
Dim ssLine As AcadSelectionSet

Dim myLine As AcadLine
Dim patternColl As Collection: Set patternColl = New Collection
Dim patternArray() As Variant
Dim patternName As String
Dim testPattern As String
Dim patternAngle As Variant
Dim patternAngDeg As Variant

Dim myHatch As AcadHatch
Dim textLine As String
Dim firstWord As String
Dim firstChar As String
Dim fFile As Integer: fFile = FreeFile
Dim boolCheck As Boolean: boolCheck = False

Dim defAngVal As Variant: defAngVal = -0.999
Dim hatchAngle1 As Variant: hatchAngle1 = defAngVal
Dim hatchAngle2 As Variant: hatchAngle2 = defAngVal
Dim hatchAngle3 As Variant: hatchAngle3 = defAngVal
Dim hatchAngle4 As Variant: hatchAngle4 = defAngVal

Dim ang1 As Variant
Dim ang2 As Variant
Dim ang3 As Variant
Dim ang4 As Variant

Dim pi: pi = 4 * Atn(1)

Set ssHatch = ThisDrawing.SelectionSets.Add("Hatch")


ssHatch.SelectOnScreen

Set myHatch = ssHatch.Item(0)
patternName = myHatch.patternName
patternAngle = myHatch.patternAngle
patternAngDeg = ((patternAngle * 180) / pi)
testPattern = "*" + patternName + ","

'Open .PAT file for iteration**************************'
Open "C:\Program Files\Autodesk Architectural Desktop
3\Support\acad.pat" _
For Input As #fFile

Do While Not EOF(fFile) ' Loop until end of file

Line Input #fFile, textLine ' Read line into variable textLine
firstWord = Left(textLine, InStr(1, textLine, ","))
If Len(firstWord) = 0 Then
GoTo myLoop
End If
firstChar = Left$(firstWord, 1)
Select Case firstChar
Case Is = ";"
GoTo myLoop
Case Is = "*"
If firstWord = testPattern Then
boolCheck = True
GoTo myLoop
Else
If boolCheck = True Then
GoTo myExit
Else
GoTo myLoop
End If
End If

Case Else 'degrees
If boolCheck = True Then

If hatchAngle1 = defAngVal Then
hatchAngle1 = firstWord
patternColl.Add hatchAngle1, "2"
ElseIf hatchAngle1 <> defAngVal And _
hatchAngle2 = defAngVal Then
hatchAngle2 = firstWord
patternColl.Add hatchAngle2, "3"
ElseIf hatchAngle2 <> defAngVal And _
hatchAngle3 = defAngVal Then
hatchAngle3 = firstWord
patternColl.Add hatchAngle3, "4"
ElseIf hatchAngle3 <> defAngVal And _
hatchAngle4 = defAngVal Then
hatchAngle4 = firstWord
patternColl.Add hatchAngle4, "5"
Else
GoTo myLoop
End If
End If
End Select
myLoop:
Loop
myExit:
Close #fFile

Select Case patternColl.Count
Case Is = 1
ang1 = fStripName(patternColl.Item(1))
MsgBox patternName & vbCrLf & ang1
Case Is = 2
ang1 = fStripName(patternColl.Item(1))
ang2 = fStripName(patternColl.Item(2))
MsgBox patternName & vbCrLf & ang1 + patternAngDeg _
& vbCrLf & ang2 + patternAngDeg
Case Is = 3
ang1 = fStripName(patternColl.Item(1))
ang2 = fStripName(patternColl.Item(2))
ang3 = fStripName(patternColl.Item(3))
MsgBox patternName & vbCrLf & ang1 + patternAngDeg _
& vbCrLf & ang2 + patternAngDeg & vbCrLf _
& ang3 + patternAngDeg
Case Is = 4
ang1 = fStripName(patternColl.Item(1))
ang2 = fStripName(patternColl.Item(2))
ang3 = fStripName(patternColl.Item(3))
ang4 = fStripName(patternColl.Item(4))
MsgBox patternName & vbCrLf & ang1 + patternAngDeg _
& vbCrLf & ang2 + patternAngDeg & vbCrLf _
& ang3 + patternAngDeg & vbCrLf _
& ang4 + patternAngDeg
End Select

Set patternColl = Nothing
ThisDrawing.SelectionSets("Hatch").Delete

End Sub
Public Function fStripName(inString) As Variant
fStripName = Left$(inString, (Len(inString) - 1))
End Function
'ENDCODE****************************************************************

 

watch for "word wrap" on the Open line..

 

NO... Just select the hatch and do what you want after "lineAngle =
myLine.Angle" with the value when the code ends Undo Back hatch to normal

Use the version that iterates the .Pat file that I sent.... no
"SendCommand". Just add more angles if necessary. Works for up to 4 entities
in a pattern. Test on ANSI hatches(31,32,ect) to see how it works. You will
probable need to modify a bit for your patterns.

Paul

 

Any of you guru's out there want to be critical (bar.. no error check and
little comments ha was in a hurry.)...Please do .....how I learn. I added
the Collection so Tony wouldn't yell at me for an array the uses ReDim
Preserve. ha.... Glad I did now...they are sweet...Thanks to Tony for the
fear...

 

No way would I write/use this code.

Not once the code is written it's not...