;===========================================================;
 ;                                                           ;
 ;    LtsMatch.lsp by Michael Bulatovich, Aug. 19, 2006      ;
 ;             www.michaelbulatovich.com                     ;
 ;                                                           ;
 ;    Changes the LTSCALE of a selection of items to         ;
 ;    that of a selected item, or a specified value.         ;
 ;                                                           ;
 ;===========================================================;

(defun strip (ss / item fronthalf backhalf newent)

  (setq counter (1- (sslength ss)))
  (while (>= counter 0)
    (setq item (ssname ss counter))
    (setq ent (entget item))
    (if	(assoc 48 ent)
      (progn
	(setq backhalf (cdr (member (assoc 48 ent) ent)))
	(setq fronthalf
	       (reverse
		 (cdr
		   (member (assoc 48 (reverse ent)) (reverse ent))
		 )
	       )
	)
	(setq newent (append fronthalf backhalf))
	(entmake newent)
	(entdel item)
 ;(entmod ent)(entupd item)
      ) ;end progn
    ) ;end if
    (setq counter (1- counter))
  ) ;end while
) ;end defun strip

(defun subs (lts ss / ltss item)

  (setq counter (1- (sslength ss)))
  (while (>= counter 0)
    (setq item (ssname ss counter))
    (setq ent (entget item))
    (if	(assoc 48 ent)
      (progn
	(setq ent (subst lts (assoc 48 ent) ent))
	(entmod ent) ;modify the ent
	(setq counter (1- counter))
      ) ;end then progn
      (progn
	(setq ltss (list lts))
	(setq ent (append ent ltss))
	(entmod ent) ;modify the ent
	(setq counter (1- counter))
      ) ;end else progn
    ) ;end if

  ) ;end while
) ;end defun subs

(defun c:ltsmatch (/ newlts ss counter ent)
 ;(setvar "cmdecho" 0)
  (command "undo" "be")
  (initget "Specify Pick")
  (setq	choice
	 (getkword
	   "Do you want to Specify an ltscale override, or Pick and object to match? <S/P>:"
	 )
  )
  (if (= choice "Specify")
    (progn
      (initget 4)
      (setq
	newlts
	 (getreal
	   "Specify ltscale override<Enter to remove overides>:"
	 )
      )
      (if (not (null newlts))
	(setq lts (cons 48 newlts))
	(setq lts nil)
      ) ;end if
    ) ;end progn

    (setq lts
	   (assoc
	     48
	     (entget
	       (car (entsel "Pick object with desired LTSCALE:"))
	     )
	   )
    )
  ) ;end if-else
  (prompt "Select items to change:")
  (setq ss (ssget))
  (if (null lts)
    (strip ss)
    (subs lts ss)
  ) ;end if
  (command "undo" "end")
  (princ)
) ;end defun