Perform hatch without superfluous requests

2026-01-15T18:09:29Z

Hi, everybody.
It is necessary to perform hatch, regardless of the previous type of hatching.
The code performs the hatch using the previous type, not the one specified in the code.

; *********** 
(defun c:HatchUser ( / ss)
  (setq ss (ssget))
  (if ss
    (progn
(command "_.-BHATCH" "_User" "_Double" "_Yes" "0" "200" "_S" ss "" "")
        )
    )
  (princ)
)

HatchUserdwg.dwg

Edited 13 hours ago by Nikon

2026-01-15T22:11:59Z

Maybe use (setvar 'hpname "User") in code, sets the pattern name.

2026-01-16T07:29:42Z

9 hours ago, BIGAL said:

Maybe use (setvar 'hpname "User") in code, sets the pattern name.

Spacing=200, double=yes and (setvar 'hpname old_hpname) do not work in this code
Is there a solution?

(defun c:HatchUserHpn ( / ss old_hpname )
(setq old_hpname (getvar 'hpname))
 (setvar 'hpname "_User")
  (setq ss (ssget))
  (if ss
    (progn
      ;; User-defined, angle=0, spacing=200, double=yes, select objects
      (command "BHATCH" "U" "0" "200" "D" "Y" "S" ss "" "")
     ;(command "_.-BHATCH" "_U" "0" "200" "_D" "_Y" "_S" ss "" "")
    )
  )
(setvar 'hpname old_hpname)
  (princ)
)

2026-01-16T16:43:13Z

If it all goes wrong then entmake it....

This link might help, with the code from code ding

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/entmake-hatch-with-base-point-or-object-polyline-entity-name/td-p/8696712

2026-01-16T16:57:49Z

59 minutes ago, Steven P said:

If it all goes wrong then entmake it....

This link might help, with the code from code ding

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/entmake-hatch-with-base-point-or-object-polyline-entity-name/td-p/8696712

Couldn't open the link...

I used the MHATCH.lsp code author VVA (2006).

; Thanks to the author VVA /2006/
(defun c:MHATCH ( /  nab cmd osm *error*)
(defun *error* (msg)(princ msg)
(if cmd (setvar "cmdecho" cmd))
(if osm (setvar "osmode" osm))
(princ))
(vl-load-com)
(setq cmd (getvar "cmdecho"))
(setq osm (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(setvar "hpassoc" 1)
(setq nab (ssget "_:L"))
(if 
(and nab 
(setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex nab)))))
 (foreach item lst
  (vl-catch-all-apply
    '(lambda ()
       (command "_.-bhatch" "_s" item "" ""))))) ;_foreach
(setvar "cmdecho" cmd)
(setvar "osmode" osm)
(princ))

I added two main lines
(setvar "hpdouble" 1) - criss-cross
(setvar "hpspace" 200) - spacing

The code is working. Perhaps there is a simpler solution.
I accept comments from the pros...

; MHATCH VVA /2006 + additions /2026
(defun c:UShatch_Doub_200 ( / nab cmd osm old_hpname old_hpang old_hpdouble old_hpspace old_hpassoc lst *error*)
  (defun *error* (msg)
    (princ msg)
    (if cmd (setvar "cmdecho" cmd))
    (if osm (setvar "osmode" osm))
    (if old_hpname (setvar "hpname" old_hpname))
    (if old_hpang (setvar "hpang" old_hpang))
    (if old_hpdouble (setvar "hpdouble" old_hpdouble))
    (if old_hpspace (setvar "hpspace" old_hpspace))
    (if old_hpassoc (setvar "hpassoc" old_hpassoc))
    (princ)
  )
  (vl-load-com)
  (setq cmd (getvar "cmdecho"))
  (setq osm (getvar "osmode"))
  (setvar "cmdecho" 0)
  (setvar "osmode" 0)

  (setq old_hpname (getvar "hpname"))
  (setq old_hpang (getvar "hpang"))
  (setq old_hpdouble (getvar "hpdouble"))
  (setq old_hpspace (getvar "hpspace"))
  (setq old_hpassoc (getvar "hpassoc"))

  (setvar "hpname" "_USER")
  (setvar "hpang" 0)
  (setvar "hpdouble" 1) 
  (setvar "hpspace" 200)
  (setvar "hpassoc" 1)

  (setq nab (ssget "_:L"))
  (if (and nab (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex nab))))
           )
    (foreach item lst
      (vl-catch-all-apply
        '(lambda ()
           (command "_.-bhatch" "_s" item "" "")
         )
       )
    )
  )

  (setvar "hpname" old_hpname)
  (setvar "hpang" old_hpang)
  (setvar "hpdouble" old_hpdouble)
  (setvar "hpspace" old_hpspace)
  (setvar "hpassoc" old_hpassoc)
  (setvar "cmdecho" cmd)
  (setvar "osmode" osm)
  (princ)
)
(princ "Type in the command prompt UShatch_Doub_200")

Thank @BIGAL, you gave me the right direction.

"Maybe use (setvar 'hpname "User") in code, sets the pattern name".

Edited 2 hours ago by Nikon

2026-01-16T18:32:15Z

@Nikon FWIW, Here is an opportunity to show you how to store and retrieve system variables without all the extra variables in Lisp. Also - I've added undo marks to the command so everything stays together, and some stuff into the error handler. Nothing you did wrong; just showing another way to do the same thing with different techniques.

; MHATCH VVA /2006 + additions /2026
(defun c:UShatch_Doub_200 ( / d lst nab vars *error*)
  
   (defun *error* (msg)
      (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*quit*,*exit*"))
	      (princ (strcat "\nError: " msg "\n"))
          (princ "\nProgram Aborted.\n")
      )
      ;; Cancel any open commands.
      (while (not (equal (getvar "cmdnames") ""))(command-s))
      ;; If uh:varlist is found, reset all the system variables to original values stored.
      (if uh:varlist
         (mapcar '(lambda (var)(setvar (car var) (cdr var))) uh:varlist)
      )
      (while (equal 8 (logand 8 (getvar "undoctl")))
         (vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))
      )
      (princ)
   )

   (vl-load-com)
   
   ;; Set an undo mark
   (vla-StartUndoMark (setq d (vla-get-activedocument (vlax-get-acad-object))))

   ;;Create an association list for the system variables and values to be set.
   (setq vars '(("cmdecho" . 0) ("osmode" . 0) ("hpname" . "_USER") ("hpang" . 0) ("hpdouble" . 1) ("hpspace" . 200) ("hpassoc" . 1)))
   
   ;; Gather the existing values for the system variables and add to association list "uh:varlist"
   (setq uh:varlist
      (mapcar '(lambda (var)(cons (car var) (getvar (car var)))) vars)
   )
   
   ;; Set all the system variable to the values stored in "vars".
   (mapcar '(lambda (var)(setvar (car var) (cdr var))) vars)
   
   (if
      (and
         (setq nab (ssget "_:L"))
         (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex nab))))
      )
      (foreach item lst
         (vl-catch-all-apply
            '(lambda ()(command "_.-bhatch" "_s" item "" ""))
         )
      )
   )

  (mapcar
    (function (lambda (var)(setvar (car var) (cdr var))))
    uh:varlist
  )
  
  (vla-EndUndoMark d)
    
  (princ)
)
(princ "Type in the command prompt UShatch_Doub_200")

Edited 1 hour ago by pkenewell

2026-01-16T18:46:30Z

13 minutes ago, pkenewell said:

@Nikon FWIW, Here is an opportunity to show you how to store and retrieve system variables without all the extra variables in Lisp. Also - I've added undo marks to the command so everything stays together, and some stuff into the error handler. Nothing you did wrong; just showing another way to do the same thing with different techniques.

Thank @pkenewell, I will study it.

2026-01-16T19:39:38Z

Another example. This allows you to select a closed polyline and hatch it by aligning itself to the side of the selection point.

(vl-load-com)
(defun c:hatch_align_vtx ( / AcDoc flag *error* f_pat ent Space pr-1 pr-1 alpha hatch)
  (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) flag T)
  (vla-StartUndoMark AcDoc)
  (defun *error* (msg)
    (and
      msg
      (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*,*EXIT*"))
      (princ (strcat "\nError: " msg))
    )
    (if
      (= 8 (logand (getvar "UNDOCTL") 8))
      (vla-endundomark AcDoc)
    )
    (princ)
  )
  (if (not (findfile "BAT_PUBL.pat"))
    (progn
      (setq f_pat (open (strcat (getvar "ROAMABLEROOTPREFIX") "support\\BAT_PUBL.pat") "w"))
      (write-line "*BAT_PUBL" f_pat)
      (write-line "45,0,0,0,.75" f_pat)
      (write-line "315,0,0,0,.75" f_pat)
      (close f_pat)
    )
  )
  (while (setq ent (entsel "\nSelect the long side polyline to hatch it: "))
    (setq obj_curv (vlax-ename->vla-object (car ent)))
    (cond
      ((and
        (eq (vlax-get-property obj_curv 'ObjectName) "AcDbPolyline")
        (eq (vla-get-closed obj_curv) :vlax-true)
       )
        (setq
          Space
          (if (eq (getvar "CVPORT") 1)
            (vla-get-PaperSpace AcDoc)
            (vla-get-ModelSpace AcDoc)
          )
          pr-1 (fix (vlax-curve-getParamAtPoint obj_curv (vlax-curve-getClosestPointTo obj_curv (cadr ent) nil)))
          pr+1 (if (>= (1+ pr-1) (fix (vlax-curve-getEndParam obj_curv))) 0 (1+ pr-1))
          alpha (+ (angle (vlax-curve-getPointAtParam obj_curv pr-1) (vlax-curve-getPointAtParam obj_curv pr+1)) (* 0.25 pi))
        )
        (setq hatch (vla-AddHatch Space acHatchPatternTypeCustomDefined "BAT_PUBL" :vlax-True))
        (vlax-invoke hatch 'AppendOuterLoop (list obj_curv))
        (vla-put-patternscale hatch 1.0)
        (vla-put-patternangle hatch alpha)
        (vla-evaluate hatch)
      )
    )
  )
  (*error* nil)
  (vla-EndUndoMark AcDoc)
  (prin1)
)

2026-01-16T20:04:34Z

37 minutes ago, Tsuky said:

Another example. This allows you to select a closed polyline and hatch it by aligning itself to the side of the selection point.

I'm changing the scale of the hatch in this line:

 ; (vla-put-patternscale hatch 1.0)
    (vla-put-patternscale hatch 200)

Super! A completely different approach.

Thanks @Tsuky

Edited 18 minutes ago by Nikon

2026-01-16T20:18:16Z

42 minutes ago, Tsuky said:
(vla-put-patternscale hatch 1.0)

I was a bit hasty.
With a scale of 200, the cell pitch is 150x150, so to get 200x200, you need to set the scale to 266.67.

Edited 13 minutes ago by Nikon

Sign In

Perform hatch without superfluous requests

Recommended Posts

Nikon

BIGAL

Nikon

Steven P

Nikon

pkenewell

Nikon

Tsuky

Nikon

Nikon

Join the conversation

Tutorials

Forums

Activity