AutoCAD VBA - count hatch area

avagorn · 发表于 2022-7-6 21:50:07

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.

maratovich · 发表于 2022-7-6 22:07:15

Try it

copy

Public Sub HatchCount()'On Error Resume Next'-------------------+Dim ObjSSDim SSitemsDim FilterType(0) As IntegerDim FilterData(0) As Variant'----------------------------------------------------------------------------------+Set ObjSS = ThisDrawing.SelectionSetsFor Each SSitems In ObjSSIf SSitems.Name = "Nabor" ThenThisDrawing.SelectionSets.Item("Nabor").DeleteExit ForEnd IfNextSet SSitems = ThisDrawing.SelectionSets.Add("Nabor")'----------------------------------------------------------------------------------+FilterType(0) = 0FilterData(0) = "HATCH"SSitems.Select acSelectionSetAll, , , FilterType, FilterData'or'SSitems.SelectOnScreen FilterType, FilterData'----------------------------------------------------------------------------------+If Err Then Err.Clear:  Exit SubIf SSitems.Count - 1 = -1 ThenMsgBox "Selection empty !", vbExclamationExit SubEnd If'----------------------------------------------------------------------------------+MsgBox "HATCH - " & SSitems.Count, vbSystemModal + vbInformation'----------------------------------------------------------------------------------+End Sub

avagorn · 发表于 2022-7-6 22:09:11

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.

maratovich · 发表于 2022-7-6 22:18:29

No. Only individual hatching. Otherwise it does not work.

It is necessary
- or know exactly what type of fill and color
- or make a form that will select the color you want.

avagorn · 发表于 2022-7-6 22:25:43

- pattern type: ANSI31, Hatch Pattern Scale 10
- form with colors will be great

maratovich · 发表于 2022-7-6 22:40:25

copy

Public Sub HatchCount()'On Error Resume Next'-------------------+Dim ObjSSDim SSitemsDim FilterType(0) As IntegerDim FilterData(0) As VariantDim HatchItem As AcadHatchDim color As AcadAcCmColorDim Version As String'----------------------------------------------------------------------------------+Set ObjSS = ThisDrawing.SelectionSetsFor Each SSitems In ObjSSIf SSitems.Name = "Nabor" ThenThisDrawing.SelectionSets.Item("Nabor").DeleteExit ForEnd IfNextSet SSitems = ThisDrawing.SelectionSets.Add("Nabor")'----------------------------------------------------------------------------------+FilterType(0) = 0FilterData(0) = "HATCH"SSitems.Select acSelectionSetAll, , , FilterType, FilterData'or'SSitems.SelectOnScreen FilterType, FilterData'----------------------------------------------------------------------------------+If Err Then Err.Clear:  Exit SubIf SSitems.Count - 1 = -1 ThenMsgBox "Selection empty !", vbExclamationExit SubEnd 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.EvaluateNext'----------------------------------------------------------------------------------+MsgBox "Ok!", vbSystemModal + vbInformation'----------------------------------------------------------------------------------+End Sub

avagorn · 发表于 2022-7-6 22:49:54

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

BIGAL · 发表于 2022-7-6 22:57:11

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"

copy

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

[编程交流] AutoCAD VBA - count hatch area

发表回复

精选推荐

浏览过的版块