AutoLISP: Make and Save Custom Hatch Pattern

This Routine has been featured on Cadalyst’s website and is very handy. If you have ever wondered how to make a custom hatch pattern and then looked at the coding that is required, you will really appreciate this routine. The only drawback that I have come across is that it will only accept line and point entities… This can be over come by drawing your curved objects and then using other LISP routines to convert arcs and circles to line entities. Or use the “SEGS” LISP routine to convert the curved objects to polylines and then explode the polyline. This will turn the polyline segments into line segments.

There are 2 commands:

1) DRAWHATCH <enter> creates a 1X1 square in which you draw your custom hatch pattern

After you have drawn your hatch pattern:

2) SAVEHATCH <enter> lets you name your hatch Pattern and save it as a .pat file.

Saving the .pat file (hatch pattern) allows you to copy the contents and save it in your support file or even add it to your acad.pat file where all of your default patterns are stored.

Picture below: DRAWHATCH & SAVEHATCH in action

Picture below: Applying the newly created hatch

Picture below: Opening the .pat file created by the SAVEHATCH command


;;;CADALYST 10/05 Tip 2065: HatchMaker.lsp	Hatch Maker	(c) 2005 Larry Schiele

;;;* ======   B E G I N   C O D E   N O W    ======   
;;;* HatchMaker.lsp written by Lanny Schiele at TMI Systems Design Corporation
;;;* Lanny.Schiele@tmisystems.com
;;;* Tested on AutoCAD 2002 & 2006. -- does include a 'VL' function -- should work on Acad2000 on up.
 
