Community

Add Prefix and Suffix option to lisp routine

Add Prefix and Suffix option to lisp routine

jtm2020hyo
Collaborator Collaborator
2,586 Views
5 Replies
Message 1 of 6

Add Prefix and Suffix option to lisp routine

jtm2020hyo
Collaborator
Collaborator
‎11-11-2018 05:58 PM

this lisp works like "tcount.lsp" but just in block-attributes, this lisp works great but I need options like Suffix and Prefix.

Can anyone help me?

 

 

(defun c:tcount_att (/ ss ob start_num inc_num sum ename new_value OLDER *error*)
  (vl-load-com)
  (setq OLDER *error*
	*error* myerror)
  (if (setq ss (ssget '((0 . "INSERT"))))
    (progn
      (initget 1 "X Y Select")
      (setq ob (getkword "\nSort selected objects by [X/Y/Select-order] <Select-order>: "))
      (cond
	((= ob "X")
	 (setq ss (sort_x ss))
	 )
	((= ob "Y")
	 (setq ss (sort_y ss))
	 )
	((= ob "Select")
	 (setq ss (sort ss))
	 )
	);cond
      (setq start_num (getint "\nSpecify starting number <1>: "))
      (if (= start_num nil)
	(setq start_num 1)
	(setq start_num start_num)
	)
      (setq inc_num (getint "\nSpecify increment number <1>: "))
      (if (= inc_num nil)
	(setq inc_num 1)
	(setq inc_num inc_num)
	);if
      (setq sum 0)
      (setq sum (apply '+ (list sum start_num)))
      (setq ename (entnext (car ss)))
      (if (/= (cdr (assoc 0 (entget ename))) "SEQEND")
	(progn
	  (setq new_value (rtos sum 2 0))
	  (entmod (subst (cons 1 new_value) (assoc 1 (entget ename)) (entget ename)))
	  (entupd (car ss))
	  )
	)      
      (mapcar '(lambda (obj)
		 (setq sum (apply '+ (list sum inc_num)))
		 (setq ename (entnext obj))
		 (if (/= (cdr (assoc 0 (entget ename))) "SEQEND")
		   (progn
		     (setq new_value (rtos sum 2 0))
		     (entmod (subst (cons 1 new_value) (assoc 1 (entget ename)) (entget ename)))
		     (entupd obj)
		     )
		   )
		 )
	      (cdr ss)
	      )
      );progn
    );if
  (setq *error* OLDER)     
  (princ)  
  );defun
;;;;;;;;
(defun sort_x (ss / n ss1 )
  (setq ss1 nil)
  (setq n 0)
  (repeat (sslength ss)
    (setq ss1 (append ss1 (list (ssname ss n))))
    (setq n (1+ n))
    );repeat
  (setq ss1 (vl-sort ss1 '(lambda (e1 e2) (< (car (cdr (assoc 10 (entget e1))))
					     (car (cdr (assoc 10 (entget e2))))
					     )
			    )
		     )
	);setq
  )
;;;;;;;;
(defun sort_y (ss / n ss1 )
  (setq ss1 nil)
  (setq n 0)
  (repeat (sslength ss)
    (setq ss1 (append ss1 (list (ssname ss n))))
    (setq n (1+ n))
    )
  (setq ss1 (vl-sort ss1 '(lambda (e1 e2) (< (cadr (cdr (assoc 10 (entget e1))))
					     (cadr (cdr (assoc 10 (entget e2))))
					     )
			    )
		     )
	);setq
  )
;;;;;;;;
(defun sort (sset / n ss1 )
  (setq ss1 nil)
  (setq n 0)
  (repeat (sslength ss)
    (setq ss1 (append ss1 (list (ssname ss n))))
    (setq n (1+ n))
    )
  ss1
  )
;;;;;;;;;;;;;;;;;;;;;;
(defun myerror (s)                    
  (cond
    ((= s "quit / exit abort") (princ))
    ((/= s "Function cancelled") (princ (strcat "\nError: " s)))
  )
  (setq *error* OLDER)        
  (princ)
)

 

 

0 Likes
Like
Report
Accepted solutions (2)
Solution 1
Solution 2
2,587 Views
5 Replies
Replies (5)
Message 2 of 6

Satish_Rajdev
Advocate
Advocate
‎11-11-2018 09:01 PM

Try this, Highlighted lines are modified :

 

(defun c:tcount_att (/ ss ob start_num inc_num sum ename new_value OLDER *error* pre suf)
  (vl-load-com)
  (setq OLDER *error*
	*error* myerror)
  (if (and (setq ss (ssget '((0 . "INSERT"))))
	   (if (not (setq pre (getstring t "\nSpecify Prefix : ")))
	     ""
	     pre
	   )
	   (if (not (setq suf (getstring t "\nSpecify Suffix : ")))
	     ""
	     suf
	   )
      )
    (progn
      (initget 1 "X Y Select")
      (setq ob (getkword "\nSort selected objects by [X/Y/Select-order] <Select-order>: "))
      (cond
	((= ob "X")
	 (setq ss (sort_x ss))
	 )
	((= ob "Y")
	 (setq ss (sort_y ss))
	 )
	((= ob "Select")
	 (setq ss (sort ss))
	 )
	);cond
      (setq start_num (getint "\nSpecify starting number <1>: "))
      (if (= start_num nil)
	(setq start_num 1)
	(setq start_num start_num)
	)
      (setq inc_num (getint "\nSpecify increment number <1>: "))
      (if (= inc_num nil)
	(setq inc_num 1)
	(setq inc_num inc_num)
	);if
      (setq sum 0)
      (setq sum (apply '+ (list sum start_num)))
      (setq ename (entnext (car ss)))
      (if (/= (cdr (assoc 0 (entget ename))) "SEQEND")
	(progn
	  (setq new_value (rtos sum 2 0))
	  (entmod (subst (cons 1 new_value) (assoc 1 (entget ename)) (entget ename)))
	  (entupd (car ss))
	  )
	)      
      (mapcar '(lambda (obj)
		 (setq sum (apply '+ (list sum inc_num)))
		 (setq ename (entnext obj))
		 (if (/= (cdr (assoc 0 (entget ename))) "SEQEND")
		   (progn
		     (setq new_value (strcat pre (rtos sum 2 0) suf))
		     (entmod (subst (cons 1 new_value) (assoc 1 (entget ename)) (entget ename)))
		     (entupd obj)
		     )
		   )
		 )
	      (cdr ss)
	      )
      );progn
    );if
  (setq *error* OLDER)     
  (princ)  
  );defun

Best Regards,
Satish Rajdev


REY Technologies | Linked IN | YouTube Channel


 

0 Likes
Like
Report
Message 3 of 6

dbhunia
Advisor
Advisor
‎11-11-2018 10:23 PM
Accepted solution

Hi

 

Try this....

 

(defun c:tcount_att (/ ss ob start_num inc_num sum ename new_value OLDER *error*)
  (vl-load-com)
  (setq OLDER *error*
	*error* myerror)
  (if (setq ss (ssget '((0 . "INSERT"))))
    (progn
      (initget "X Y Picked")
      (setq ob (getkword "\nSort selected objects by [X/Y/Picked-order] <Picked-order>: "))
      (cond
	((= ob "X")
	 (setq ss (sort_x ss))
	 )
	((= ob "Y")
	 (setq ss (sort_y ss))
	 )
	((or (= ob "Picked") (= ob nil))
	 (setq ss (sort ss))
	 )
      );cond
      (setq start_num (getint "\nSpecify starting number <1>: "))
      (if (= start_num nil)
	(setq start_num 1)
	(setq start_num start_num)
      );if
      (setq inc_num (getint "\nSpecify increment number <1>: "))
      (if (= inc_num nil)
	(setq inc_num 1)
	(setq inc_num inc_num)
      );if
      (setq sum 0)
      (setq sum (apply '+ (list sum start_num)))
      (setq ename (entnext (car ss)))
      (if (/= (cdr (assoc 0 (entget ename))) "SEQEND")

	(progn
	(initget "Overwrite Prefix Suffix")

	    (if (/= (cdr (assoc 0 (entget ename))) "SEQEND")

		(progn
		(setq ob1 (getkword "\nPlacement of numbers in text [Overwrite/Prefix/Suffix] <Overwrite>: "))

		  (cond
		    ((or (= ob1 "Overwrite") (= ob1 nil))
			(setq new_value (rtos sum 2 0))
		  	(entmod (subst (cons 1 new_value) (assoc 1 (entget ename)) (entget ename)))
	  		(entupd (car ss))
		    )
		    ((= ob1 "Prefix")
			(setq new_value (rtos sum 2 0))
		  	(entmod (subst (cons 1 (strcat new_value (cdr (assoc 1 (entget ename))))) (assoc 1 (entget ename)) (entget ename)))
	  		(entupd (car ss))
		    )
		    ((= ob1 "Suffix")
			(setq new_value (rtos sum 2 0))
		  	(entmod (subst (cons 1 (strcat (cdr (assoc 1 (entget ename))) new_value)) (assoc 1 (entget ename)) (entget ename)))
		  	(entupd (car ss))
		    )
		  );cond
		);progn
	    );if
	);progn
      )      
      (mapcar '(lambda (obj)
		 (setq sum (apply '+ (list sum inc_num)))
		 (setq ename (entnext obj))
		 (if (/= (cdr (assoc 0 (entget ename))) "SEQEND")
		(progn
		  (cond
		    ((or (= ob1 "Overwrite") (= ob1 nil))
			(setq new_value (rtos sum 2 0))
	  		(entmod (subst (cons 1 new_value) (assoc 1 (entget ename)) (entget ename)))
		  	(entupd (car ss))
		    )
		    ((= ob1 "Prefix")
			(setq new_value (rtos sum 2 0))
	  		(entmod (subst (cons 1 (strcat new_value (cdr (assoc 1 (entget ename))))) (assoc 1 (entget ename)) (entget ename)))
		  	(entupd (car ss))
		    )
		    ((= ob1 "Suffix")
			(setq new_value (rtos sum 2 0))
	  		(entmod (subst (cons 1 (strcat (cdr (assoc 1 (entget ename))) new_value)) (assoc 1 (entget ename)) (entget ename)))
		  	(entupd (car ss))
		    )
		  );cond
		);progn
	       )
	       )
	      (cdr ss)
	      )
      );progn
    );if
  (setq *error* OLDER)     
  (princ)  
  );defun
;;;;;;;;
(defun sort_x (ss / n ss1 )
  (setq ss1 nil)
  (setq n 0)
  (repeat (sslength ss)
    (setq ss1 (append ss1 (list (ssname ss n))))
    (setq n (1+ n))
    );repeat
  (setq ss1 (vl-sort ss1 '(lambda (e1 e2) (< (car (cdr (assoc 10 (entget e1))))
					     (car (cdr (assoc 10 (entget e2))))
					     )
			    )
		     )
	);setq
  )
;;;;;;;;
(defun sort_y (ss / n ss1 )
  (setq ss1 nil)
  (setq n 0)
  (repeat (sslength ss)
    (setq ss1 (append ss1 (list (ssname ss n))))
    (setq n (1+ n))
    )
  (setq ss1 (vl-sort ss1 '(lambda (e1 e2) (< (cadr (cdr (assoc 10 (entget e1))))
					     (cadr (cdr (assoc 10 (entget e2))))
					     )
			    )
		     )
	);setq
  )
;;;;;;;;
(defun sort (sset / n ss1 )
  (setq ss1 nil)
  (setq n 0)
  (repeat (sslength ss)
    (setq ss1 (append ss1 (list (ssname ss n))))
    (setq n (1+ n))
    )
  ss1
  )
;;;;;;;;;;;;;;;;;;;;;;
(defun myerror (s)                    
  (cond
    ((= s "quit / exit abort") (princ))
    ((/= s "Function cancelled") (princ (strcat "\nError: " s)))
  )
  (setq *error* OLDER)        
  (princ)
)

Debashis Bhunia
Co-Founder of Geometrifying Trigonometry(C)
________________________________________________
Walking is the First step of Running, Technique comes Next....
Report
Message 4 of 6

dbhunia
Advisor
Advisor
‎11-12-2018 12:44 AM
Accepted solution

Hi

 

I may be wrong in my last post for your requirement........

 

@jtm2020hyo wrote:

this lisp works like "tcount.lsp" but just in block-attributes, this lisp works great but I need options like Suffix and Prefix.
............

 

If so you can try this......

 

(defun c:tcount_att (/ ss ob start_num inc_num sum ename new_value OLDER *error*)
  (vl-load-com)
  (setq OLDER *error*
	*error* myerror)
  (if (setq ss (ssget '((0 . "INSERT"))))
    (progn
      (initget "X Y Picked")
      (setq ob (getkword "\nSort selected objects by [X/Y/Picked-order] <Picked-order>: "))
      (cond
	((= ob "X")
	 (setq ss (sort_x ss))
	 )
	((= ob "Y")
	 (setq ss (sort_y ss))
	 )
	((or (= ob "Picked") (= ob nil))
	 (setq ss (sort ss))
	 )
      );cond
      (setq start_num (getint "\nSpecify starting number <1>: "))
      (if (= start_num nil)
	(setq start_num 1)
	(setq start_num start_num)
      );if
      (setq inc_num (getint "\nSpecify increment number <1>: "))
      (if (= inc_num nil)
	(setq inc_num 1)
	(setq inc_num inc_num)
      );if
      (setq sum 0)
      (setq sum (apply '+ (list sum start_num)))
      (setq ename (entnext (car ss)))
      (if (/= (cdr (assoc 0 (entget ename))) "SEQEND")

	(progn
	(initget "None Prefix Suffix")

	    (if (/= (cdr (assoc 0 (entget ename))) "SEQEND")

		(progn
		(setq ob1 (getkword "\nAdd text with Value to [Prefix/Suffix/None] <None>: "))

		  (cond
		    ((or (= ob1 "None") (= ob1 nil))
			(setq new_value (rtos sum 2 0))
		  	(entmod (subst (cons 1 new_value) (assoc 1 (entget ename)) (entget ename)))
	  		(entupd (car ss))
		    )
		    ((= ob1 "Prefix")
			(setq Txt (getstring "\nEnter text for Prefix: "))
			(setq new_value (rtos sum 2 0))
		  	(entmod (subst (cons 1 (strcat Txt new_value)) (assoc 1 (entget ename)) (entget ename)))
	  		(entupd (car ss))
		    )
		    ((= ob1 "Suffix")
			(setq Txt (getstring "\nEnter text for Suffix: "))
			(setq new_value (rtos sum 2 0))
		  	(entmod (subst (cons 1 (strcat new_value Txt)) (assoc 1 (entget ename)) (entget ename)))
		  	(entupd (car ss))
		    )
		  );cond
		);progn
	    );if
	);progn
      )      
      (mapcar '(lambda (obj)
		 (setq sum (apply '+ (list sum inc_num)))
		 (setq ename (entnext obj))
		 (if (/= (cdr (assoc 0 (entget ename))) "SEQEND")
		(progn
		  (cond
		    ((or (= ob1 "None") (= ob1 nil))
			(setq new_value (rtos sum 2 0))
	  		(entmod (subst (cons 1 new_value) (assoc 1 (entget ename)) (entget ename)))
		  	(entupd (car ss))
		    )
		    ((= ob1 "Prefix")
			(setq new_value (rtos sum 2 0))
	  		(entmod (subst (cons 1 (strcat Txt new_value)) (assoc 1 (entget ename)) (entget ename)))
		  	(entupd (car ss))
		    )
		    ((= ob1 "Suffix")
			(setq new_value (rtos sum 2 0))
	  		(entmod (subst (cons 1 (strcat new_value Txt)) (assoc 1 (entget ename)) (entget ename)))
		  	(entupd (car ss))
		    )
		  );cond
		);progn
	       )
	       )
	      (cdr ss)
	      )
      );progn
    );if
  (setq *error* OLDER)     
  (princ)  
  );defun
;;;;;;;;
(defun sort_x (ss / n ss1 )
  (setq ss1 nil)
  (setq n 0)
  (repeat (sslength ss)
    (setq ss1 (append ss1 (list (ssname ss n))))
    (setq n (1+ n))
    );repeat
  (setq ss1 (vl-sort ss1 '(lambda (e1 e2) (< (car (cdr (assoc 10 (entget e1))))
					     (car (cdr (assoc 10 (entget e2))))
					     )
			    )
		     )
	);setq
  )
;;;;;;;;
(defun sort_y (ss / n ss1 )
  (setq ss1 nil)
  (setq n 0)
  (repeat (sslength ss)
    (setq ss1 (append ss1 (list (ssname ss n))))
    (setq n (1+ n))
    )
  (setq ss1 (vl-sort ss1 '(lambda (e1 e2) (< (cadr (cdr (assoc 10 (entget e1))))
					     (cadr (cdr (assoc 10 (entget e2))))
					     )
			    )
		     )
	);setq
  )
;;;;;;;;
(defun sort (sset / n ss1 )
  (setq ss1 nil)
  (setq n 0)
  (repeat (sslength ss)
    (setq ss1 (append ss1 (list (ssname ss n))))
    (setq n (1+ n))
    )
  ss1
  )
;;;;;;;;;;;;;;;;;;;;;;
(defun myerror (s)                    
  (cond
    ((= s "quit / exit abort") (princ))
    ((/= s "Function cancelled") (princ (strcat "\nError: " s)))
  )
  (setq *error* OLDER)        
  (princ)
)

Debashis Bhunia
Co-Founder of Geometrifying Trigonometry(C)
________________________________________________
Walking is the First step of Running, Technique comes Next....
Report
Message 5 of 6

jtm2020hyo
Collaborator
Collaborator
in reply to dbhunia
‎11-12-2018 10:45 AM

@dbhunia
Both codes are very good and work for me.

thanks a lot, you are the best.

0 Likes
Like
Report
Message 6 of 6

jtm2020hyo
Collaborator
Collaborator
in reply to Satish_Rajdev
‎11-12-2018 10:48 AM

I was testing code but does not work.

0 Likes
Like
Report
Report a website issue