Break while loop on enter, hatch command

[lastknownuser]

Usually I find solutions on all my problems by searching other posts but this one I couldn't find anywhere so here it is, my first post.
Jus to say I am not an expert in lisp but I understand some basic stuff.

My problem is next:
I have a lisp that is creating hatch using -hatch command in while loop, but I need to break the loop with enter (or any other key), NOT ESC, so it doesn't stop the lisp because there is some other stuff with layers that it needs to do.

Here is what I have
(while ""
(command "-hatch" "P" "S" "CO" "" pause "")
)

And I have tried with (setq P (getpoint) after while, which is working like I want it, but I need to click two times, first select some point and then click where to hatch. Maybe theres a way to use the selected point as hatch point? Any help would be good, thanks.

[tombu]

For current versions try:

(command "-hatch" "P" "S" "CO" "" pause "")
(while (=(getvar 'CMDNAMES) "HATCH")(command-s PAUSE))

or

(command "-hatch" "P" "S" "CO" "" pause "")
(while (=(getvar 'CMDNAMES) "HATCH")(command PAUSE))

for AutoCAD 2014

[dan20047]

Please provide more of your code for a better answer. The solution might be to collect the point/selection data before using the hatch command, or it might be to collect the objects created by the hatch command and modify them, say change their layer. Each technique uses different code. For example the following code hatches on the same layer as selected plines and then moves everything back in draworder. I haven't provided all the subroutines such as the ERROR & SETV, but the subroutines for collecting new objects are at bottom.

 

;;; Bhatch Multiple closed polylines with current hatch pattern & on same layer & send to back
(defun c:BHatchMultipleCBack ( / ss i iss en ed elay elst)
  (SAA-ERROR-INIT (list (list "cmdecho" 0) T))
  (SETV "clayer" (getvar "clayer"))     ;save current layer
  (princ (strcat "\nSelect Multiple Closed Polylines To Hatch with current pattern: " (getvar "HPNAME")))
;  (if (setq ss (ssget (list (cons 0 "*POLYLINE")))) ;(cons 70 1))))
;  (if (setq ss (ssget (list (cons 0 "*POLYLINE") (cons 70 1))))
  (if (setq ss (ssget (list (cons -4 "<OR")(cons 0 "*POLYLINE,REGION")(cons 0 "CIRCLE")(cons 0 "ELLIPSE")(cons -4 "OR>")))) ;(cons 70 1))))
    (progn
      (setq i 0
            elst (SAA_GetLast)
      )
      (setq iss (sslength ss))
      (while (< i iss)
        (setq en (ssname ss i)
              ed (entget en)
              elay (cdr (assoc 8 ed))
        ) ;_setq
        (setvar "CLAYER" elay)
        (command "-bhatch" "select" "single" en  "")
        (setq i (1+ i))
      ); end while
      (command "draworder" ss (SAA_AFTER elst) "" "back") ;send selected boundaries & new hatches to back
      (princ (strcat "\n\nPolylines Selected: " (itoa i)))
    );; end progn
    (prompt "\nNo Polylines Selected to Process ")
  );; end if
  (RSETV "clayer")
  (SAA-ERROR-RESTORE)
  (princ)
)

;;;==============================================================================
;;; Returns selection set of all entities after passed in entity name
;;; taken from CAD Cookbook utilities
;;;==============================================================================
(defun SAA_AFTER (ename / ss)
  (setq ss (ssadd))					;create selection set
  (if ename
    (while (setq ename (entnext ename))
       (ssadd ename ss)					;add entities to set
    )
;;;    (setq ss (ssget "X"))				;if no last entity, get all
  ) ;end if
  (if (> (sslength ss) 0) ss)			;return nil if no entities
)

;;;==============================================================================
;;; Returns last entity, even subentities on polylines
;;; used to ensure SAA_AFTER skips to the next full entity, not just a subentity
;;;
;;; by roy_043 from http://www.theswamp.org/index.php?topic=35626.msg408522#msg408522
;;;==============================================================================
(defun SAA_GetLast ( / ent newEnt)
  (setq ent (entlast))
  (while (and
           ent
           (setq newEnt (entnext ent))
         )
    (setq ent newEnt)
  )
  ent
)

 

[lastknownuser]

@tombu - that way I can only put one hatch, and then lisp stops. I would like it to be able to continue clicking hatches as long as I want and then on enter the while loop would stop and the lisp would do next command

@dan20047 - the lisp is simple, just to put hatches inside certain areas and then on enter it would freez/unfreez the layers the way I want it.

Here is the full code:
 

(defun c:hatchtest ()
(IF (layerstate-has "$TEMP") (layerstate-delete "$TEMP"))
(COMMAND "-LAYER" "A" "S" "$TEMP" "" "" "") 
(graphscr)
(setq frz "area_*")
(setq unfr "line_*,plot_*")
(lathfr unfr frz)
(setq lay (cdr (assoc 2 (tblsearch "LAYER" "plot_1"))))
(if (/= lay "plot_1")
(progn
(command "layer" "new" "plot_1" "color" "8" "plot_1"  "")
(command "clayer" "plot_1" )
)
(command "clayer" "plot_1")
)
(while ""
(command "-hatch" "P" "S" "CO" "" pause "")      
);while     
(IF (layerstate-has "$TEMP") 
(COMMAND "-LAYER" "A" "R" "$TEMP" "" ""))
(princ)
)

 

[tombu]

5 hours ago, lastknownuser said:

@tombu - that way I can only put one hatch, and then lisp stops. I would like it to be able to continue clicking hatches as long as I want and then on enter the while loop would stop and the lisp would do next command

@dan20047 - the lisp is simple, just to put hatches inside certain areas and then on enter it would freez/unfreez the layers the way I want it.

Here is the full code:

Can you include the "lathfr" function needed to run the routine?

You could replace:

(setq lay (cdr (assoc 2 (tblsearch "LAYER" "plot_1"))))
(if (/= lay "plot_1")
(progn
(command "layer" "new" "plot_1" "color" "8" "plot_1"  "")
(command "clayer" "plot_1" )
)
(command "clayer" "plot_1")
)

with

(command "layer" "N" "plot_1" "S" "" "C" "8" ""  "")

 

[lastknownuser]

@tombu "lathfr" is a simple function that freezer layers defined by "frz" variable and unfreezez the other. And I could change what you mentioned, but that doesn't change anything regarding my problem with the while loop. Maybe I'm trying do something that can't be done?

[dan20047]

Your while loop is checking for empty string "", thus never stopping. You could change that to (while (setq pt1 (getpoint)), and then use the variable pt1 inside the hatch command in place of pause. If you press enter instead of picking a point, pt1 will be nil, and the while loop will exit. 

[tombu]

Try:

(defun c:hatchtest (/ *error*)
 (defun *Error* (msg) ; embedded defun
   (if (layerstate-has "$TEMP")(COMMAND "-LAYER" "A" "R" "$TEMP" "" ""))
   (if (/= s "Function cancelled")
     (princ (strcat "\nError: " msg))
   )
   (princ)
 )
 (IF (layerstate-has "$TEMP") (layerstate-delete "$TEMP"))
 (COMMAND "-LAYER" "stAte" "S" "$TEMP" "" "" "") 
 (command "layer" "N" "plot_1" "S" "" "C" "8" "" "" "")
 (command "-hatch" "P" "S" "CO" "" pause)      
 (while (=(getvar 'CMDNAMES) "-HATCH")(command PAUSE))(princ)
 (COMMAND "-LAYER" "A" "R" "$TEMP" "D" "$TEMP" "" "")
)

 

[mhupp]

@lastknownuserThis is probably the simplest. If you keep creating hatches they will never equal until you set through the loop without creating a new hatch. Found in a Lee Mac post 10 years ago.

 

(setq LastEntity T)
(while (not (equal LastEntity ThisEntity))
   (setq LastEntity (entlast))
   (command "-hatch" "P" "S" "CO" "" pause "")
   (setq ThisEntity (entlast))
 )

 

-EDIT- Forgot the first line. without it they would both be nil at the start.

 

Edited May 13, 2021 by mhupp

[lastknownuser]

14 hours ago, dan20047 said:

Your while loop is checking for empty string "", thus never stopping. You could change that to (while (setq pt1 (getpoint)), and then use the variable pt1 inside the hatch command in place of pause. If you press enter instead of picking a point, pt1 will be nil, and the while loop will exit. 

I understand that and I wrote in my first post that I tried with getpoint and its working how I want it but it requires for me to click two time, first to pick point and then to pick area for hatch. If there is a way to avoid that double click I'd like to know, but I can't figure it out.
 

14 hours ago, tombu said:

Try:

(defun c:hatchtest (/ *error*)
 (defun *Error* (msg) ; embedded defun
   (if (layerstate-has "$TEMP")(COMMAND "-LAYER" "A" "R" "$TEMP" "" ""))
   (if (/= s "Function cancelled")
     (princ (strcat "\nError: " msg))
   )
   (princ)
 )
 (IF (layerstate-has "$TEMP") (layerstate-delete "$TEMP"))
 (COMMAND "-LAYER" "stAte" "S" "$TEMP" "" "" "") 
 (command "layer" "N" "plot_1" "S" "" "C" "8" "" "" "")
 (command "-hatch" "P" "S" "CO" "" pause)      
 (while (=(getvar 'CMDNAMES) "-HATCH")(command PAUSE))(princ)
 (COMMAND "-LAYER" "A" "R" "$TEMP" "D" "$TEMP" "" "")
)

 

Thanks! This is working how I want it, sort of. Except all areas I select to hatch are defined as one hatch, and I would prefer it to be each hatch for each closed area, but if that can't be done then nevermind.

 

10 hours ago, mhupp said:

@lastknownuserThis is probably the simplest. If you keep creating hatches they will never equal until you set through the loop without creating a new hatch. Found in a Lee Mac post 10 years ago.

 

(while (not (equal LastEntity ThisEntity))
   (setq LastEntity (entlast))
   (command "-hatch" "P" "S" "CO" "" pause "")
   (setq ThisEntity (entlast))
 )

 

https://www.cadtutor.net/forum/topic/29881-question-about-exiting-a-while-loop/?do=findComment&comment=239738

I udnerstand the logic of what are you saying, and what is said in that post, but I can't implement it in a way how I want it with a hatch command. And I tried your code but its not working for me unfortunately, nothing happens

[mhupp]

5 hours ago, lastknownuser said:

I understand the logic of what are you saying, and what is said in that post, but I can't implement it in a way how I want it with a hatch command. And I tried your code but its not working for me unfortunately, nothing happens

 

Sorry I was missing the (setq LastEntity T). Without setting the LastEntity before entering the loop both are nil at the start making the while statement true and it just exits. Your code with the added loop logic.

 

(defun c:hatchtest (/ frz unfr lathfr lay LastEntity ThisEntity)
  (if (layerstate-has "$TEMP") (layerstate-delete "$TEMP"))
  (vl-cmdf "-Layer" "A" "S" "$TEMP" "" "" "")
  (graphscr)
  (setq frz "area_*")
  (setq unfr "line_*,plot_*")
  (lathfr unfr frz)
  (setq lay (cdr (assoc 2 (tblsearch "LAYER" "plot_1"))))
  (if (/= lay "plot_1")
    (progn
      (vl-cmdf "layer" "new" "plot_1" "color" "8" "plot_1" "")
      (vl-cmdf "clayer" "plot_1")
    )
    (vl-cmdf "clayer" "plot_1")
  )
  (setq LastEntity T)
  (while (not (equal LastEntity ThisEntity))
    (setq LastEntity (entlast))
    (vl-cmdf "-hatch" "P" "S" "CO" "" pause "")
    (setq ThisEntity (entlast))
  )
  (if (layerstate-has "$TEMP")
      (vl-cmdf "-Layer" "A" "R" "$TEMP" "" "")
  )
  (princ)
)

 

Edited May 13, 2021 by mhupp

[tombu]

5 hours ago, lastknownuser said:

Thanks! This is working how I want it, sort of. Except all areas I select to hatch are defined as one hatch, and I would prefer it to be each hatch for each closed area, but if that can't be done then nevermind.

That can easily be controlled with the system variable HPSEPARATE: https://help.autodesk.com/view/ACD/2022/ENU/?guid=GUID-82537D46-06CD-4A2B-9148-1475A3599B12

Controls whether a single hatch object or separate hatch objects are created when operating on several closed boundaries.

Type:Integer

Saved in:Registry

Initial value:0

Value = 0 A single hatch object is created

Value = 1 Separate hatch objects are created

 

I'd save current value, set it to 1 for the lisp, then reset it on exit.

[lastknownuser]

Thank you guys, both solutions work how I wanted,  you helped me a lot!

[lastknownuser]

One more question, when I start the lisp in new drawing its asking me to set the hatch background color when I use it for the first time, I just click to select none and its not a big deal but I'm wondering is there a way to avoid that, to define this value within the lisp itself? I tried with "-HPBACKGROUNDCOLOR" command but it doesn't work 

[tombu]

5 hours ago, lastknownuser said:

One more question, when I start the lisp in new drawing its asking me to set the hatch background color when I use it for the first time, I just click to select none and its not a big deal but I'm wondering is there a way to avoid that, to define this value within the lisp itself? I tried with "-HPBACKGROUNDCOLOR" command but it doesn't work 

(setvar 'HPSEPARATE 1)
(setvar 'HPBACKGROUNDCOLOR "None")

HPBACKGROUNDCOLOR is a system variable so setting it with setvar should work. If needed HPCOLOR should be set to ByLayer.

[lastknownuser]

1 hour ago, tombu said:

(setvar 'HPSEPARATE 1)
(setvar 'HPBACKGROUNDCOLOR "None")

HPBACKGROUNDCOLOR is a system variable so setting it with setvar should work. If needed HPCOLOR should be set to ByLayer.

My mistake, that is how I tried it, not the way I wrote it as command "-HPBACKGROUNDCOLOR", but its still not working because it is asking me to set new background color no matter how I define it with setvar function. For example I wrote (setvar 'HPBACKGROUNDCOLOR "1") in lisp and on start of the lisp it is still asking me to confirm "1" or set new color.

[tombu]

58 minutes ago, lastknownuser said:

My mistake, that is how I tried it, not the way I wrote it as command "-HPBACKGROUNDCOLOR", but its still not working because it is asking me to set new background color no matter how I define it with setvar function. For example I wrote (setvar 'HPBACKGROUNDCOLOR "1") in lisp and on start of the lisp it is still asking me to confirm "1" or set new color.

 

Try:

(command "-hatch" "P" "S" "CO" "." "." "" pause)

 

Edited May 14, 2021 by tombu
Set background color