AutoCAD AutoLISP - help combining 2 LISP routines

[BigBoyCAD]

Hi LISPers.

I have 2 codes that I wish to combine.

Code 1: draws a revcloud

Code 2: Automatically starts a pick points hatching command with the hatch criteria all dialed in.

Can I please get a hand simply combining these two lisp codes.
Still new to lisp and having trouble stitching them in together.

Also, in code 1, if there is a way to remove the prompt for 'Reverse direction: Yes/No' that comes up when the revcloud is drawn unclosed that would be great. 

Would prefer to say 'No' to reversing.

P.s. shout out to @komondormrex for previous help with code 2. 👍

Code 1 (to run first):

(defun c:RCLD3 ( / )
(prompt "\nDraw a revision cloud (Normal style, Freehand, arc length = 200)...")
(command "_.revcloud"
"style" "normal" ;; force Normal style
"arc" "200" "200" ;; min = 200, max = 200
"f" ;; Freehand mode
pause ;; let user draw the cloud
)
(princ)
)

Code 2:

(defun c:ERH-KOMO-MULTIPICK ( / oldce oldlay oldhpname oldhpscale oldhpang oldhplayer lay)

;; Save environment & hatch defaults

(setq oldce (getvar "CMDECHO"))

(setq oldlay (getvar "CLAYER"))

(setq oldhpname (getvar "HPNAME"))

(setq oldhpscale (getvar "HPSCALE"))

(setq oldhpang (getvar "HPANG"))

(setq oldhplayer (getvar "HPLAYER"))

(setvar "CMDECHO" 0) ; quiet mode

(setq lay "Earth Hatch 2")

;; Ensure layer exists and is colour 11

(if (tblsearch "LAYER" lay)

(vl-cmdf "_.-LAYER" "C" "11" lay "")

(vl-cmdf "_.-LAYER" "N" lay "C" "11" lay "")

)

;; Temporarily make Earth Hatch 2 current

(setvar "CLAYER" lay)

;; Start hatch with full property setup

(vl-cmdf

"_-HATCH"

"_Properties" "EARTH" "35" "45"

"_Layer" lay

"_Color" "11" ;; <- force hatch colour to 11, independent of HPCOLOR

;;;"_PickPoints" ; komondormrex

"" ; komondormrex

"_k" ; komondormrex

)

(command "_si" ename "") ; komondormrex

;;; Allow multiple picks until user presses Enter

(while (= 1 (getvar "CMDACTIVE"))

(command pause)

)

;; Restore hatch defaults

(if oldhpname (setvar "HPNAME" oldhpname))

(if oldhpscale (setvar "HPSCALE" oldhpscale))

(if oldhpang (setvar "HPANG" oldhpang))

(if oldhplayer (setvar "HPLAYER" oldhplayer))

;; Restore previous layer and CMDECHO

(setvar "CLAYER" oldlay)

(setvar "CMDECHO" oldce)

(princ)

)

[Kent1Cooper]

My guess is that one pause isn't enough to take User input for the REVCLOUD command.  But I think [untested] you can do this to have it keep taking input until the command is finished:

(command-s "_.revcloud"
  "style" "normal" ;; force Normal style
  "arc" "200" "200" ;; min = 200, max = 200
  "f" ;; Freehand mode
)

No explicit pause built in -- however many are needed should be allowed by its being in a (command-s) function.

[paullimapa · Accepted solution]

try this:

; rc3-erh combines RCLD3 & ERH-KOMO-MULTIPICK
; OP:
; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/autocad-autolisp-help-combining-2-lisp-routines/td-p/13822968
(defun c:rc3-erh (/ oldce oldlay oldhpname oldhpscale oldhpang oldhplayer lay)
;; begin RCLD3 draws revision cloud
(prompt "\nDraw a revision cloud (Normal style, Freehand, arc length = 200)...")
(initcommandversion 2) ; need to run this first before revcloud runs like from the command prompt with all parameters
(command "_.revcloud"
"_style" "normal" ;; force Normal style
"_arc" "200" "200" ;; min = 200, max = 200
"_f" ;; Freehand mode not an option when executed via lisp
)
; let user draw the cloud
(while (= 1 (getvar "CMDACTIVE"))
(command pause)
)
;; begin ERH-KOMO-MULTIPICK Automatically starts a pick points hatching command with the hatch criteria all dialed in
;; Save environment & hatch defaults
(setq oldce (getvar "CMDECHO"))
(setq oldlay (getvar "CLAYER"))
(setq oldhpname (getvar "HPNAME"))
(setq oldhpscale (getvar "HPSCALE"))
(setq oldhpang (getvar "HPANG"))
(setq oldhplayer (getvar "HPLAYER"))
(setvar "CMDECHO" 0) ; quiet mode
(setq lay "Earth Hatch 2")
;; Ensure layer exists and is colour 11
(if (tblsearch "LAYER" lay)
(vl-cmdf "_.-LAYER" "C" "11" lay "")
(vl-cmdf "_.-LAYER" "N" lay "C" "11" lay "")
)
;; Temporarily make Earth Hatch 2 current
(setvar "CLAYER" lay)
(princ"\nPick Points for Hatching...") 
;; Start hatch with full property setup
(vl-cmdf
"_-HATCH"
"_Properties" "EARTH" "35" "45"
"_Layer" lay
"_Color" "11" ;; <- force hatch colour to 11, independent of HPCOLOR
"" ; none
;;;"_PickPoints" ; komondormrex
;"" ; komondormrex
; "_k" ; komondormrex
)
;(command "_si" ename "") ; komondormrex
 
;;; Allow multiple picks until user presses Enter
(while (= 1 (getvar "CMDACTIVE"))
(command pause)
)
;; Restore hatch defaults
(if oldhpname (setvar "HPNAME" oldhpname))
(if oldhpscale (setvar "HPSCALE" oldhpscale))
(if oldhpang (setvar "HPANG" oldhpang))
(if oldhplayer (setvar "HPLAYER" oldhplayer))
 
;; Restore previous layer and CMDECHO
(setvar "CLAYER" oldlay)
(setvar "CMDECHO" oldce)
(princ)

)

