Preset your Hatching

[madcadder]

Here's a trick for those not using palettes...



There are many instances in daily operations where I repeatedly set down certain patterns. Usually on set layers at predetermined scales. Etc.

So how do you normally do that? Open the hatch dialog, set scale, pick pattern, blah, blah, blah. You know what you do.

Time consuming and then you have to do it again for the next pattern.

Per request and due to recent automation threads I though I’d share a way to resolve most of your hatch issues into as little as 3 clicks.

When testing on a new drawing I counted it at 12 clicks, not counting typing or scrolling, to do this.

The following Lisp will:

1) Presets the snapbase for this hatch pattern.
2) Checks to see if a layer exists, creates if needed, and sets it current.
3) Creates an 8 in tile flooring pattern with “island detection” preset to OUTER
4) Allows single or multiple selection of hatching area(s)
5) Sets layer, snapbase, hatch name, angle, scale, etc. back to what they were before command.




(DEFUN |hatcherror| (|msg|)
(IF (OR (= |msg| "Function cancelled")
(= |msg| "quit / exit abort")
)
(PRINC (STRCAT "\nError: " |msg|))
)
(SETVAR "clayer" |clayer|)
(SETVAR "hpang" |hpang|)
(SETVAR "hpname" |hpname|)
(SETVAR "hpscale" |hpscale|)
(SETQ *error* |olderror|)
(COMMAND "undo" "end")
(SETVAR "cmdecho" |cmdecho|)
(PRINC)
)


(DEFUN c:tile8 (/ |hpang| |hpname| |hpscale| |olderror| |autosnap|
|clayer| |cmdecho| |orthomode| |polarmode|
)
(COMMAND "undo" "begin") ; start undo
(SETQ |cmdecho| (GETVAR "cmdecho")) ; save current cmdecho
(SETVAR "cmdecho" 0) ; turn off echo
(SETQ |olderror| *error*) ; save current error code
(SETQ *error* |hatcherror|) ; set error code for this routine
(SETQ |clayer| (GETVAR "clayer")) ; save current layer
(SETQ |hpang| (GETVAR "hpang")) ; save current hatch angle
(SETQ |hpname| (GETVAR "hpname")) ; save current hatch name
(SETQ |hpscale| (GETVAR "hpscale")) ; save current hatch scale
(SETQ |osmode| (GETVAR "osmode")) ; saves current osnap settings
(SETQ |snapbase| (GETVAR "snapbase")) ;save current snapbase point
(SETVAR "osmode" 0) ; turn off osnaps
(SETQ |newbase| (GETPOINT "\nPick SNAPBASE for hatching area: "))
; Select snapbase point for this pattern
(SETVAR "snapbase" (LIST (CAR |newbase|) (CADR |newbase|)))
; set snapbase to point selected
(SETVAR "hpang" 0) ; set hatch angle to 0
(SETVAR "hpname" "net,o") ; set hatch name with OUTER island detection (",I" inner ",O" outer ",N" normal)
(SETVAR "hpscale" 64) ; set hatch scale (to equal 8" tile)
(IF (NOT (TBLSEARCH "layer" "dwgtexture"))
; search to see if layer exists
(COMMAND "_.-layer" "_make" "dwgtexture" "_color" "8" "dwgtexture"
""
) ; makes layer named dwgtexture with color set to 8 if not found
(COMMAND "_.-layer" "_thaw" "dwgtexture" "_on" "dwgtexture" "_set"
"dwgtexture" ""
) ; sets layer current if found
)
(PRINC
"\nHatch Pattern for 8in Tile Flooring ready: "
)
(PRINC "\nSelect internal point: ")
(COMMAND "-bhatch") ; starts hatch with dialog box supressed
(WHILE (> (GETVAR "cmdactive") 0) ; loops while selecting hatch area(s)
(COMMAND pause)
)
(SETVAR "clayer" |clayer|) ; set layer back to original layer
(SETVAR "hpang" |hpang|) ; sets hatch angle back to original angle
(SETVAR "hpname" |hpname|) ; sets hatch name back to original name
(SETVAR "hpscale" |hpscale|) ; sets hatch scale back to original scale
(SETQ *error* |olderror|) ; sets error back to original error
(COMMAND "undo" "end") ; ends undo
(SETVAR "cmdecho" |cmdecho|) ; set echo back to original
(PRINC) ; exit quietly
)