(defun C:DrawHatch (/)
  (command "undo" "be")
  (setq os (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (command "UCS" "w")
  (command "PLINE" "0,0" "0,1" "1,1" "1,0" "c")
  (command "zoom" "c" "0.5,0.5" 1.1)
  (setvar "OSMODE" os)
  (setvar "SNAPMODE" 1)
  (setvar "SNAPUNIT" (list 0.01 0.01))
  (command "undo" "e")
  (alert
    "Draw pattern within 1x1 box using LINE or POINT entities only..."
  )
  (princ)
)
 
(defun C:SaveHatch (/      round    dxf      ListToFile
      user     SelSet   SelSetSize ssNth
      Ent      EntInfo  EntType  pt1 pt2
      Dist     AngTo    AngFrom  XDir YDir
      Gap      DeltaX   DeltaY   AngZone Counter
      Ratio    Factor   HatchName  HatchDescr
      FileLines       FileLines  FileName
      Scaler   ScaledX  ScaledY  RF x
      y      h       _AB      _BC _AC
      _AD      _DE      _EF      _EH _FH
      DimZin
     )
;;;* BEGIN NESTED FUNCTIONS
 
  (defun round (num)
    (if (>= (- num (fix num)) 0.5)
      (fix (1+ num))
      (fix num)
    )
  )
 
  (defun dxf (code EnameOrElist / VarType)
    (setq VarType (type EnameOrElist))
    (if (= VarType (read "ENAME"))
      (cdr (assoc code (entget EnameOrElist)))
      (cdr (assoc code EnameOrElist))
    )
  )
 

  (defun ListToFile (TextList    FileName  DoOpenWithNotepad
       AsAppend    /   TextItem
       File    RetVal
      )
    (if (setq File (open FileName
    (if AsAppend
      "a"
      "w"
    )
     )
 )
      (progn
 (foreach TextItem TextList
   (write-line TextItem File)
 )
 (setq File (close File))
 (if DoOpenWithNotepad
   (startapp "notepad" FileName)
 )
      )
    )
    (FindFile FileName)
  )
 
;;;* END NESTED FUNCTIONS
  
  (princ
    (strcat
      "\n."
      "\n    0,1 ----------- 1,1"
      "\n     |               | "
      "\n     |  Lines and    | "
      "\n     |  points must  | "
      "\n     |  be snapped   | "
      "\n     |  to nearest   | "
      "\n     |  0.01         | "
      "\n     |               | "
      "\n    0,0 ----------- 1,0"
      "\n."
      "\nNote:  Lines must be drawn within 0,0 to 1,1 and lie on a 0.01 grid."
     )
  )
  (textscr)
  (getstring "\nHit [ENTER] to continue...")
 
  (princ
    "\nSelect 1x1 pattern of lines and/or points for new hatch pattern..."
  )
  (while (not (setq SelSet (ssget (list (cons 0 "LINE,POINT")))))
  )
  (setq ssNth    0
 SelSetSize (sslength SelSet)
 DimZin    (getvar "DIMZIN")
  )
  (setvar "DIMZIN" 11)
  (if (> SelSetSize 0)
    (princ "\nAnalyaing entities...")
  )
  (while (< ssNth SelSetSize)
    (setq Ent   (ssname SelSet ssNth)
   EntInfo (entget Ent)
   EntType (dxf 0 EntInfo)
   ssNth   (+ ssNth 1)
    )
    (cond
      ((= EntType "POINT")
       (setq pt1      (dxf 10 EntInfo)
      FileLine (strcat "0,"
         (rtos (car pt1) 2 6)
         ","
         (rtos (cadr pt1) 2 6)
         ",0,1,0,-1"
        )
       )
       (princ (strcat "\n" FileLine))
       (setq FileLines (cons FileLine FileLines))
      )
      ((= EntType "LINE")
       (setq pt1     (dxf 10 EntInfo)
      pt2     (dxf 11 EntInfo)
      Dist    (distance pt1 pt2)
      AngTo   (angle pt1 pt2)
      AngFrom (angle pt2 pt1)
      IsValid nil
       )
       (if
  (or (equal (car pt1) (car pt2) 0.0001)
      (equal (cadr pt1) (cadr pt2) 0.0001)
  )
   (setq DeltaX 0
  DeltaY 1
  Gap (- Dist 1)
  IsValid T
   )
   (progn
     (setq Ang   (if (< AngTo pi)
       AngTo
       AngFrom
     )
    AngZone (fix (/ Ang (/ pi 4)))
    XDir   (abs (- (car pt2) (car pt1)))
    YDir   (abs (- (cadr pt2) (cadr pt1)))
    Factor  1
    RF   1
     )
     (cond
       ((= AngZone 0)
        (setq DeltaY (abs (sin Ang))
       DeltaX (abs (- (abs (/ 1.0 (sin Ang))) (abs (cos Ang)))
       )
        )
       )
       ((= AngZone 1)
        (setq DeltaY (abs (cos Ang))
       DeltaX (abs (sin Ang))
        )
       )
       ((= AngZone 2)
        (setq DeltaY (abs (cos Ang))
       DeltaX (abs (- (abs (/ 1.0 (cos Ang))) (abs (sin Ang)))
       )
        )
       )
       ((= AngZone 3)
        (setq DeltaY (abs (sin Ang))
       DeltaX (abs (cos Ang))
        )
       )
     )
     (if (not (equal XDir YDir 0.001))
       (progn
  (setq Ratio  (if (< XDir YDir)
          (/ YDir XDir)
          (/ XDir YDir)
        )
        RF     (* Ratio Factor)
        Scaler (/ 1
    (if (< XDir YDir)
      XDir
      YDir
    )
        )
  )
  (if (not (equal Ratio (round Ratio) 0.001))
    (progn
      (while
        (and
   (<= Factor 100)
   (not (equal RF (round RF) 0.001))
        )
         (setq Factor (+ Factor 1)
        RF     (* Ratio Factor)
         )
      )
      (if (and (> Factor 1) (<= Factor 100))
        (progn
   (setq _AB (* XDir Scaler Factor)
         _BC (* YDir Scaler Factor)
         _AC (sqrt (+ (* _AB _AB) (* _BC _BC)))
         _EF 1
         x   1
   )
   (while (< x (- _AB 0.5))
     (setq y (* x (/ YDir XDir))
    h (if (< Ang (/ pi 2))
        (- (+ 1 (fix y)) y)
        (- y (fix y))
      )
     )
     (if (< h _EF)
       (setq _AD x
      _DE y
      _AE (sqrt (+ (* x x) (* y y)))
      _EF h
       )
     )
     (setq x (+ x 1))
   )
   (if (< _EF 1)
     (setq _EH (/ (* _BC _EF) _AC)
    _FH (/ (* _AB _EF) _AC)
    DeltaX (+ _AE
        (if (> Ang (/ pi 2))
          (- _EH)
          _EH
        )
     )
    DeltaY (+ _FH)
    Gap (- Dist _AC)
    IsValid T
     )
   )
        )
      )
    )
  )
       )
     )
     (if (= Factor 1)
       (setq Gap     (- Dist (abs (* Factor (/ 1 DeltaY))))
      IsValid T
       )
     )
   )
       )
       (if
  IsValid
   (progn
     (setq FileLine
     (strcat
       (angtos AngTo 0 6)
       ","
       (rtos (car pt1) 2 8)
       ","
       (rtos (cadr pt1) 2 8)
       ","
       (rtos DeltaX 2 8)
       ","
       (rtos DeltaY 2 8)
       ","
       (rtos Dist 2 8)
       ","
       (rtos Gap 2 8)
     )
     )
     (princ (strcat "\n" FileLine))
     (setq FileLines (cons FileLine FileLines))
   )
   (princ (strcat "\n * * *  Line with invalid angle "
    (angtos AngTo 0 6)
    (chr 186)
    " omitted.  * * *"
   )
   )
       )
      )
      ((princ
  (strcat "\n * * *  Invalid entity " EntType " omitted.")
       )
      )
    )
  )
  (setvar "DIMZIN" DimZin)
  (if
    (and
      FileLines
      (setq HatchDescr
      (getstring T
   "\nBriefly describe this hatch pattern: "
      )
      )
      (setq FileName (getfiled "Hatch Pattern File"
          "I:\\Acad\\Hatch\\"
          "pat"
          1
       )
      )
    )
     (progn
       (if (= HatchDescr "")
  (setq HatchDescr "Custom hatch pattern")
       )
       (setq HatchName (vl-filename-base FileName)
      FileLines (cons (strcat "*" HatchName "," HatchDescr)
        (reverse FileLines)
         )
       )
       (princ
  "\n============================================================"
       )
       (princ
  (strcat "\nPlease wait while the hatch file is created...\n"
  )
       )
       (ListToFile FileLines FileName nil nil)
       (command "delay" 1500)  ;delay required so file can be created and found (silly, but req.)
       (if (findfile FileName)
  (progn
    (setvar "HPNAME" HatchName)
    (princ (strcat "\nHatch pattern '"
     HatchName
     "' is ready to use!"
    )
    )
  )
  (progn
    (princ "\nUnable to create hatch pattern file:")
    (princ (strcat "\n  " FileName))
  )
       )
     )
     (princ
       (if FileLines
  "\nCancelled."
  "\nUnable to create hatch pattern from selected entities."
       )
     )
  )
  (princ)
)
 
(princ "\n ************************************************************** ")
(princ "\n**                                                            **")
(princ "\n*  HatchMaker.lsp written by Lanny Schiele -- enjoy!           *")
(princ "\n*                                                              *")
(princ "\n*  Type in DRAWHATCH to have the environment created to draw.  *")
(princ "\n*  Type in SAVEHATCH to save the pattern you created.          *")
(princ "\n**                                                            **")
(princ "\n ************************************************************** ")
(princ)
Advertisements

About AutoCAD Tips

This blog serves as a knowledge base for myself (and anyone else) so that I can reference tips & tricks that I have learned and also refer others to it as well. I hope that this blog helps you learn at least one tip to make your drafting/design experience better.
This entry was posted in AutoLISP, Customization, Hatch, TIPS. Bookmark the permalink.

39 Responses to AutoLISP: Make and Save Custom Hatch Pattern

  1. georgi ishkitiev says:

    10x for this script ! nice work

  2. Lan says:

    hi, i cant seem to create a hatch when like you did. It keeps on saying that invalid angle…
    any suggestion?

    • AutoCAD Tips says:

      I haven’t seen that error before. When drawing the hatch pattern, are you staying within that 1 inch by 1 inch square and only using lines?

      • PJ says:

        Have the same problem this is what Acad said…..

        Hit [ENTER] to continue…
        Select 1×1 pattern of lines and/or points for new hatch pattern…
        Select objects: 1 found
        Select objects: 1 found, 2 total
        Select objects:
        Analyaing entities…
        * * * Line with invalid angle 300º omitted. * * *
        * * * Line with invalid angle 60º omitted. * * *
        Unable to create hatch pattern from selected entities.

        within the square that acad draws

      • AutoCAD Tips says:

        Sorry that it doesn’t work for you. Here is the link to where the code came from http://cadtips.cadalyst.com/patterns/hatch-maker.
        I am super busy and cant look into it much right now.
        I would suggest posting a question either on the cadalyst site or on this CadTutor site where they talk about this routine. I think that someone might be quicker in responding with a solution. http://www.cadtutor.net/forum/showthread.php?8416-Create-a-hatch

        Again, Sorry for that
        ~Greg

  3. Ludmila Altman says:

    Great!!!During two days I had try to find something to define Custom hatch (for our customer) and so simple and so good!Thank you!

  4. Kayla says:

    I am using AutoCAD 2013 and when i tried to enter in DRAWHATCH like you did, it says “unknown command ‘DRAWHATCH’. Press F1 for help.” I really want to make shingle roof patterns for this chicken coop i’m making, but if I am unsuccessful with this pattern stuff I’ll have to move on and just recreate the image multiple times. That is just TEDIOUS. Please help?

    • AutoCAD Tips says:

      Hello Kayla,
      Please see this link for how to copy the code that is listed in the post and how to use it. the Commands shown in this post are not available in autocad by default you need to add them as custom commands that you can add. That is what AutoLISP is – it is a computer programming language that lets you make AutoCAD do what you want it to…
      Please see the links that are shown in the “About” section of my blog for how to copy the AutoLISP code that you find from the blog.
      https://autocadtips.wordpress.com/about/

      ~Greg

      • CAD Addict says:

        There are already lots of Shingle Roof hatch available. just google for it.
        i have tried this routine but it is only limited to using lines only. Am trying to make a complex Stone Paver pattern but i need to use arcs and curves and this routine does not support that yes

  5. Melih says:

    Hi;
    That’s a great script. I can use the command “drawhatch” but cant save it. When i try the command “SAVEHATCH” it says “unknown command ‘SAVEHATCH’. Press F1 for help.” Any suggetions? I’m using autocad 2012.

  6. wow…great work..i would like share about the AutoCAD Hatch Patterns.
    Browse our easy to install AutoCAD Hatch Patterns. We feature both a wood and stone hatch pattern set or a large collection of hatch patterns – over 350 available … or create your own hatch pattern with the Hatch Pattern Manager!

  7. WebCADer says:

    Thanks this is perfect. However say if I wanted it to show diagonal like “Grass” hatch, how do I do that? I’ve tried playing around with the .pat file but no joy.

  8. termal says:

    hi
    i just used line to create hatch and not worked spline ; how can i do to create hatch by spline or circle or arc or polyline !!!!!!!!!?

  9. albañil says:

    very good, thanks this is perfecto to me

  10. PJ says:

    I followed your post with the segmenting of the curves … but when i enter savehatch and select all the lines and i click save autocad said …. Line with invalid angle is omitted and then error: autocad variable setting rejected

    what did i do wrong ??

  11. max iv says:

    great !!! work fine!!!
    just stupit qiestion: is it possible to make one of the side diferent of 1? (to have some proportions)

  12. Nuria says:

    This was absolutely awesome! I’ve been searching all day for that solution and I was getting desperate… you save my day! :)

  13. Emily says:

    THANK YOU!!! This is exactly what I needed.

  14. spencermag@gmail.com says:

    where is the lisp download button!

  15. spencermag@gmail.com says:

    Oh. the code is for the lisp, ton for the example hatch? sorry!

  16. Can this function work with patterns that need to be a certain size? i.e. at a scale of 1.0, it will be larger than the 1×1 area. Thanks…

  17. Melonie says:

    I am having a heck of a time creating what I believe to be a “simple” hatch. After I create the .pat file, it breaks up the pattern. I am using basic lines, no p-lines or splines. Can someone help? I have my .dwg on dropbox:
    https://——————————————————————–
    Ps, I have loaded the .lsp file, followed all the instructions.

    • AutoCAD Tips says:

      Melonie,
      I figured out a solution and I will actually make a post about it because it isn’t as straight forward as making a hatch pattern and sending it to you in this case.
      I am working on it now and should have it up soon.
      ~Greg

  18. Pingback: Using SUPERHATCH To Make Complicated Hatch Patterns | AutoCAD Tips

  19. westernlogan : cad outsourcing company says:

    Very helpful for our team …
    Thanks

  20. chito serbatos says:

    this is very helpful, i was able to design my own tiles…
    however, the lisp is only for straight line, the lisp is not accepting circles, arc, curves and spline, what to do pls.

  21. David Webb says:

    is this the place where you can request assistance with writing a basic lisp routine?

  22. adam williams says:

    using the script im being given the message, “missing perpetrators on line…” what do you think is causing this?

  23. frank says:

    Muy bueno tu Lisp, pero quiero saber si puedo crear un hatch que no requiera de un cuadro de 1×1 sino que los lados tengan una relación entre sí, o de otra manera que sea rectangular… por favor responde y en donde puedo cambiar la programación del lisp.

  24. frank says:

    Muy bueno tu lisp, por favor quiesiera saber si se puede hacer en un rectángulo o que los lados tengan una relación, como cambiaría la programación del lisp…

  25. frank says:

    como cambiaría el código para hacer un hatch en formato rectangular… se agrace su respuesta…

  26. Pingback: How To Draw Roof Tiles In Autocad 3d | Information

  27. Pingback: Custom Revit Hatch Patterns - The EASY way! - revitIQ

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s