[BigBoyCAD]

No dice unfortunately. Thanks though. 👍

[BigBoyCAD]

Works great! 

Thank you very much @paullimapa 

[paullimapa]

You are welcome…cheers!!!

[Moshe-A]

@BigBoyCAD  hi,

Check the following code and it contains some sophisticated functions but don't worry i will explain everything that's why i added lines numbers.

So lets begin... 😀

line #02 - there is no need to save the current value of cmdecho, cause we assume it is 1 at start (it always should be) we zero it and at end we set it back to 1. if it was zero at start, it will be 1 when our program is finish (for normal operation of AutoLISP).

line #03 we start undo group\begin and at end we finish with (line #48) undo end. this guarantees an undo with 1 Undo.

line #07 we define a constant variable of type list to hold all the system vars we want to set, why doing that? cause we have more then one\two variables we want to set and holding them is a list (hey 😀, we are talking here on LISP language where lists is in focus) loop is the right way to do it.

line #08 is obvious, we define a const variable for the working layer cause this layer is used in code at least 6 times so if in future you want to change the layer name (or made syntax error) you can easily change\correct it in one place and program continue to work.

lines #11-18 here's comes the sophisticated part. we use mapcar function (in lisp it is known as anonymous function i'll explain that later if you want) mapcar combined with lambda function is actually a loop that can pass a list (even lists...you will see that soon...) argument to lambda for process and it done that item by item (each string it turn)  so we have SYSVARSNAME which is a list of strings, mapcar pass that to lambda (right into sysName) there we use getvar to retrieve the current value.

and the important thing is the return value from mapcar which is a list of all the retrieved values of all the sysvars.

line #24 we run REVCLOUD command. as you can see i use (command-s) function [not  (command) ] this is because (command-s) invoke AutoCAD standard command and continue to run it until it is finish only than the code continue to the next line.

saves you to use  the following in your code (although it is ok to do that)

;;; Allow multiple picks until user presses Enter
(while (= 1 (getvar "CMDACTIVE"))
(command pause)
)

line #23 a call to (initcommandversion 2) make sure the current version of the standard command will be invoked next.

line #27-30 make sure working layer is exist

line #32 do the hatch

lines #37-45 another sophisticated stuff 😀 we want to restore sysvars back so we use (vl-every) function (pure AutoLISP) very similar to mapcar function, it create a loop this time it passes 2 arguments to lambda function. first argument is SYSVARSNAME and the second is savedSysVars (the return value from the first mapcar). each step (vl-every) pass items from SYSVARSNAME and savedSysVars to lambda to (setvar) to restore AutoCAD sysvar back - isn't this nice?

and what's the different between (vl-every) and (mapcar)? the return value of course. (vl-every) return T if all steps (in lambda process) is NOT nil (otherwise it return nil)

enjoy

Moshe

;| 01 |; (defun c:rcld3 (/ SYSVARSNAME savedSysVars HATCHLAYER)
;| 02 |;  (setvar "cmdecho" 0)       	; disable command prompts
;| 03 |;  (command "._undo" "_Group")	; start undo group
;| 04 |; 
;| 05 |;  ;;; program starts, do initial settings
;| 06 |;   
;| 07 |;  (setq SYSVARSNAME '("hpname" "hpscale" "hpang" "hplayer" "clayer")) ; const
;| 08 |;  (setq HATCHLAYER "Earth Hatch 2"); const
;| 09 |; 
;| 10 |;  ; save sysvar value - user loop
;| 11 |;  (setq savedSysVars
;| 12 |; 	(mapcar
;| 13 |;    	  '(lambda (sysName)
;| 14 |;             (getvar sysName)
;| 15 |;            ); lambda
;| 16 |; 	 SYSVARSNAME
;| 17 |;         ); mapcar
;| 18 |;  ); setq
;| 19 |; 
;| 20 |; 
;| 21 |;  ;;; program body
;| 22 |;   
;| 23 |;  (initcommandversion 2)
;| 24 |;  (command-s "._revcloud" "Freehand" "_Style" "normal" "_Arc" 200 200)
;| 25 |; 
;| 26 |;  ; create hatch working layer + set it current + set color
;| 27 |;  (if (tblsearch "layer" HATCHLAYER)
;| 28 |;   (command "._layer" "_Set" HATCHLAYER "_Color" 11 HATCHLAYER "")
;| 29 |;   (command "._layer" "_Make" HATCHLAYER "_Color" 11 HATCHLAYER "")
;| 30 |;  )
;| 31 |; 
;| 32 |;  (command "._bhatch" "_Properties" "EARTH" 35 45 "_Layer" HATCHLAYER pause "")
;| 33 |; 
;| 34 |;   
;| 35 |;  ;;; program,  prepare to end
;| 36 |; 
;| 37 |;  (vl-every
;| 38 |;    '(lambda (sysName val)
;| 39 |;      (setvar sysName val)
;| 40 |;     ); lambda
;| 44 |;   SYSVARSNAME savedSysVars
;| 45 |;  ); vl-every
;| 46 |; 
;| 47 |;  (command "._undo" "_end") ; close undo group
;| 48 |;  (setvar "cmdecho" 1)	    ; restore command prompts
;| 49 |;   
;| 50 |;  (princ) ; quiet exit
;| 51 |; ); c:rcld3