List of Hatch patterns

vla-get-dimstyles

Like that how can get list of hatch patterns

There is a .Net solution, but I'm not sure if can be translated to AutoLISP.

The .Net solution "can" be translated to lisp. Only issue is you'd have to translate the entire library call - no simple feat.

There is no such thing as Hatch patterns saved in the DWG file the same way DimStyles / Text Styles / LineTypes are. Every time you open the hatch dialog / ribbon it loads all the hatches from the acad(iso).PAT file as well as custom PAT files in your search paths. So what the .Net library does (and what would be needed to implement such in lisp) is to read through all those files and extract each pattern's name. The only "patterns" saved in the DWG is those used in actual Hatch objects, in which case you can step through those objects to find their hatch pattern names (and even their pattern data).

Here is a quickly assembled solution using prewritten code:

[color=GREEN];; Hatch Pattern List  -  Lee Mac[/color]
[color=GREEN];; Returns a list of all hatch patterns defined in all PAT files found in the[/color]
[color=GREEN];; support file search paths & working directory.[/color]

([color=BLUE]defun[/color] hatchpatternlist ( [color=BLUE]/[/color] lst )
   ([color=BLUE]foreach[/color] dir ([color=BLUE]cons[/color] ([color=BLUE]getvar[/color] 'dwgprefix) (parsesupportpaths ([color=BLUE]getenv[/color] [color=MAROON]"ACAD"[/color])))
       ([color=BLUE]foreach[/color] pat ([color=BLUE]vl-directory-files[/color] dir [color=MAROON]"*.pat"[/color] 1)
           ([color=BLUE]setq[/color] lst ([color=BLUE]cons[/color] (parsepatfile ([color=BLUE]strcat[/color] (fixdir dir) [color=MAROON]"\\"[/color] pat)) lst))
       )
   )
   ([color=BLUE]vl-sort[/color] (unique ([color=BLUE]apply[/color] '[color=BLUE]append[/color] lst)) '[color=BLUE]<[/color])
)

([color=BLUE]defun[/color] unique ( lst )
   ([color=BLUE]if[/color] lst ([color=BLUE]cons[/color] ([color=BLUE]car[/color] lst) (unique ([color=BLUE]vl-remove[/color] ([color=BLUE]car[/color] lst) ([color=BLUE]cdr[/color] lst)))))
)

([color=BLUE]defun[/color] fixdir ( str )
   ([color=BLUE]vl-string-right-trim[/color] [color=MAROON]"\\"[/color] ([color=BLUE]vl-string-translate[/color] [color=MAROON]"/"[/color] [color=MAROON]"\\"[/color] str))
)

([color=BLUE]defun[/color] parsesupportpaths ( str [color=BLUE]/[/color] pos )
   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] pos ([color=BLUE]vl-string-position[/color] 59 str))
       ([color=BLUE]vl-remove[/color] [color=MAROON]""[/color] ([color=BLUE]cons[/color] ([color=BLUE]substr[/color] str 1 pos) (parsesupportpaths ([color=BLUE]substr[/color] str ([color=BLUE]+[/color] pos 2)))))
       ([color=BLUE]list[/color] str)
   )
)

([color=BLUE]defun[/color] parsepatfile ( fn [color=BLUE]/[/color] fd hp ln )
   ([color=BLUE]if[/color]
       ([color=BLUE]and[/color]
           ([color=BLUE]setq[/color] fn ([color=BLUE]findfile[/color] fn))
           ([color=BLUE]setq[/color] fd ([color=BLUE]open[/color] fn [color=MAROON]"r"[/color]))
       )
       ([color=BLUE]progn[/color]
           ([color=BLUE]while[/color] ([color=BLUE]setq[/color] ln ([color=BLUE]read-line[/color] fd))
               ([color=BLUE]if[/color] ([color=BLUE]wcmatch[/color] ln [color=MAROON]"`**`,*"[/color])
                   ([color=BLUE]setq[/color] hp ([color=BLUE]cons[/color] ([color=BLUE]strcase[/color] ([color=BLUE]substr[/color] ln 2 ([color=BLUE]1-[/color] ([color=BLUE]vl-string-position[/color] 44 ln)))) hp))
               )
           )
           ([color=BLUE]close[/color] fd)
           ([color=BLUE]reverse[/color] hp)
       )
   )
)

Call with:

(hatchpatternlist)

Was my solution suitable?

Nice one Lee.

Maybe wimal is looking only for used hatch patterns.

;collects names of all hatch patterns used in current drawing
(defun test ( / ss i h l)
 (if
   (setq ss (ssget "X" '((0 . "HATCH"))))
   (repeat (setq i (sslength ss))
     (if
       (not (member (setq h (vla-get-PatternName (vlax-ename->vla-object (ssname ss (setq i (1- i)))))) l))
       (setq l (cons h l))
       )
     )
   )
 (acad_strlsort l)
 )


;collects names of all hatch patterns used in current drawing, including those used only inside blocks
(defun test1 ( / h l)
 (vlax-for block (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
   (vlax-for obj block
     (if
       (and
         (eq (vla-get-objectname obj) "AcDbHatch")
         (not (member (setq h (vla-get-PatternName obj)) l))
         )
       (setq l (cons h l))
       )
     )
   )
 (acad_strlsort l)
 )

_$ (test)
("ANSI31,_O" "AR-RSHKE,_O" "AR-SAND" "EARTH,_O")
_$ (test1)
("ANSI31,_O" "AR-CONC" "AR-RSHKE,_O" "AR-SAND" "EARTH,_O")

Thank you Stefan; good idea to collect patterns in use.

We shall have to wait to see what 'wimal' intends to do with these functions...

Sorry for the delay of the reply. Mr.Lee Mac your code is grate. Actually I wanted that kind of code .Thanks sir

You're very welcome wimal, thank you for your response.