Hi guys,
I made this routine and it works very well for me but I have a issue that I can not figure out how to do.
Basicaly, the routine asks for the user to choose the hatch type (Retirer/Percer), then the layer (Defpoints/Select/Current) and finaly the type of the object to draw (Polyline/Rectangle). My original routine has also a Circle and a Boundary options, and an Error trap to reset the variables but I will keep it simple for the purpose of my issue.
So, my issue is: when I choose the type of object to draw, it draws just one of it and the routine ends. I would like to have something that "says" to the routine that I want to keep drawing that object (Polyline or Rectangle) and putting the hacth inside until I do enter and then the routine goes to its end.
Can I have any help please?
Thanks!
Solved! Go to Solution.
Solved by marko_ribar. Go to Solution.
Did I put the file attached?
The new look of the site is a mess...
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; SUBFUNCTIONS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;get the layer needed
(defun selectobject ()
(command "select" nil);to remove selection if an object is already selected
(command "laymcur")
(princ "\nSelect an object to take its layer:")
(setvar "cecolor" "BYLAYER")
(setvar "celtype" "BYLAYER")
(command pause);wait until I draw the rectangle or the pline
(setq Layerselectobject (getvar "clayer"))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;draw rectangle
(defun drawrectangle ()
(command "rectang")
(while (> (getvar 'cmdactive) 0) (command pause));while the command is active, wait...
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;draw pline
(defun drawpline()
(command "pline")
(while (> (getvar 'cmdactive) 0) (command pause));while the command is active, wait...
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun createLayerDef ()
;create layer if not present
(if (tblsearch "layer" "Defpoints")
(command "_.-layer" "_U" "Defpoints" "_T" "Defpoints" "_ON" "Defpoints" "")
(command "_.-layer" "_M" "Defpoints" "_C" "158" "" "")
);if
(setvar "clayer" "Defpoints")
(setvar "cecolor" "30")
(setvar "celtype" "BYLAYER")
);defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;initget Defpoints Select Current
(defun initgetLayer()
(initget "Defpoints Select Current")
(setq ansLayer (cond ( (getkword "\nSpecify Layer [Defpoints/Select/Current] <Current>: ") ) ( "Current" )))
(cond
((eq anslayer "Defpoints")
(setvar "thumbsize" 1)
);eq
((eq anslayer "Select")
(setvar "thumbsize" 2)
(selectobject)
);eq
((eq ansLayer "Current")
(setq llocalGen (getvar "clayer"));need because Defpoints can be choosen after this
);eq
);cond
)
;;;;;;;;;;;;;;;;;;;;;;;;;; SET HATCH VARIABLES ;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun sethatchVarRet ()
;set hatch variables
(setvar "hpassoc" 1)
(setvar "hpcolor" "31")
(setvar "hpdraworder" 3)
(setvar "hpname" "ANSI31")
(setvar "hpislanddetection" 0)
(setvar "hplayer" ".")
(setvar "hpang" 0)
(setvar "hpscale" 15)
(setvar "hpseparate" 1)
);defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun sethatchVarPer ()
;set hatch variables Percer en Chantier
(setvar "hpassoc" 1)
(setvar "hpcolor" "2")
(setvar "hpdraworder" 3)
(setvar "hpname" "ANSI31")
(setvar "hpislanddetection" 0)
(setvar "hplayer" ".")
(setvar "hpang" 0)
(setvar "hpscale" 1)
(setvar "hpseparate" 1)
(setvar "celtype" "Continuous")
);defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; MAIN ROUTINE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:HTT (/ ansLayer ansHatch llocalGen typ)
(setvar "thumbsize" 0);variable randomly chosen to provide the Defpoints option
(setq llocalGen (getvar "clayer"));because I want the hatch in the current layer when I choose Defpoints option
(initget "Retirer Percer")
(setq ansHatch (cond ( (getkword "\nSpecify hatch type: [Retirer/Percer] <Percer>: ") ) ( "Percer" )))
(cond ;for ansHatch
((eq ansHatch "Retirer")
(initgetLayer)
(initget "Polyline Rectangle")
(setq typ (cond ( (getkword "\nChoose [Polyline/Rectangle] <Rectangle>: ") ) ( "Rectangle" )))
(cond ;for typ
((eq typ "Polyline")
(if (= (getvar "thumbsize") 1) (createLayerDef))
(command "multiple")
(drawpline)
(setvar "clayer" llocalGen);need to remade the current layer over Defpoints to make the hatch
(if (= (getvar "thumbsize") 2) (setvar "clayer" Layerselectobject));because I want the hatch in the choosen layer
(sethatchVarRet)
(command "_.bhatch" "s" "l" "" "")
);eq Polyline
((eq typ "Rectangle")
(if (= (getvar "thumbsize") 1) (createLayerDef))
(drawrectangle)
(setvar "clayer" llocalGen);need to remade the current layer over Defpoints to make the hatch
(if (= (getvar "thumbsize") 2) (setvar "clayer" Layerselectobject));because I want the hatch in the choosen layer
(sethatchVarRet)
(command "_.bhatch" "s" "l" "" "")
);eq Rectangle
);cond typ
(princ "\nHatch *Retirer* finished.")
);eq
((eq ansHatch "Percer")
(initgetLayer)
(initget "Polyline Rectangle")
(setq typ (cond ( (getkword "\nChoose [Polyline/Rectangle] <Rectangle>: ") ) ( "Rectangle" )))
(cond ;for typ
((eq typ "Polyline")
(if (= (getvar "thumbsize") 1) (createLayerDef))
(drawpline)
(setvar "clayer" llocalGen);need to remade the current layer over Defpoints to make the hatch
(if (= (getvar "thumbsize") 2) (setvar "clayer" Layerselectobject));because I want the hatch in the choosen layer
(sethatchVarPer)
(command "_.bhatch" "s" "l" "" "")
);eq Polyline
((eq typ "Rectangle")
(if (= (getvar "thumbsize") 1) (createLayerDef))
(drawrectangle)
(setvar "clayer" llocalGen);need to remade the current layer over Defpoints to make the hatch
(if (= (getvar "thumbsize") 2) (setvar "clayer" Layerselectobject));because I want the hatch in the choosen layer
(sethatchVarPer)
(command "_.bhatch" "s" "l" "" "")
);eq Rectangle
);cond typ
(princ "\nHatch *Parcer* finished.")
);eq
);cond ansHatch
(princ)
);defun
Here is quick fix...
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; SUBFUNCTIONS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;get the layer needed (defun selectobject () (command "select" nil) ;to remove selection if an object is already selected (command "laymcur") (princ "\nSelect an object to take its layer:") (setvar "cecolor" "BYLAYER") (setvar "celtype" "BYLAYER") (command pause) ;wait until I draw the rectangle or the pline (setq Layerselectobject (getvar "clayer")) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;draw rectangle (defun drawrectangle () (command "rectang") (while (> (getvar 'cmdactive) 0) (command pause)) ;while the command is active, wait... ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;draw pline (defun drawpline () (command "pline") (while (> (getvar 'cmdactive) 0) (command pause)) ;while the command is active, wait... ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun createLayerDef () ;create layer if not present (if (tblsearch "layer" "Defpoints") (command "_.-layer" "_U" "Defpoints" "_T" "Defpoints" "_ON" "Defpoints" "" ) (command "_.-layer" "_M" "Defpoints" "_C" "158" "" "") ) ;if (setvar "clayer" "Defpoints") (setvar "cecolor" "30") (setvar "celtype" "BYLAYER") ) ;defun ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;initget Defpoints Select Current (defun initgetLayer () (initget "Defpoints Select Current") (setq ansLayer (cond ((getkword "\nSpecify Layer [Defpoints/Select/Current] <Current>: " ) ) ("Current") ) ) (cond ((eq anslayer "Defpoints") (setvar "thumbsize" 1) ) ;eq ((eq anslayer "Select") (setvar "thumbsize" 2) (selectobject) ) ;eq ((eq ansLayer "Current") (setq llocalGen (getvar "clayer")) ;need because Defpoints can be choosen after this ) ;eq ) ;cond ) ;;;;;;;;;;;;;;;;;;;;;;;;;; SET HATCH VARIABLES ;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun sethatchVarRet () ;set hatch variables (setvar "hpassoc" 1) (setvar "hpcolor" "31") (setvar "hpdraworder" 3) (setvar "hpname" "ANSI31") (setvar "hpislanddetection" 0) (setvar "hplayer" ".") (setvar "hpang" 0) (setvar "hpscale" 15) (setvar "hpseparate" 1) ) ;defun ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun sethatchVarPer () ;set hatch variables Percer en Chantier (setvar "hpassoc" 1) (setvar "hpcolor" "2") (setvar "hpdraworder" 3) (setvar "hpname" "ANSI31") (setvar "hpislanddetection" 0) (setvar "hplayer" ".") (setvar "hpang" 0) (setvar "hpscale" 1) (setvar "hpseparate" 1) (setvar "celtype" "Continuous") ) ;defun ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; MAIN ROUTINE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:HTT (/ *error* ansLayer ansHatch llocalGen typ ch) (defun *error* (msg) (if msg (prompt msg) ) (princ) ) (setvar "thumbsize" 0) ;variable randomly chosen to provide the Defpoints option (setq llocalGen (getvar "clayer")) ;because I want the hatch in the current layer when I choose Defpoints option (initget "Retirer Percer") (setq ansHatch (cond ((getkword "\nSpecify hatch type: [Retirer/Percer] <Percer>: " ) ) ("Percer") ) ) (cond ;for ansHatch ((eq ansHatch "Retirer") (initgetLayer) (initget "Polyline Rectangle") (setq typ (cond ((getkword "\nChoose [Polyline/Rectangle] <Rectangle>: ")) ("Rectangle") ) ) (cond ;for typ ((eq typ "Polyline") (while (progn (if (= (getvar "thumbsize") 1) (createLayerDef) ) (drawpline) (setvar "clayer" llocalGen) ;need to remade the current layer over Defpoints to make the hatch (if (= (getvar "thumbsize") 2) (setvar "clayer" Layerselectobject) ) ;because I want the hatch in the choosen layer (sethatchVarRet) (command "_.bhatch" "s" "l" "" "") (initget "Yes No") (setq ch (getkword "\nContinue with drawing [Yes/No] <Yes>: ") ) (if (or (eq ch "Yes") (eq ch nil)) t nil ) ) ;progn ) ;while ) ;eq Polyline ((eq typ "Rectangle") (while (progn (if (= (getvar "thumbsize") 1) (createLayerDef) ) (drawrectangle) (setvar "clayer" llocalGen) ;need to remade the current layer over Defpoints to make the hatch (if (= (getvar "thumbsize") 2) (setvar "clayer" Layerselectobject) ) ;because I want the hatch in the choosen layer (sethatchVarRet) (command "_.bhatch" "s" "l" "" "") (initget "Yes No") (setq ch (getkword "\nContinue with drawing [Yes/No] <Yes>: ") ) (if (or (eq ch "Yes") (eq ch nil)) t nil ) ) ;progn ) ;while ) ;eq Rectangle ) ;cond typ (princ "\nHatch *Retirer* finished.") ) ;eq ((eq ansHatch "Percer") (initgetLayer) (initget "Polyline Rectangle") (setq typ (cond ((getkword "\nChoose [Polyline/Rectangle] <Rectangle>: ")) ("Rectangle") ) ) (cond ;for typ ((eq typ "Polyline") (while (progn (if (= (getvar "thumbsize") 1) (createLayerDef) ) (drawpline) (setvar "clayer" llocalGen) ;need to remade the current layer over Defpoints to make the hatch (if (= (getvar "thumbsize") 2) (setvar "clayer" Layerselectobject) ) ;because I want the hatch in the choosen layer (sethatchVarPer) (command "_.bhatch" "s" "l" "" "") (initget "Yes No") (setq ch (getkword "\nContinue with drawing [Yes/No] <Yes>: ") ) (if (or (eq ch "Yes") (eq ch nil)) t nil ) ) ;progn ) ;while ) ;eq Polyline ((eq typ "Rectangle") (while (progn (if (= (getvar "thumbsize") 1) (createLayerDef) ) (drawrectangle) (setvar "clayer" llocalGen) ;need to remade the current layer over Defpoints to make the hatch (if (= (getvar "thumbsize") 2) (setvar "clayer" Layerselectobject) ) ;because I want the hatch in the choosen layer (sethatchVarPer) (command "_.bhatch" "s" "l" "" "") (initget "Yes No") (setq ch (getkword "\nContinue with drawing [Yes/No] <Yes>: ") ) (if (or (eq ch "Yes") (eq ch nil)) t nil ) ) ;progn ) ;while ) ;eq Rectangle ) ;cond typ (princ "\nHatch *Parcer* finished.") ) ;eq ) ;cond ansHatch (princ) ) ;defun
HTH, M.R.
Hi Marko.
It is a very good solution, thanks. Because of your answer I started to learn about the "WHILE" statement.
I do not understand one thing:
If ENTER = nil (http://www.afralisp.net/autolisp/tutorials/program-looping.php), why this other routine does not stops when I hit ENTER?
(defun C:Rept ( )
(while
(setvar "hpassoc" 1)
(setvar "hpcolor" "8")
(setvar "hpdraworder" 1)
(setvar "hpname" "solid")
(command "rectang")
(while (> (getvar 'cmdactive) 0) (command pause))
(command "_.bhatch" "s" "l" "" "")
);while
(princ)
);defun
Like the command COPY, I would like to have something that will repeat until I hit ENTER. 🙂
Hi Alex
(defun C:Rept ( / pt1 Flag)
(setq Flag T) ;so, you are setting FLAG = TRUE
(while Flag ;and while WHILE = TRUE
(setvar "hpassoc" 1) ;set this
(setvar "hpcolor" "8") ;set this
(setvar "hpdraworder" 1) ;set this
(setvar "hpname" "solid") ;set this
(setq pt1 (getpoint)) ;get a point and set to PT1 for the fisrt point of the rectangle
(setq Flag pt1) ;set the point to FLAG so if the point is NIL because I hit ENTER, the routine stops?
(command "rectang" pt1)
(while (> (getvar 'cmdactive) 0) (command pause))
(command "_.bhatch" "s" "l" "" "")
);while
(princ) );defun
Am I getting this?
@alexKoshman wrote:
Try this: (defun C:Rept ( / pt1 Flag) (setq Flag T) (while Flag (setvar "hpassoc" 1) (setvar "hpcolor" "8") (setvar "hpdraworder" 1) (setvar "hpname" "solid") (setq pt1 (getpoint)) (setq Flag pt1) (command "rectang" pt1) (while (> (getvar 'cmdactive) 0) (command pause)) (command "_.bhatch" "s" "l" "" "") ) ; while (princ) ) ; ....
I would think, since nothing within the (while) loop is re-setting those hatch-related System Variables back to previous values, you may as well set them just once, and then go into the (while) loop, so that it doesn't set them again for every rectangle & hatch. Also, after hitting Enter when asked for a point, it will set Flag to nil, but the (while) loop won't be stopped until it gets around to the beginning again to check on the value of Flag. That means it will still try to draw a rectangle and return an error for the nil point. And I think you could do it without the Flag variable, something like this [untested]:
(defun C:Rept (/ pt1)
(setvar "hpassoc" 1)
(setvar "hpcolor" "8")
(setvar "hpdraworder" 1)
(setvar "hpname" "solid")
(while (setq pt1 (getpoint "\nPrompt similar to RECTANG's initial prompt: ")); returns nil on Enter to end (while)
(command "rectang" pt1)
(while (> (getvar 'cmdactive) 0) (command pause))
(command "_.bhatch" "s" "l" "" "")
); while
(princ)
); defun