;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;                                                                          ;
;         SiteStats.lsp   By Michael Bulatovich    February 21st, 2007     ;
;                                                                          ;
;         Performs basic arithmetic functions using text entities          ;
;         as inputs, and displays the answers as copies of text            ;
;         entities on screen which can be repositioned. Includes           ;
;         a converter function that can convert square units from          ;
;         meters to feet, and a prefix/suffix utility.                     ;
;         The acad.unt file must have sqm and sqft                         ;
;         defined as units in order to work. Routine is meant to           ;
;         facilitate the tabulation of area statistics.                    ;
;                                                                          ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(textscr)
(Princ
  "\n\n
\tSiteStats.LSP\tloads a number of command line functions\n\t\t\trelated to site stats.                  \n
\t______________________________________________________________\n                                                 
\tCVRT\twill convert square areas from square feet to meters,\n\t\t\tor vice versa.\n
\t\t\t(The acad.unt file must have sqm and sqft defined\n\t\t\tas units in order to work.)        \n
                                                 
\tARE\twill label the area of a polyline using the \n\t\t\tcurrent text style and layer.  \n
                                                 
\tFIX\twill add prefixes and/or suffixes series of text entities.                 \n
                                                 
\t+\twill add numeric values of a series of text entities.                 \n
                                                 
\t-\twill subtract numeric values of a series of text entities.                 \n
                                                 
\t/\twill divide numeric values of a series of text entities.                 \n
                                                 
\t*\twill multiply numeric values of a series of text entities.                 \n

\t______________________________________________________________\n                                                                                    
\tCalculated values are delivered by copying existing text\n
\t\t\tto the desired location for the calculated value.
  "
  
  )

;=====================================================================;
;          converter section                                          ;
;=====================================================================;
(defun c:cvrt (/	cont	item	    itemlist	itemstring
		    itemvalue	newvalue    newstring	newtext
		    newlist digitacc itemacc   
		   )
  (graphscr)
  (setvar "cmdecho" 0)
  (command "undo" "m")
  (if (equal conversiontype nil)
    (progn
      (prompt "\nMakes Copies of Numbers Converted to/from Metric/Imperial.")

      (initget 1 "1 2")
      (setq conversiontype
	     (getkword
	       "\nSpecify conversion type: <1> Sq. Meters-->Sq. Feet or <2> Sq. Feet-->Sq. Meters"
	     )
	    cvrt2ndrun nil
      )
      
    ));end if
    (cond
      ((and cvrt2ndrun (equal conversiontype "1"))
	(progn
	  (prompt "\nContinue converting Sq. Meters --> Sq. Feet?: <Y>/N")
	  (setq cont (getstring))
	  (if (not(eq cont ""))
	    (setq conversiontype "2"
		  cvrt2ndrun nil)
	    ;(setq cvrt2ndrun nil)
	  )
	);end then progn
      );end cond 1

      ((and cvrt2ndrun (equal conversiontype "2"))
	(progn
	  (prompt "\nContinue converting Sq. Feet --> Sq. Meters?: <Y>/N")
	  (setq cont (getstring))
	  (if (not(eq cont ""))
	    (setq conversiontype "1"
		  cvrt2ndrun nil)
	    ;(setq cvrt2ndrun nil)
	  )
	);end then progn
      );end cond 2
    );end cond
     

(setq cvrt2ndrun t)


  (setq	item
	 (car (entsel "\n<<<<< Pick number to copy-convert:>>>>>"))
  )
  (setq itemlist (entget item))
  (setq itemstring (cdr (assoc 1 itemlist)))
  
  (test itemstring)
  (setq itemacc digitacc)
  (cond
    ((equal conversiontype "1")(setq itemacc (1- itemacc)))
    ((equal conversiontype "2")(setq itemacc (1+ itemacc)))
    )

(setq itemvalue (atof itemstring))
  (if (equal conversiontype "1")
    (progn
      (setq newvalue
	     (cvunit itemvalue "sqm" "sqft")
      )
    )
    (progn
      (setq newvalue
	     (cvunit itemvalue "sqft" "sqm")
      )

    )
  )
  (setq newstring (rtos newvalue 2 itemacc))
  (prompt
    "\nCopy text to new location for converted number: (Base point/Second point)"
  )
  
  (command "copy" item "" pause pause)
  (setq newtext (entlast))
  (setq newlist (entget newtext))
  (setq newlist (subst (cons 1 newstring) (assoc 1 newlist) newlist))
  (entmod newlist)
  (princ)
)

