Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Stuck in a routine 2

9 REPLIES 9
SOLVED
Reply
Message 1 of 10
msarqui
690 Views, 9 Replies

Stuck in a routine 2

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!

9 REPLIES 9
Message 2 of 10
msarqui
in reply to: msarqui

Did I put the file attached?

The new look of the site is a mess...Smiley Very Happy

 

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

 

Message 3 of 10
marko_ribar
in reply to: msarqui

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.

Marko Ribar, d.i.a. (graduated engineer of architecture)
Message 4 of 10
msarqui
in reply to: marko_ribar

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. 🙂

 

Message 5 of 10
alexKoshman
in reply to: msarqui

It's because the "(while (setvar ... ...)" is ALWAYS TRUE!
Message 6 of 10
alexKoshman
in reply to: alexKoshman

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) ) ; defun Sorry for formatting... it doesn't work here... : (
Message 7 of 10
msarqui
in reply to: alexKoshman

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?

Message 8 of 10
alexKoshman
in reply to: msarqui

You're absolutely right! ; )
Message 9 of 10
Kent1Cooper
in reply to: alexKoshman


@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

Kent Cooper, AIA
Message 10 of 10
alexKoshman
in reply to: Kent1Cooper

Yes, Kent! That's much more logical shorter and a bit shorter! ; )

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost