Perform hatch without superfluous requests

[Nikon]

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 11 hours ago by Nikon

[BIGAL]

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

[Nikon]

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

 

[Steven P]

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

[Nikon]

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 1 hour ago by Nikon

[pkenewell]

@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 9 minutes ago by pkenewell

[Nikon]

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.