;=====================================================================;
;          area label section                                         ;
;=====================================================================;

(defun c:ARE (/ q qname getq checkclose remainder AR inspnt)
  (setvar "cmdecho" 0)
  (graphscr)
  (command "undo" "m")
  (if (not textheight)
    (progn
      (initget "Fixed Unspecified Dunno")
      (setq textheight
	     (getkword
	       "\n\nIs the current textstyle height Fixed or Unspecified or Don't know? F/U/D:"
	     )
	     );end setq
      (if (eq textheight "Dunno")
	(progn
	  (Prompt "Go check and come back.")
	  (setq textheight nil)
	  (quit)(princ)
	  ))
      (setq q (entsel "Pick a closed POLYLINE:"))
    );end progn
  );end if
  (if are1strun
    (Progn
      (initget 128 "Change")
      (setq q (entsel "<C>hange text height option or Pick a closed POLYLINE:"))
      (if (eq q "Change")
	(progn
	  (cond
	    ((eq textheight "Fixed")(setq textheight "Unspecified"));end cond 1
	    ((eq textheight "Unspecified")(setq textheight "Fixed"));end cond 2
	    );end cond
	  (setq q (entsel "Pick a closed POLYLINE:"))
	  );end inner progn
	);end if   
      );end progn
    );end if
  ;(setq q (entsel "Pick a closed POLYLINE:"))
  (setq qname (car q))
  (setq getq (entget qname))
 
  (setq checkclose (cdr (assoc 70 getq)))
 
 ;NOTE  if pline is closed, the 70 code bit adds 1 , so it is not an even num
 ;      "    "   "    "   , the 70 code bit must be 2,4,8,18,64,128--an even num
 ;so check if its even or odd-by dividing it by 2 and see if remainder is 1 or0
  (setq remainder (rem (+ 2 checkclose) 2))
  (if (= remainder 0) (alert "pline is NOT CLOSED"))
  (command "area" "E" qname)
  (setq ar (/ (getvar "AREA") 144))
  (SETQ AR (RTOS AR 2 2)
	    are1strun t)
  (setq inspnt (getpoint "Pick point for area label:"))
   (if (eq textheight "Fixed")
    (command "text" inspnt  "" AR )
    (command "text" inspnt "" ""	AR)
  )
)


;=====================================================================;
;          + section                                                  ;
;=====================================================================;
(defun c:+ (/	       item	  itemlist   itemstring
	    itemvalue  sum	  sumstring  newtext
	    newlist    newstring  acc	     digitacc
	   )
  (setvar "cmdecho" 0)
  (graphscr)
  (command "undo" "m")
  (setq sum 0)(setq acc 0)
  (while
    (setq item
	   (car (entsel "\n<<<<< Pick numbers to add:>>>>>"))
    )
     (setq itemlist (entget item))
     (setq itemstring (cdr (assoc 1 itemlist)))
     
     (test itemstring)
     (setq itemvalue (atof itemstring))
     (setq sum (+ sum itemvalue))
     (if (> digitacc acc)
       (setq acc digitacc)
     )
     (princ (strcat "\nSum equals " (rtos sum 2 acc)))
  ) ;end while
  (prompt
    "\nCopy text entity to new location for sum:(Base point/Second point)"
  )
  (command "copy" pause "" pause pause)
  (setq sumstring (rtos sum 2 acc))
  (setq newtext (entlast))
  (setq newlist (entget newtext))
  (setq	newlist	(subst (cons 1 sumstring)
		       (assoc 1 newlist)
		       newlist))
  (entmod newlist)
  (princ)
) ;end defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;                     test function                          ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun test (string / charac len end counter digit flag)
  (setq	charac (list "1" "2" "3" "4" "5" "6" "7" "8" "9" "0"
		     ".")
  )
  (setq len (strlen string))
  (setq digitacc 0)
  (setq end len)
  (setq counter 1)
  (while counter
    (setq digit (substr string counter 1))
    (if	(and flag (eq digit "."))
      (progn
	(princ "\nNot a valid number.\n")
	(quit)
      )
    )
    (if	(member digit charac)
      (progn
	(setq counter (1+ counter))
	(if flag
	  (setq digitacc (1+ digitacc))
	)
      )
      (progn (princ "\nNot a valid number.\n") (quit))
 ;end progn
    ) ;end if
    (if	(eq digit ".")
      (setq flag t)
    )
    (if	(> counter len)
      (setq counter nil)
    )
  ) ;end while
) ;end test

