+ Reply to Thread
Results 1 to 8 of 8
  1. #1
    Forum Newbie
    Using
    AutoCAD 2017
    Join Date
    Jun 2017
    Posts
    4

    Default AutoCAD VBA - count hatch areas

    Registered forum members do not see this ad.

    Hello,

    I would like to write a procedure (function) which will show how many hatch areas are on the drawing. For example:
    I have drawing which has 3 objects (2 rectangulars and 1 circle - all in layer 0.
    1 rectangular and 1 circle is hatch. So when I will start the function it will show message about 2 hatch objects.

  2. #2
    Senior Member
    Using
    AutoCAD 2009
    Join Date
    Oct 2012
    Posts
    293

    Default

    Try it
    Code:
    Public Sub HatchCount()
    'On Error Resume Next
    '-------------------+
    Dim ObjSS
    Dim SSitems
    Dim FilterType(0) As Integer
    Dim FilterData(0) As Variant
    '----------------------------------------------------------------------------------+
    Set ObjSS = ThisDrawing.SelectionSets
    For Each SSitems In ObjSS
    If SSitems.Name = "Nabor" Then
    ThisDrawing.SelectionSets.Item("Nabor").Delete
    Exit For
    End If
    Next
    Set SSitems = ThisDrawing.SelectionSets.Add("Nabor")
    '----------------------------------------------------------------------------------+
    FilterType(0) = 0
    FilterData(0) = "HATCH"
    SSitems.Select acSelectionSetAll, , , FilterType, FilterData
    'or
    'SSitems.SelectOnScreen FilterType, FilterData
    '----------------------------------------------------------------------------------+
    If Err Then Err.Clear:  Exit Sub
    If SSitems.Count - 1 = -1 Then
    MsgBox "Selection empty !", vbExclamation
    Exit Sub
    End If
    '----------------------------------------------------------------------------------+
    MsgBox "HATCH - " & SSitems.Count, vbSystemModal + vbInformation
    '----------------------------------------------------------------------------------+
    End Sub

  3. #3
    Forum Newbie
    Using
    AutoCAD 2017
    Join Date
    Jun 2017
    Posts
    4

    Default

    Thank you. It works but I see some issues. For example:
    1. I drew 3 circles
    2. Next I went to Hatch Creation and made hatch in 2 circles
    3. Finally I closed Hatch Creation
    Then the function will say about 1 hatch object.
    But if I change actions:
    1. I drew 3 circles
    2. Next I went to Hatch Creation and made hatch in first circle
    3. I closed Hatch Creation
    4. I went to Hatch Creation again and made hatch in second circle
    5. I closed Hatch Creation
    Then the function will say about 2 hatch objects and this is correct result.
    Do you have any ideas how to improve this function?

    Also if it is not a problem I would like to ask about help in:
    - make this function also let the user to change hatch pattern to solid with possibility to choose color.

  4. #4
    Senior Member
    Using
    AutoCAD 2009
    Join Date
    Oct 2012
    Posts
    293

    Default

    Quote Originally Posted by avagorn View Post
    Do you have any ideas how to improve this function?
    No. Only individual hatching. Otherwise it does not work.

    Quote Originally Posted by avagorn View Post
    - make this function also let the user to change hatch pattern to solid with possibility to choose color.
    It is necessary
    - or know exactly what type of fill and color
    - or make a form that will select the color you want.

  5. #5
    Forum Newbie
    Using
    AutoCAD 2017
    Join Date
    Jun 2017
    Posts
    4

    Default

    Quote Originally Posted by maratovich View Post
    It is necessary
    - or know exactly what type of fill and color
    - or make a form that will select the color you want.
    - pattern type: ANSI31, Hatch Pattern Scale 10
    - form with colors will be great

  6. #6
    Senior Member
    Using
    AutoCAD 2009
    Join Date
    Oct 2012
    Posts
    293

    Default

    Code:
    Public Sub HatchCount()
    'On Error Resume Next
    '-------------------+
    Dim ObjSS
    Dim SSitems
    Dim FilterType(0) As Integer
    Dim FilterData(0) As Variant
    Dim HatchItem As AcadHatch
    Dim color As AcadAcCmColor
    Dim Version As String
    '----------------------------------------------------------------------------------+
    Set ObjSS = ThisDrawing.SelectionSets
    For Each SSitems In ObjSS
    If SSitems.Name = "Nabor" Then
    ThisDrawing.SelectionSets.Item("Nabor").Delete
    Exit For
    End If
    Next
    Set SSitems = ThisDrawing.SelectionSets.Add("Nabor")
    '----------------------------------------------------------------------------------+
    FilterType(0) = 0
    FilterData(0) = "HATCH"
    SSitems.Select acSelectionSetAll, , , FilterType, FilterData
    'or
    'SSitems.SelectOnScreen FilterType, FilterData
    '----------------------------------------------------------------------------------+
    If Err Then Err.Clear:  Exit Sub
    If SSitems.Count - 1 = -1 Then
    MsgBox "Selection empty !", vbExclamation
    Exit Sub
    End If
    '----------------------------------------------------------------------------------+
    MsgBox "HATCH - " & SSitems.Count, vbSystemModal + vbInformation
    '----------------------------------------------------------------------------------+
    Version = Left(ThisDrawing.GetVariable("ACADVER"), 2)
    Set color = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor." & Version)
    color.SetRGB 80, 100, 244
    '----------------------------------------------------------------------------------+
    For Each HatchItem In SSitems
        HatchItem.SetPattern acHatchPatternTypePreDefined, "ANSI31"
        HatchItem.PatternScale = 10
        HatchItem.TrueColor = color
        HatchItem.Evaluate
    Next
    '----------------------------------------------------------------------------------+
    MsgBox "Ok!", vbSystemModal + vbInformation
    '----------------------------------------------------------------------------------+
    End Sub

  7. #7
    Forum Newbie
    Using
    AutoCAD 2017
    Join Date
    Jun 2017
    Posts
    4

    Default

    Sorry for late reply. The procedure works good. Thank you very much for help.

  8. #8
    Luminous Being
    Using
    Civil 3D 2016
    Join Date
    Dec 2005
    Location
    GEELONG AUSTRALIA
    Posts
    9,815

    Default

    Registered forum members do not see this ad.

    You can get at the number of individual hatches that make 1 bigger hatch pattern if you dump a hatch you will see the variable "numerof loops"

    Code:
    (vl-load-com)
    (defun hatchnum ( / x num ss tot)
    (setq ss (ssget (list (cons 0 "hatch"))))
    (setq num (sslength ss))
    (setq tot 0)
    (repeat (setq x (sslength ss))
    (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1))))) 
    (setq tot (+ (vla-get-numberofloops obj) tot ))
    )
    (alert (strcat "There is " (rtos num 2 0) "hatches\n\nMade up of " (rtos tot 2 ) " sections"))
    )
    (hatchnum)
    A man who never made mistakes never made anything

Similar Threads

  1. solid hatch closed areas of drawing
    By Barry_47 in forum AutoLISP, Visual LISP & DCL
    Replies: 35
    Last Post: 22nd Sep 2014, 05:48 am
  2. Strange! about hatch areas weight calculation.
    By elfert in forum AutoLISP, Visual LISP & DCL
    Replies: 1
    Last Post: 9th Apr 2012, 10:35 pm
  3. Problems with calculating areas of hatch
    By BenGoble in forum AutoCAD General
    Replies: 2
    Last Post: 27th Jul 2009, 05:16 am
  4. total hatch areas
    By happyunited in forum AutoCAD Drawing Management & Output
    Replies: 15
    Last Post: 5th Oct 2007, 04:41 pm
  5. Hatch areas
    By happyunited in forum AutoCAD Drawing Management & Output
    Replies: 7
    Last Post: 13th Sep 2007, 07:17 pm

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts