Dynamic Input & Insertion a Block into a lisp action

[sam_safinia]

Most of these routine lisp credit goes to BeeKeeCZ for very useful helps. 

Here is my new challenge: I want to insert my blocks into a drawing by using dynamic input. The abc.lsp makes dynamic input entries and the challenge starts here. 

1) How can I direct this selection to read from abcFn.lsp and insert appropriate block (by selecting "A" ==> insert block "a" or run "Ma" function, etc.)

2) How can keep dynamic input running until I press Esc. It means after inserting block "a" it doesn't stop and show me dynamic input selection again and it continues until I terminate it.

Here is lisps and blocks.

Thanks

[ВeekeeCZ]

Hi, try this one. This assumes that your function are loaded.

Spoiler

(vl-load-com)
(defun c:DDS ( / key input)
  (setq key "mA mB mC") ; This calls functions c:MA, c:MB, c:MB
  (while (progn
	   (initget key)
	   (setq input (cond ((getkword (strcat "\nSelect segment [" (vl-string-translate " " "/" key) "] <A>: ")))
			     ("mA"))))
    (apply (read (strcat "c:" input)) nil))
  (princ)
)

Or with last option remained under enter...

Spoiler

(vl-load-com)
(defun c:DDS ( / key input)
  (setq input "A"
	key "A B C") ; This calls functions c:MA, c:MB, c:MB
  (while (progn
	   (initget key)
	   (setq input (cond ((getkword (strcat "\nSelect segment [" (vl-string-translate " " "/" key) "] <" input ">: ")))
			     (input))))
    (apply (read (strcat "c:m" input)) nil))
  (princ)
)

[sam_safinia]

Thanks BeeKeeCZ. Probably my bad explanation.

What I meant was for example if I select "A" to insert my first block, it goes through whole my dynamic block insertion prompts to the end but it starts over again. How can I stop looping it and force it to back to first selection tree after the last prompt (Orientation for selection "A").

This is last prompt:

I want to back to this again:

Cheers.

[ВeekeeCZ]

Hi s_plant, I did understood a I think the problem is somewhere else.

First, try this DDS routine with test funcions of c:MA, c:MB and c:MC - this works good for me.

Spoiler

(vl-load-com)
(defun c:DDS ( / key input)
  (setq input "A"
	key "A B C") ; This calls functions c:MA, c:MB, c:MB
  (while (progn
	   (initget key)
	   (setq input (cond ((getkword (strcat "\nSelect segment [" (vl-string-translate " " "/" key) "] <" input ">: ")))
			     (input))))
    (apply (read (strcat "c:m" input)) nil))
  (princ)
)


(defun c:ma nil (princ "\nHello s_plant, I'm 'c:MA' and I'm working pretty well!") (princ))
(defun c:mb nil (princ "\nHello s_plant, I'm 'c:MB' and I'm working pretty well!") (princ))
(defun c:mc nil (princ "\nHello s_plant, I'm 'c:MC' and I'm working pretty well!") (princ))

Then... the problem is inside of DRXA function (and the same in DRXB and C), that you are using att, oCLAYER, oATTREQ and oATTDIA variables (localized), but you set no value in these! Then, when you use these variable it goes into error and does not come back into DDS for next prompt. I tried to fix it. 

And, since your M_a block has no attributes you can't have "aA" as a parameter!

Spoiler

(defun C:Ma  ()   (DRXA  "M_a" "Layer for A"      1         "Continuous"        0.5       "M1"      6    nil nil  nil) (princ)) ; "aA"
(defun DRXA ( Block  Layer  Color  LType  LWeight  HLayer HColor   Att1 Att2 Att3 / oCLAYER oATTREQ oATTDIA *error* att)
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
      (princ (strcat "\nError: " errmsg)))
    (setvar 'CLAYER oCLAYER)
    (setvar 'ATTREQ oATTREQ)
    (setvar 'ATTDIA oATTDIA)
    (princ))
  (setq oCLAYER (getvar 'CLAYER)
	oATTREQ (getvar 'ATTREQ)
	oATTDIA (getvar 'ATTDIA)
	att 1)
  
  (command "_.-LAYER" "_M"   Layer        "_C"      Color         Layer            "_L"      LType          Layer    "_LW"   LWeight   Layer   "")
  (command "_.-LAYER" "_C" HColor HLayer "")
;;===================================================================================================;;
;;                                        CHANGE DIRECTORY, PLEASE!                                  ;;
		  (command "_.-INSERT" (strcat Block ".dwg") "_s" 1.0 pause pause)
;;===================================================================================================;;	
  (while (> (getvar 'CMDACTIVE) 0)
    (command (cond ((eval (read (strcat "Att" (itoa att)))))
		   (T ""))) 
    (setq att (1+ att)))
  (command "_.SETBYLAYER" "_Last" "" "_N" "_Y")
  (setvar 'CLAYER oCLAYER)
  (setvar 'ATTREQ oATTREQ)
  (setvar 'ATTDIA oATTDIA)
)

[sam_safinia]

I test them right now. Sorry but your first routine doesn't;t work and I got this error:

Can't reenter LISP.
LISP command is not available.

and main function is not working for me after your changes 😞

I'm not sure what i missed

[sam_safinia]

First routine working fine, no hassle but second one still is going through a loop on my first selection and after 3 time of asking DB parameters it stops working!

[ВeekeeCZ]

---

@s_plant wrote:

First routine working fine, no hassle but second one still is going through a loop on my first selection and after 3 time of asking DB parameters it stops working!

---

Hi, glad that at least something works.

Underneath, you can find simplified code for c:DDS, c:MA.,c:MB and c:MC. That should work as it is without causing an error (at least works for me).

BUT, as you can see, there is no reactor in it. And that's the problem I cannot solve - because if I load the reactor, then I run MA, it goes fine just ones. If I run MA second time, then it shows "Unknown command "MA". With normal command such as "-insert", run from Autocad directly, the reactor works fine. But if "-insert" command is run from lisp, it is not terminated correctly. The reactor has to be modified somehow - and I am not a good guy for it.

So... you you need to aks the author of the reactor, or maybe someone else here could help with this one (make a new thread up on this topic).

Spoiler

(vl-load-com)

; -------------------------------------------------------------------------------------------------------------------------

(defun c:DDS ( / key input)
  (setq input "A"
	key "A B C") ; This calls functions c:MA, c:MB, c:MB
  (while (progn
	   (initget key)
	   (setq input (cond ((getkword (strcat "\nSelect segment [" (vl-string-translate " " "/" key) "] <" input ">: ")))
			     (input))))
    (apply (read (strcat "c:m" input)) nil))
  (princ)
)

;-----
(defun C:MA  ()
  (DRX  ""		; Block FilePath
	"M_a"		; Block Name
	"Layer for A"	; Layer Name
	1		; Layer Color
	"Continuous"	; Layer LineType
	0.5		; Layer LinetypeWeight
	)
  (princ)
)

;-----
(defun C:MB  ()
  (DRX  ""		; Block FilePath
	"M_b"		; Block Name
	"Layer for B"	; Layer Name
	3		; Layer Color
	"Continuous"	; Layer LineType
	0.15		; Layer LinetypeWeight
	)
  (princ)
)

;-----
(defun C:MC  ()
  (DRX  ""		; Block FilePath
	"M_a"		; Block Name
	"Layer for C"	; Layer Name
	2		; Layer Color
	"Continuous"	; Layer LineType
	0.5		; Layer LinetypeWeight
	)
  (princ)
)



; -------------------------------------------------------------------------------------------------------------------------
; -------------------------------------------------------------------------------------------------------------------------

(defun DRX (Path Block Layer LColor LType LWeight / oCLAYER *error*)

  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
      (princ (strcat "\nError: " errmsg)))
    (setvar 'CLAYER oCLAYER)
    (princ))

  ; -----
  (setq oCLAYER (getvar 'CLAYER))
  (if (tblsearch "LAYER" Layer)
    (setvar 'CLAYER Layer)
    (command "_.-LAYER" "_M" Layer "_C" Lcolor Layer "_L" LType Layer "_LW" LWeight Layer ""))
  (command "_.-INSERT" (strcat Path Block ".dwg") "_s" 1 "_r" 0 PAUSE)
  (setvar 'CLAYER oCLAYER)
)


; -------------------------------------------------------------------------------------------------------------------------
; -------------------------------------------------------------------------------------------------------------------------

[sam_safinia]

Thanks BeeKeeCZ for great help.

[ВeekeeCZ · Accepted solution]

Ok, not sure about this one. Do you need the reactor for some other stuff? Is your reactor loaded all the time? I recommend don't - then you can use following modification, which works as you want. I modified this reactor routine to lose its reactivity... but if you run the original reactor from some other place then it would be in conflict with each other.

In case you use the original reactor for other stuff you can
- erase "-insert" command from list of command to react on (still reacts on (no dash) insert command
- use it as regular routine and run it manually just after insert command (it takes last inserted block).

Spoiler

(vl-load-com)
; -------------------------------------------------------------------------------------------------------------------------

(defun c:DDS ( / key input)
  (setq input "A"
	key "A B C") ; This calls functions c:MA, c:MB, c:MB
  (while (progn
	   (initget key)
	   (setq input (cond ((getkword (strcat "\nSelect segment [" (vl-string-translate " " "/" key) "] <" input ">: ")))
			     (input))))
    (apply (read (strcat "c:m" input)) nil))
  (princ)
)

;-----
(defun C:MA  ()
  (DRX  ""		; Block FilePath
	"M_a"		; Block Name
	"Layer for A"	; Layer Name
	1		; Layer Color
	"Continuous"	; Layer LineType
	0.5		; Layer LinetypeWeight
	)
  (princ)
)

;-----
(defun C:MB  ()
  (DRX  ""		; Block FilePath
	"M_b"		; Block Name
	"Layer for B"	; Layer Name
	3		; Layer Color
	"Continuous"	; Layer LineType
	0.15		; Layer LinetypeWeight
	)
  (princ)
)

;-----
(defun C:MC  ()
  (DRX  ""		; Block FilePath
	"M_a"		; Block Name
	"Layer for C"	; Layer Name
	2		; Layer Color
	"Continuous"	; Layer LineType
	0.5		; Layer LinetypeWeight
	)
  (princ)
)



; -------------------------------------------------------------------------------------------------------------------------
; -------------------------------------------------------------------------------------------------------------------------

(defun DRX (Path Block Layer LColor LType LWeight / oCLAYER *error*)

  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
      (princ (strcat "\nError: " errmsg)))
    (setvar 'CLAYER oCLAYER)
    (princ))

  ; -----
  (setq oCLAYER (getvar 'CLAYER))
  (if (tblsearch "LAYER" Layer)
    (setvar 'CLAYER Layer)
    (command "_.-LAYER" "_M" Layer "_C" Lcolor Layer "_L" LType Layer "_LW" LWeight Layer ""))
  (command "_.-INSERT" (strcat Path Block ".dwg") "_s" 1 "_r" 0 PAUSE)
  (gp:binsertatte)
  (setvar 'CLAYER oCLAYER)
)


; -------------------------------------------------------------------------------------------------------------------------
; -------------------------------------------------------------------------------------------------------------------------

(defun gp:binsertatte ( / ss->objlist ss obj objattr nwstr objdyn newvalue prmpts cnt dyn dynp attr)

  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
      (princ (strcat "\nError: " errmsg)))
    (setvar "dynmode" dyn)
    (setvar "dynprompt" dynp)
    (setvar "attreq" attr))
  
  (defun ss->objlist (ss / cnt objlist)
    (setq cnt (sslength ss))
    (repeat cnt
      (setq objlist (append objlist (list (vlax-ename->vla-object (ssname ss (- cnt 1))))))
      (setq cnt (- cnt 1)))
    (setq ss nil)
    objlist)
  
  ;----
  
  (setq dyn (getvar "dynmode")
	dynp (getvar "dynprompt")
	attr (getvar "attreq"))
  
  (setvar "attreq" 0)
  (setvar "dynprompt" 1)
  (setvar "dynmode" 1)
  (setq ss (ssget "L"))
  (setq obj (ss->objlist ss))
  (foreach o obj
    (if (= (cdr (assoc 0 (entget (vlax-vla-object->ename o)))) "INSERT")
      (progn
	(if (= (vla-get-HasAttributes o) :vlax-true)
	  (progn
	    (setq objattr (vlax-safearray->list (vlax-variant-value (vla-GetAttributes o))))
	    (foreach oa objattr
	      (setq oatr oa)
	      (if (= (vla-get-Constant oa) :vlax-false)
		(progn
		  (setq nwstr (getstring (strcat "\nSpecify " (vla-get-TagString oa) ": <" (vla-get-TextString oa) ">: ")))
		  (if (/= nwstr "") (vla-put-TextString oa nwstr))
		  (setq nwstr nil)
		  )
		)
	      )
	    )
	  )
	(if (= (vla-get-IsDynamicBlock o) :vlax-true)
	  (progn
	    (setq objdyn (vlax-safearray->list (vlax-variant-value (vla-GetDynamicBlockProperties o))))
	    (foreach od objdyn
	      (if (and (= (vla-get-Show od) :vlax-true) (= (vla-get-ReadOnly od) :vlax-false) (/= (vla-get-PropertyName od) "Origin"))
		(progn
		  (if (= (vlax-safearray-get-u-bound (vlax-variant-value (vla-get-AllowedValues od)) 1) -1)
		    (progn
		      (if (= (vla-get-Description od) "")
			(setq prmpts (strcat "\nEnter value for " (vla-get-PropertyName od) ":"))
			(setq prmpts (strcat "\nEnter value for " (vla-get-Description od) ":"))
			)
		      (cond
			((= (vla-get-UnitsType od) acAngular) (setq newvalue (getorient prmpts)))
			((= (vla-get-UnitsType od) acDistance) (setq newvalue (getdist prmpts)))
			((= (vla-get-UnitsType od) acArea) (setq newvalue (getreal prmpts)))
			)
		      (if (/= newvalue nil) (vla-put-Value od (vlax-make-variant newvalue)))
		      )
		    (progn
		      (setq prmpts "[")
		      (setq cnt 1)
		      (foreach pt (vlax-safearray->list (vlax-variant-value (vla-get-AllowedValues od)))
			(if (= (vla-get-UnitsType od) acNoUnits)
			  (if (numberp (vlax-variant-value pt))
			    (if (= (vlax-variant-value pt) 0)
			      (setq prmpts (strcat prmpts (itoa cnt) ").NotFlipped "))
			      (setq prmpts (strcat prmpts (itoa cnt) ").Flipped "))
			      )
			    (setq prmpts (strcat prmpts (itoa cnt) ")." (vl-string-translate "/" "|" (vl-string-translate " " "-" (vlax-variant-value pt))) " "))
			    )
			  (setq prmpts (strcat prmpts (itoa cnt) ")." (vl-string-translate "/" "|" (vl-string-translate " " "-" (rtos (vlax-variant-value pt)))) " "))
			  )
			(setq cnt (+ cnt 1))
			)
		      (setq prmpts (strcat (vl-string-right-trim " " prmpts) "]"))
		      (initget 0 (vl-string-trim "[]" prmpts))
		      (if (= (vla-get-Description od) "")
			(setq newvalue (getkword (strcat "\nEnter value for " (vla-get-PropertyName od) ":" (vl-string-translate " " "/" prmpts))))
			(setq newvalue (getkword (strcat "\nEnter value for " (vla-get-Description od) ":" (vl-string-translate " " "/" prmpts))))
			)
		      (if (/= newvalue nil)
			(progn
			  (setq newvalue (nth (- (atoi (substr newvalue 1 (vl-string-position 41 newvalue))) 1) (vlax-safearray->list (vlax-variant-value (vla-get-AllowedValues od)))))
			  (vla-put-Value od newvalue)
			  )
			)
		      )
		    )
		  )
		)
	      )
	    )
	  )
	)
      )
    )
  (setvar "dynmode" dyn)
  (setvar "dynprompt" dynp)
  (setvar "attreq" attr) 
  (princ)
)

[sam_safinia]

How intelligent you are BeeKeeCZ!!!

That's a great job and a big task for me to dig and understand it line by line.

Well done mate 🙂

[sam_safinia]

I appreciate any idea of how to put UNDO for the reactor. Where do I need to put start and End of my Undo?

For instance when adding pipe length for the first block M_a and then want to Undo input length to change with different length

Thanks

[ВeekeeCZ]

---

@s_plant wrote:

I appreciate any idea of how to put UNDO for the reactor. Where do I need to put start and End of my Undo?

For instance when adding pipe length for the first block M_a and then want to Undo input length to change with different length

Thanks

---

This is not that simple. You can't call undo command in the middle of another command. You need to adjust your routine (which - since my last adjustment - is not the reactor anymore).

So try this version... anywhere you can type "U" for "Undo" for go 1 step back. If you do this inside your main function then you'll erase last segment drawn.
btw The main function can be terminated by typing "+" as well.

Spoiler

(vl-load-com)

; -------------------------------------------------------------------------------------------------------------------------

(defun c:DDS ( / key input adoc)
  
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (setq input "A"
	key "A B C" ; This calls functions c:MA, c:MB, c:MB
	enlast (entlast)
	)
  (while (progn
	   (initget (strcat key " Undo +"))
	   (setq input (cond ((getkword (strcat "\nSelect segment [" (vl-string-translate " " "/" key) "] <" input ">: ")))
			     (input)))
	   (/= input "+")
	   )
    (if (/= input "Undo")
      (apply (read (strcat "c:m" input)) nil)
      (if (/= enlast (entlast)) (entdel (entlast)))))
  (princ)
  
  ;-----
  (defun C:MA  ()
    (DRX  ""		; Block FilePath
	  "M_a"		; Block Name
	  "Layer for A"	; Layer Name
	  1		; Layer Color
	  "Continuous"	; Layer LineType
	  0.5		; Layer LinetypeWeight
	  )
    (princ)
    )
  
  ;-----
  (defun C:MB  ()
    (DRX  ""		; Block FilePath
	  "M_b"		; Block Name
	  "Layer for B"	; Layer Name
	  3		; Layer Color
	  "Continuous"	; Layer LineType
	  0.15		; Layer LinetypeWeight
	  )
    (princ)
    )
  
  ;-----
  (defun C:MC  ()
    (DRX  ""		; Block FilePath
	  "M_c"		; Block Name
	  "Layer for C"	; Layer Name
	  2		; Layer Color
	  "Continuous"	; Layer LineType
	  0.5		; Layer LinetypeWeight
	  )
    (princ)
    )
  
  
  ; -------------------------------------------------------------------------------------------------------------------------
  
  (defun DRX (Path Block Layer LColor LType LWeight / oCLAYER *error*)
    
    (defun *error* (errmsg)
      (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
	(princ (strcat "\nError: " errmsg)))
      (setvar 'CLAYER oCLAYER)
      (vla-endundomark adoc))
    
    ; -----
    (setq oCLAYER (getvar 'CLAYER))
    (if (tblsearch "LAYER" Layer)
      (setvar 'CLAYER Layer)
      (command "_.-LAYER" "_M" Layer "_C" Lcolor Layer "_L" LType Layer "_LW" LWeight Layer ""))
    (command "_.-INSERT" (strcat Path Block ".dwg") "_s" 1 "_r" 0 PAUSE)
    (setvar 'CLAYER oCLAYER)
    (gp:binsertatte)
    )
 
  
  ; -------------------------------------------------------------------------------------------------------------------------
  
  (defun gp:binsertatte ( / *error* ss->objlist nVAR oVAR ss obj objattr nwstr objdyn newvalue prmpts cnt dyn dynp attr i ii)
    
    (defun *error* (errmsg)
      (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
	(princ (strcat "\nError: " errmsg)))
      (mapcar 'setvar nVAR oVAR)
      (vla-endundomark adoc))
    
    (defun ss->objlist (ss / cnt objlist)
      (setq cnt (sslength ss))
      (repeat cnt
	(setq objlist (append objlist (list (vlax-ename->vla-object (ssname ss (- cnt 1))))))
	(setq cnt (- cnt 1)))
      (setq ss nil)
      objlist)
    
    ;----
    
    (setq oVAR (mapcar 'getvar (setq nVAR '(DYNMODE DYNPROMPT ATTREQ))))
    (mapcar 'setvar nVAR 		        '(1	  1	    0))
    
    (setq ss (ssget "L"))
    (setq obj (ss->objlist ss))
    (foreach o obj
      (if (= (cdr (assoc 0 (entget (vlax-vla-object->ename o)))) "INSERT")
	(progn
	  (if (= (vla-get-HasAttributes o) :vlax-true)
	    (progn
	      (setq objattr (vlax-safearray->list (vlax-variant-value (vla-GetAttributes o))))
	      (foreach oa objattr
		(setq oatr oa)
		(if (= (vla-get-Constant oa) :vlax-false)
		  (progn
		    (setq nwstr (getstring (strcat "\nSpecify " (vla-get-TagString oa) ": <" (vla-get-TextString oa) ">: ")))
		    (if (/= nwstr "") (vla-put-TextString oa nwstr))
		    (setq nwstr nil)
		    )
		  )
		)
	      )
	    )
	  (if (= (vla-get-IsDynamicBlock o) :vlax-true)
	    (progn
	      (setq objdyn (vlax-safearray->list (vlax-variant-value (vla-GetDynamicBlockProperties o)))
		    i -1)
	      ;(foreach od objdyn
	      (while (< (setq i (1+ i)) (length objdyn))
		(if (and (setq od (nth i objdyn))
			 (= (vla-get-Show od) :vlax-true)
			 (= (vla-get-ReadOnly od) :vlax-false)
			 (/= (vla-get-PropertyName od) "Origin")
			 )
		  (progn
		    (if (= (vlax-safearray-get-u-bound (vlax-variant-value (vla-get-AllowedValues od)) 1) -1)
		      (progn
			(if (= (vla-get-Description od) "")
			  (setq prmpts (strcat "\nEnter value for " (vla-get-PropertyName od) ":"))
			  (setq prmpts (strcat "\nEnter value for " (vla-get-Description od) ":"))
			  )
			(initget "Undo")
			(cond
			  ((= (vla-get-UnitsType od) acAngular) (setq newvalue (getorient prmpts)))
			  ((= (vla-get-UnitsType od) acDistance) (setq newvalue (getdist prmpts)))
			  ((= (vla-get-UnitsType od) acArea) (setq newvalue (getreal prmpts)))
			  )
			(if (and newvalue
				 (/= newvalue "Undo"))
			  (vla-put-Value od (vlax-make-variant newvalue)))
			)
		      (progn
			(setq prmpts "[")
			(setq cnt 1)
			(foreach pt (vlax-safearray->list (vlax-variant-value (vla-get-AllowedValues od)))
			  (if (= (vla-get-UnitsType od) acNoUnits)
			    (if (numberp (vlax-variant-value pt))
			      (if (= (vlax-variant-value pt) 0)
				(setq prmpts (strcat prmpts (itoa cnt) ").NotFlipped "))
				(setq prmpts (strcat prmpts (itoa cnt) ").Flipped "))
				)
			      (setq prmpts (strcat prmpts (itoa cnt) ")." (vl-string-translate "/" "|" (vl-string-translate " " "-" (vlax-variant-value pt))) " "))
			      )
			    (setq prmpts (strcat prmpts (itoa cnt) ")." (vl-string-translate "/" "|" (vl-string-translate " " "-" (rtos (vlax-variant-value pt)))) " "))
			    )
			  (setq cnt (+ cnt 1))
			  )
			(setq prmpts (strcat (vl-string-right-trim " " prmpts) "]"))
			(initget 0 (strcat (vl-string-trim "[]" prmpts) " Undo"))
			(if (= (vla-get-Description od) "")
			  (setq newvalue (getkword (strcat "\nEnter value for " (vla-get-PropertyName od) ":" (vl-string-translate " " "/" prmpts))))
			  (setq newvalue (getkword (strcat "\nEnter value for " (vla-get-Description od) ":" (vl-string-translate " " "/" prmpts))))
			  )
			(if (and newvalue
				 (/= newvalue "Undo"))
			  (progn
			    (setq newvalue (nth (- (atoi (substr newvalue 1 (vl-string-position 41 newvalue))) 1) (vlax-safearray->list (vlax-variant-value (vla-get-AllowedValues od)))))
			    (vla-put-Value od newvalue)
			    )
			  )
			)
		      )
		    (if (= newvalue "Undo")
		      (if ii
			(setq i (1- (car ii))
			      ii (cdr ii))
			(setq i -1))
		      (setq ii (cons i ii)))
		    )
		  )
		)
	      )
	    )
	  )
	)
      )
    )
  (mapcar 'setvar nVAR oVAR)
  (vla-endundomark adoc)
  (princ)
)

[sam_safinia]

Thanks BeeKeeCZ.

As you said it is not that much simple. It works fine with Undo last inserted segment but not within each insertion process by typing "U". I simply added "Undo" option into dynamic input selection to do the last inserted deletion but cannot run Undo for any of my input data because for example after asking Length of pipe, lisp is looking for numeric input not alphabetic(U)

(vl-load-com)

; -------------------------------------------------------------------------------------------------------------------------

(defun c:DDS ( / key input adoc)
  
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (setq input "A"
	key "A B C Undo" ; This calls functions c:MA, c:MB, c:MB
	enlast (entlast)
	)
  (while (progn
	   (initget (strcat key " Undo +"))
	   (setq input (cond ((getkword (strcat "\nSelect segment [" (vl-string-translate " " "/" key) "] <" input ">: ")))
			     (input)))
	   (/= input "+")
	   )
    (if (/= input "Undo")
      (apply (read (strcat "c:m" input)) nil)
      (if (/= enlast (entlast)) (entdel (entlast)))))
  (princ)
  
  ;-----
  (defun C:MA  ()
    (DRX  ""		; Block FilePath
	  "M_a"		; Block Name
	  "Layer for A"	; Layer Name
	  1		; Layer Color
	  "Continuous"	; Layer LineType
	  0.5		; Layer LinetypeWeight
	  )
    (princ)
    )
  
  ;-----
  (defun C:MB  ()
    (DRX  ""		; Block FilePath
	  "M_b"		; Block Name
	  "Layer for B"	; Layer Name
	  3		; Layer Color
	  "Continuous"	; Layer LineType
	  0.15		; Layer LinetypeWeight
	  )
    (princ)
    )
  
  ;-----
  (defun C:MC  ()
    (DRX  ""		; Block FilePath
	  "M_c"		; Block Name
	  "Layer for C"	; Layer Name
	  2		; Layer Color
	  "Continuous"	; Layer LineType
	  0.5		; Layer LinetypeWeight
	  )
    (princ)
    )
  ;-----	
	(defun C:MUndo  ()
    (C:Undo)
  (princ)
)
  
  
  ; -------------------------------------------------------------------------------------------------------------------------
  
  (defun DRX (Path Block Layer LColor LType LWeight / oCLAYER *error*)
    
    (defun *error* (errmsg)
      (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
	(princ (strcat "\nError: " errmsg)))
      (setvar 'CLAYER oCLAYER)
      (vla-endundomark adoc))
    
    ; -----
    (setq oCLAYER (getvar 'CLAYER))
    (if (tblsearch "LAYER" Layer)
      (setvar 'CLAYER Layer)
      (command "_.-LAYER" "_M" Layer "_C" Lcolor Layer "_L" LType Layer "_LW" LWeight Layer ""))
    (command "_.-INSERT" (strcat Path Block ".dwg") "_s" 1 "_r" 0 PAUSE)
    (setvar 'CLAYER oCLAYER)
    (gp:binsertatte)
    )
 
  
  ; -------------------------------------------------------------------------------------------------------------------------
  
  (defun gp:binsertatte ( / *error* ss->objlist nVAR oVAR ss obj objattr nwstr objdyn newvalue prmpts cnt dyn dynp attr i ii)
    
    (defun *error* (errmsg)
      (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
	(princ (strcat "\nError: " errmsg)))
      (mapcar 'setvar nVAR oVAR)
      (vla-endundomark adoc))
    
    (defun ss->objlist (ss / cnt objlist)
      (setq cnt (sslength ss))
      (repeat cnt
	(setq objlist (append objlist (list (vlax-ename->vla-object (ssname ss (- cnt 1))))))
	(setq cnt (- cnt 1)))
      (setq ss nil)
      objlist)
    
    ;----
    
    (setq oVAR (mapcar 'getvar (setq nVAR '(DYNMODE DYNPROMPT ATTREQ))))
    (mapcar 'setvar nVAR 		        '(1	  1	    0))
    
    (setq ss (ssget "L"))
    (setq obj (ss->objlist ss))
    (foreach o obj
      (if (= (cdr (assoc 0 (entget (vlax-vla-object->ename o)))) "INSERT")
	(progn
	  (if (= (vla-get-HasAttributes o) :vlax-true)
	    (progn
	      (setq objattr (vlax-safearray->list (vlax-variant-value (vla-GetAttributes o))))
	      (foreach oa objattr
		(setq oatr oa)
		(if (= (vla-get-Constant oa) :vlax-false)
		  (progn
		    (setq nwstr (getstring (strcat "\nSpecify " (vla-get-TagString oa) ": <" (vla-get-TextString oa) ">: ")))
		    (if (/= nwstr "") (vla-put-TextString oa nwstr))
		    (setq nwstr nil)
		    )
		  )
		)
	      )
	    )
	  (if (= (vla-get-IsDynamicBlock o) :vlax-true)
	    (progn
	      (setq objdyn (vlax-safearray->list (vlax-variant-value (vla-GetDynamicBlockProperties o)))
		    i -1)
	      ;(foreach od objdyn
	      (while (< (setq i (1+ i)) (length objdyn))
		(if (and (setq od (nth i objdyn))
			 (= (vla-get-Show od) :vlax-true)
			 (= (vla-get-ReadOnly od) :vlax-false)
			 (/= (vla-get-PropertyName od) "Origin")
			 )
		  (progn
		    (if (= (vlax-safearray-get-u-bound (vlax-variant-value (vla-get-AllowedValues od)) 1) -1)
		      (progn
			(if (= (vla-get-Description od) "")
			  (setq prmpts (strcat "\nEnter value for " (vla-get-PropertyName od) ":"))
			  (setq prmpts (strcat "\nEnter value for " (vla-get-Description od) ":"))
			  )
			(initget "Undo")
			(cond
			  ((= (vla-get-UnitsType od) acAngular) (setq newvalue (getorient prmpts)))
			  ((= (vla-get-UnitsType od) acDistance) (setq newvalue (getdist prmpts)))
			  ((= (vla-get-UnitsType od) acArea) (setq newvalue (getreal prmpts)))
			  )
			(if (and newvalue
				 (/= newvalue "Undo"))
			  (vla-put-Value od (vlax-make-variant newvalue)))
			)
		      (progn
			(setq prmpts "")
			(setq cnt 1)
			(foreach pt (vlax-safearray->list (vlax-variant-value (vla-get-AllowedValues od)))
			  (if (= (vla-get-UnitsType od) acNoUnits)
			    (if (numberp (vlax-variant-value pt))
			      (if (= (vlax-variant-value pt) 0)
				(setq prmpts (strcat prmpts (itoa cnt) ").NotFlipped "))
				(setq prmpts (strcat prmpts (itoa cnt) ").Flipped "))
				)
			      (setq prmpts (strcat prmpts (itoa cnt) ")." (vl-string-translate "/" "|" (vl-string-translate " " "-" (vlax-variant-value pt))) " "))
			      )
			    (setq prmpts (strcat prmpts (itoa cnt) ")." (vl-string-translate "/" "|" (vl-string-translate " " "-" (rtos (vlax-variant-value pt)))) " "))
			    )
			  (setq cnt (+ cnt 1))
			  )
			(setq prmpts (strcat (vl-string-right-trim " " prmpts) ""))
			(initget 0 (strcat (vl-string-trim "[]" prmpts) " Undo"))
			(if (= (vla-get-Description od) "")
			  (setq newvalue (getkword (strcat "\nEnter value for " (vla-get-PropertyName od) ":" (vl-string-translate " " "/" prmpts))))
			  (setq newvalue (getkword (strcat "\nEnter value for " (vla-get-Description od) ":" (vl-string-translate " " "/" prmpts))))
			  )
			(if (and newvalue
				 (/= newvalue "Undo"))
			  (progn
			    (setq newvalue (nth (- (atoi (substr newvalue 1 (vl-string-position 41 newvalue))) 1) (vlax-safearray->list (vlax-variant-value (vla-get-AllowedValues od)))))
			    (vla-put-Value od newvalue)
			    )
			  )
			)
		      )
		    (if (= newvalue "Undo")
		      (if ii
			(setq i (1- (car ii))
			      ii (cdr ii))
			(setq i -1))
		      (setq ii (cons i ii)))
		    )
		  )
		)
	      )
	    )
	  )
	)
      )
    )
  (mapcar 'setvar nVAR oVAR)
  (vla-endundomark adoc)
  (princ)
)

[ВeekeeCZ · Accepted solution]

---

@s_plant wrote:

Thanks BeeKeeCZ.

.... I simply added "Undo" option into dynamic input selection to do the last inserted deletion but cannot run Undo for any of my input data because for example after asking Length of pipe, lisp is looking for numeric input not alphabetic(U)

---

You can do that. And I made this for you. It is defined as a keyword within (initget "Undo") function.

With only exception you can type "U" anywhere you want. The only exception is when you are prompted to place a block - this is autocad's native command which I can't change. But autocad let you know if you try type anything unexpected.

In main function now you can see "Undo" and "Quit" items on a flyout. When you select a dynamic property then "Undo" is not shown, but it is accepted - type it on a keyboard. This works good for me.

Spoiler

(vl-load-com)

; -------------------------------------------------------------------------------------------------------------------------

(defun c:DDS ( / key input adoc)
  
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (setq input "A"
	key "A B C Undo Quit" ; This calls functions c:MA, c:MB, c:MB
	enlast (entlast)
	)
  (while (progn
	   (initget key)
	   (setq input (cond ((getkword (strcat "\nSelect segment [" (vl-string-translate " " "/" key) "] <" input ">: ")))
			     (input)))
	   (/= input "Quit")
	   )
    (if (/= input "Undo")
      (apply (read (strcat "c:M" input)) nil)
      (if (/= enlast (entlast)) (entdel (entlast)))))
  (vla-endundomark adoc)
  (princ)
  )

;-----
(defun C:MA  ()
  (DRX  ""		; Block FilePath
	"M_a"		; Block Name
	"Layer for A"	; Layer Name
	1		; Layer Color
	"Continuous"	; Layer LineType
	0.5		; Layer LinetypeWeight
	)
  (princ)
  )

;-----
(defun C:MB  ()
  (DRX  ""		; Block FilePath
	"M_b"		; Block Name
	"Layer for B"	; Layer Name
	3		; Layer Color
	"Continuous"	; Layer LineType
	0.15		; Layer LinetypeWeight
	)
  (princ)
  )

;-----
(defun C:MC  ()
  (DRX  ""		; Block FilePath
	"M_c"		; Block Name
	"Layer for C"	; Layer Name
	2		; Layer Color
	"Continuous"	; Layer LineType
	0.5		; Layer LinetypeWeight
	)
  (princ)
  )


; -------------------------------------------------------------------------------------------------------------------------

(defun DRX (Path Block Layer LColor LType LWeight / oCLAYER *error*)
  
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (setvar 'CLAYER oCLAYER)
    (setvar 'CMDECHO 1)
    (vla-endundomark adoc))
  
  ; -----
  (setq oCLAYER (getvar 'CLAYER))
  (setvar 'CMDECHO 0)
  (if (tblsearch "LAYER" Layer)
    (setvar 'CLAYER Layer)
    (command "_.-LAYER" "_M" Layer "_C" Lcolor Layer "_L" LType Layer "_LW" LWeight Layer ""))
  (setvar 'CMDECHO 1)
  (command "_.-INSERT" (strcat Path Block ".dwg") "_s" 1 "_r" 0 PAUSE)
  (setvar 'CLAYER oCLAYER)
  (gp:binsertatte)
  )


; -------------------------------------------------------------------------------------------------------------------------

(defun gp:binsertatte ( / *error* ss->objlist nVAR oVAR ss obj objattr nwstr objdyn newvalue prmpts cnt dyn dynp attr i ii)
  
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (mapcar 'setvar nVAR oVAR)
    (vla-endundomark adoc))
  
  (defun ss->objlist (ss / cnt objlist)
    (setq cnt (sslength ss))
    (repeat cnt
      (setq objlist (append objlist (list (vlax-ename->vla-object (ssname ss (- cnt 1))))))
      (setq cnt (- cnt 1)))
    (setq ss nil)
    objlist)
  
  ;----
  
  (setq oVAR (mapcar 'getvar (setq nVAR '(DYNMODE DYNPROMPT ATTREQ))))
  (mapcar 'setvar nVAR 		        '(1	  1	    0))
  
  (setq ss (ssget "L"))
  (setq obj (ss->objlist ss))
  (foreach o obj
    (if (= (cdr (assoc 0 (entget (vlax-vla-object->ename o)))) "INSERT")
      (progn
	(if (= (vla-get-HasAttributes o) :vlax-true)
	  (progn
	    (setq objattr (vlax-safearray->list (vlax-variant-value (vla-GetAttributes o))))
	    (foreach oa objattr
	      (setq oatr oa)
	      (if (= (vla-get-Constant oa) :vlax-false)
		(progn
		  (setq nwstr (getstring (strcat "\nSpecify " (vla-get-TagString oa) ": <" (vla-get-TextString oa) ">: ")))
		  (if (/= nwstr "") (vla-put-TextString oa nwstr))
		  (setq nwstr nil)
		  )
		)
	      )
	    )
	  )
	(if (= (vla-get-IsDynamicBlock o) :vlax-true)
	  (progn
	    (setq objdyn (vlax-safearray->list (vlax-variant-value (vla-GetDynamicBlockProperties o)))
		  i -1)
	    ;(foreach od objdyn
	    (while (< (setq i (1+ i)) (length objdyn))
	      (if (and (setq od (nth i objdyn))
		       (= (vla-get-Show od) :vlax-true)
		       (= (vla-get-ReadOnly od) :vlax-false)
		       (/= (vla-get-PropertyName od) "Origin")
		       )
		(progn
		  (if (= (vlax-safearray-get-u-bound (vlax-variant-value (vla-get-AllowedValues od)) 1) -1)
		    (progn
		      (if (= (vla-get-Description od) "")
			(setq prmpts (strcat "\nEnter value for " (vla-get-PropertyName od) ":"))
			(setq prmpts (strcat "\nEnter value for " (vla-get-Description od) ":"))
			)
		      (initget "Undo")
		      (cond
			((= (vla-get-UnitsType od) acAngular) (setq newvalue (getorient prmpts)))
			((= (vla-get-UnitsType od) acDistance) (setq newvalue (getdist prmpts)))
			((= (vla-get-UnitsType od) acArea) (setq newvalue (getreal prmpts)))
			)
		      (if (and newvalue
			       (/= newvalue "Undo"))
			(vla-put-Value od (vlax-make-variant newvalue)))
		      )
		    (progn
		      (setq prmpts "[")
		      (setq cnt 1)
		      (foreach pt (vlax-safearray->list (vlax-variant-value (vla-get-AllowedValues od)))
			(if (= (vla-get-UnitsType od) acNoUnits)
			  (if (numberp (vlax-variant-value pt))
			    (if (= (vlax-variant-value pt) 0)
			      (setq prmpts (strcat prmpts (itoa cnt) ").NotFlipped "))
			      (setq prmpts (strcat prmpts (itoa cnt) ").Flipped "))
			      )
			    (setq prmpts (strcat prmpts (itoa cnt) ")." (vl-string-translate "/" "|" (vl-string-translate " " "-" (vlax-variant-value pt))) " "))
			    )
			  (setq prmpts (strcat prmpts (itoa cnt) ")." (vl-string-translate "/" "|" (vl-string-translate " " "-" (rtos (vlax-variant-value pt)))) " "))
			  )
			(setq cnt (+ cnt 1))
			)
		      (setq prmpts (strcat (vl-string-right-trim " " prmpts) "]"))
		      (initget 0 (strcat (vl-string-trim "[]" prmpts) " Undo"))
		      (if (= (vla-get-Description od) "")
			(setq newvalue (getkword (strcat "\nEnter value for " (vla-get-PropertyName od) ":" (vl-string-translate " " "/" prmpts))))
			(setq newvalue (getkword (strcat "\nEnter value for " (vla-get-Description od) ":" (vl-string-translate " " "/" prmpts))))
			)
		      (if (and newvalue
			       (/= newvalue "Undo"))
			(progn
			  (setq newvalue (nth (- (atoi (substr newvalue 1 (vl-string-position 41 newvalue))) 1) (vlax-safearray->list (vlax-variant-value (vla-get-AllowedValues od)))))
			  (vla-put-Value od newvalue)
			  )
			)
		      )
		    )
		  (if (= newvalue "Undo")
		    (if ii
		      (setq i (1- (car ii))
			    ii (cdr ii))
		      (setq i -1))
		    (setq ii (cons i ii)))
		  )
		)
	      )
	    )
	  )
	)
      )
    )
  (mapcar 'setvar nVAR oVAR)
  )

[sam_safinia]

Great job BeeKeeCZ and appreciate your help as always 🙂