;=====================================================================;
;          - section                                                  ;
;=====================================================================;
(defun c:- (/	       item	  itemlist   itemstring
	    itemvalue  sum	  sumstring  newtext
	    newlist    newstring  acc	     digitacc
	   )
  (setvar "cmdecho" 0)
  (graphscr)
  (command "undo" "m")
  
    (setq item
	   (car
	     (entsel "\n<<<<< Pick number to subtract FROM:>>>>>")
	   )
    )

    (setq itemlist (entget item))
    (setq itemstring (cdr (assoc 1 itemlist)))
    (setq acc 0)
    (test itemstring)
    (setq sum (atof itemstring))
  
  (if (> digitacc acc)
    (setq acc digitacc)
  )
  (while
    (setq item
	   (car (entsel "\n<<<<< Pick numbers to subtract:>>>>>"))
    )

     (setq itemlist (entget item))
     (setq itemstring (cdr (assoc 1 itemlist)))
     (test itemstring)
     (setq itemvalue (atof itemstring))
     (setq sum (- sum itemvalue))
     (if (> digitacc acc)
       (setq acc digitacc))
     (princ (strcat "\nRemainder equals " (rtos sum 2 acc)))
  ) ;end while
  (prompt "\nCopy text entity to new location for sum:(Base point/Second point)")
  (command "copy" pause "" pause pause)
  (setq sumstring (rtos sum 2 acc))
  (setq newtext (entlast))
  (setq newlist (entget newtext))
  (setq	newlist	(subst (cons 1 sumstring)
		       (assoc 1 newlist)
		       newlist))
  (entmod newlist)
  (princ)
) ;end defun

(defun test (string / charac len end counter digit flag)
  (setq	charac (list "1" "2" "3" "4" "5" "6" "7" "8" "9" "0" "."))
  (setq len (strlen string))
  (setq digitacc 0)
  (setq end len)
  (setq counter 1)
  (while counter
    (setq digit (substr string counter 1))
    (if	(and flag (eq digit "."))
      (progn (princ "\nNot a valid number.\n")
	(quit)))
    (if	(member digit charac)
      (progn
	(setq counter (1+ counter))
	(if flag
	  (setq digitacc (1+ digitacc))))
      (progn (princ "\nNot a valid number.\n") (quit))
    ) ;end if
    (if	(eq digit ".")
      (setq flag t))
    (if	(> counter len)
      (setq counter nil))
  ) ;end while
) ;end test

;=====================================================================;
;          * section                                                  ;
;=====================================================================;
(defun c:* (/	       item	  itemlist   itemstring
	    itemvalue  sum	  sumstring  newtext
	    newlist    newstring  acc	     digitacc   )
  (setvar "cmdecho" 0)
  (graphscr)
  (command "undo" "m")
  
    (setq item
	   (car (entsel "\n<<<<< Pick number to multiply:>>>>>"))
    )

    (setq itemlist (entget item))
    (setq itemstring (cdr (assoc 1 itemlist)))
    (setq acc 0)
    (test itemstring)
    (setq sum (atof itemstring))
  
  (if (> digitacc acc)(setq acc digitacc))
  (while
    (setq item
	   (car (entsel "\n<<<<< Pick numbers to multiply:>>>>>")))
     (setq itemlist (entget item))
     (setq itemstring (cdr (assoc 1 itemlist)))
     (test itemstring)
     (setq itemvalue (atof itemstring))
     (setq sum (* sum itemvalue))
     (if (> digitacc acc)(setq acc digitacc))
     (princ (strcat "\nProduct equals " (rtos sum 2 acc)))
  ) ;end while
  (prompt "\nCopy text entity to new location for product:(Base point/Second point)")
  (command "copy" pause "" pause pause)
  (setq sumstring (rtos sum 2 acc))
  (setq newtext (entlast))
  (setq newlist (entget newtext))
  (setq	newlist	(subst (cons 1 sumstring)
		       (assoc 1 newlist)
		       newlist))
  (entmod newlist)
  (princ)
) ;end defun

(defun test (string / charac len end counter digit flag)
  (setq	charac (list "1" "2" "3" "4" "5" "6" "7" "8" "9" "0" "."))
  (setq len (strlen string))
  (setq digitacc 0)
  (setq end len)
  (setq counter 1)
  (while counter
    (setq digit (substr string counter 1))
    (if	(and flag (eq digit "."))
      (progn(princ "\nNot a valid number.\n")(quit))
    )
    (if	(member digit charac)
      (progn
	(setq counter (1+ counter))
	(if flag
	  (setq digitacc (1+ digitacc)))
      )
      (progn (princ "\nNot a valid number.\n") (quit))
    ) ;end if
    (if	(eq digit ".")(setq flag t))
    (if	(> counter len)(setq counter nil))
  ) ;end while
) ;end test

;=====================================================================;
;          / section                                                  ;
;=====================================================================;
(defun c:/ (/	       item	  itemlist   itemstring
	    itemvalue  sum	  sumstring  newtext
	    newlist    newstring  acc	     digitacc
	   )
  (setvar "cmdecho" 0)
  (graphscr)
  (command "undo" "m")
  
    (setq item
	   (car (entsel "\n<<<<< Pick number to divide:>>>>>")))
    (setq itemlist (entget item))
    (setq itemstring (cdr (assoc 1 itemlist)))
    (setq acc 0)
    (test itemstring)
    (setq sum (atof itemstring))
  (if (> digitacc acc)(setq acc digitacc))
  (while
    (setq item
	   (car	(entsel "\n<<<<< Pick numbers to divide BY:>>>>>")))
     (setq itemlist (entget item))
     (setq itemstring (cdr (assoc 1 itemlist)))
     (test itemstring)
     (setq itemvalue (atof itemstring))
     (setq sum (/ sum itemvalue))
     (if (> digitacc acc)(setq acc digitacc))
     (princ (strcat "\nQuotient equals " (rtos sum 2 acc)))
  ) ;end while
  (prompt "\nCopy text entity to new location for product:(Base point/Second point)")
  (command "copy" pause "" pause pause)
  (setq sumstring (rtos sum 2 acc))
  (setq newtext (entlast))
  (setq newlist (entget newtext))
  (setq	newlist	(subst (cons 1 sumstring)
		       (assoc 1 newlist)
		       newlist))
  (entmod newlist)
  (princ)
) ;end defun

(defun test (string / charac len end counter digit flag)
  (setq	charac (list "1" "2" "3" "4" "5" "6" "7" "8" "9" "0" "."))
  (setq digitacc 0)
  (setq len (strlen string))
  (setq end len)
  (setq counter 1)
  (while counter
    (setq digit (substr string counter 1))
    (if	(and flag (eq digit "."))
      (progn (princ "\nNot a valid number.\n")(quit)))
    (if	(member digit charac)
      (progn
	(setq counter (1+ counter))
	(if flag(setq digitacc (1+ digitacc))))
      (progn (princ "\nNot a valid number.\n") (quit))
    ) ;end if
    (if	(eq digit ".")(setq flag t))
    (if	(> counter len)(setq counter nil))
  ) ;end while
) ;end test

;=====================================================================;
;          FIX section                                                ;
;=====================================================================;

(defun c:fix
	     (/		  pretest     ss default
	      sslen	      nextent
	      entdata	        c
	      targ_att	  targ_list   targ_flag
	      	  newval     textval   )
  (setvar "cmdecho" 0)
  (graphscr)
  (command "undo" "m")
  (if (not fix2ndrun)
    (progn
          (Alert "FIX.LSP\n\nFIX adds alpha-numeric prefixes and/or suffixes to all\ntext entities in a selection set.\n")
	  (setq pretest nil
		prefix nil
		suffix nil)
	  )
  ) ;end if
  (initget  "Prefix Suffix Both")
  (setq	pretest
	 (getkword
	   "Do you want to add a Prefix, a Suffix, or Both? <P/S/B>:"))
  (cond
    ((eq pretest "Prefix") (if (not prefix)
				   (progn
				     (setq prefix
				     (getstring "Type prefix, including spaces, in double quotes :"))
				     );end progn
				     (progn
				       (setq default prefix)
				       (setq prefix
				       (getstring (strcat "Type prefix, including spaces, in double quotes : <" default ">")))
				       (if (eq prefix "")(setq prefix default))
				       );end progn
				      );end if
	);end condition pre
    ((eq pretest "Suffix")(if (not suffix)
				   (progn
				     (setq suffix
				     (getstring "Type suffix, including spaces, in double quotes :"))
				     );end progn
				     (progn
				       (setq default suffix)
				       (setq suffix
				       (getstring (strcat "Type suffix, including spaces, in double quotes : <" default ">")))
				       (if (eq suffix "")(setq suffix default))
				       );end progn
				      );end if
     );end condition suf
    ((eq pretest "Both")(progn
			  (if (not prefix)
				   (progn
				     (setq prefix
				     (getstring "Type prefix, including spaces, in double quotes :"))
				     );end progn
				     (progn
				       (setq default prefix)
				       (setq prefix
				       (getstring (strcat "Type prefix, including spaces, in double quotes : <" default ">")))
				       (if (eq  prefix "")(setq prefix default))
				       );end progn
				      ); end if
			  (if (not suffix)
				   (progn
				     (setq suffix
				     (getstring "Type suffix, including spaces, in double quotes :"))
				     );end progn
				     (progn
				       (setq default suffix)
				       (setq suffix
				       (getstring (strcat "Type suffix, including spaces, in double quotes : <" default ">")))
				       (if (eq suffix "")(setq suffix default))
				       );end progn
				      );end if
			  );end progn
     );end condition both
    );end cond
  
  (princ "Select text entities to change:")
  (setq	ss     (ssget '((0 . "TEXT")))
	sslen (sslength ss)
	c	     0  ) ;end setq
  (while (< c sslen)
    (setq nextent (ssname ss c) 				;get the next text
	  entdata    (entget nextent) 				;get the next text list
    ) 								;end setq
    (if	(eq "TEXT" (cdr (assoc 0 entdata))) 			;if the entnext is text...
      (progn
	(setq textval (assoc 1 entdata)) 			; get the text value
	(cond ((eq pretest "Prefix")(setq newval  (strcat prefix (cdr textval))))
	      ((eq pretest "Suffix")(setq newval  (strcat (cdr textval) suffix)))
	      ((eq pretest "Both")(setq newval (strcat prefix (cdr textval) suffix)))
	      );end cond
	 (setq entdata  (subst (cons 1 newval) textval entdata)) 	;and swap it for the old value
	(entmod entdata))
            (setq c (+ 1 c))						;if/else set the counter to get the next block
    ) ;end if
    (setq c (+ 1 c))
  ) ;end while
  (command "regen")
  (setq fix2ndrun t)
  (princ)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
) ;end defun