AREA CALCULATION LISP

[vbcad]

I HAVE A LISP(NOT MY CODE I DO NOT KNOW WHERE IT CAME FROM) THAT I WOULD LIKE TO USE FOR SQUARE FOOTAGE CALCULATIONS. THE ROUTINE RETRIEVES THE SQUARE FOOTAGE A THE PRINTS IT ON THE SCREEN AT A USER PICKED POINT. I WOULD LIKE THE ROUTINE TO PRINT "SQ. FT." AFTER THE SQARE FOOTAGE NUMBER. IT WILL DO THIS IF I ENTER IT AT THE PROMPT "ENTER THE TYPE OF UNITS. BELOW IS THE CODE.

;
(defun C:AC (/ #ENT #AA #CV #UN #PT #TXT #ECHO #OLDERR @NEWERR)

(defun @NEWERR (%A)
(setq *error* #OLDERR)
(setvar "cmdecho" #ECHO)
(cond
((= %A "Function cancelled") nil)
(T (princ (strcat "\nerror: " %A ":\n"))))
(princ))

(setq #OLDERR *error*)
(setq #ECHO (getvar "cmdecho"))

(setq *error* @NEWERR)
(setvar "cmdecho" 0)
(setq #ENT (car (entsel "\nPick an object for an area: ")))

(if #ENT
(if (member (cdr (assoc 0 (entget #ENT)))
(list "ELLIPSE" "CIRCLE" "LWPOLYLINE" "POLYLINE" "REGION"))
(progn
(command "_.area" "_o" #ENT)

(setq #AA (getvar "area")
#CV (getreal "\nEnter a conversion factor: <1.0> ")
#UN (getstring T "\nEnter the type of units: ")
#PT (getpoint "\nSpecify start point of text: "))
(if (not #CV)
(setq #CV 1.0))
(if (/= #UN "")
(setq #TXT (strcat (rtos (* #AA #CV)) " " #UN))
(setq #TXT (rtos (* #AA #CV))))

(entmake (list (cons 0 "TEXT")
(cons 10 #PT)
(cons 40 (getvar "TEXTSize"))
(cons 1 #TXT))))))

(setq *error* #OLDERR)
(setvar "cmdecho" #ECHO)

(princ))



(princ "\n\nType AC to start.")

(princ)

 

[kpetursson]

you could try...
change
#UN (getstring T "\nEnter the type of units: ")
to
#UN (getstring T "\nEnter the type of units: <SQ.FT.> ")

and after
(setq #CV 1.0))
add
(if (= #UN "")
(setq #UN "SQ.FT."))

that should do it.

Kevin Petursson
--
"Everyone says quotable things everyday, but their not famous... so nobody cares."... Some Person

 

[vbcad]

THANKS. THAT WORKS WELL. THERE IS A LOT OF STUFF IN THE CODE THAT I WOULD LIKE TO TAKE OUT. I DO NOT NEED TO KNOW CONVERSION FACTOR OR TYPE OF UNITS ETC AS EVERYTHING IS IN SQUARE FEET. I ALSO WOULD LIKE TO USE A DEFAULT TEXT STYLE AND SIZE. THIS ALWAYS PUTS THE TEXT AS THE "STANDARD" TEXT STYLE. THIS WOULD HELP ELIMINATE SOME CLICKS. HERE IS THE CODE AS IT STANDS NOW.

(defun C:AC (/ #ENT #AA #CV #UN #PT #TXT #ECHO #OLDERR @NEWERR)
(command "-units" "2" "0" "1" "0" "0" "y")
(defun @NEWERR (%A)
(setq *error* #OLDERR)
(setvar "cmdecho" #ECHO)
(cond
((= %A "Function cancelled") nil)
(T (princ (strcat "\nerror: " %A ":\n"))))
(princ))

(setq #OLDERR *error*)
(setq #ECHO (getvar "cmdecho"))

(setq *error* @NEWERR)
(setvar "cmdecho" 0)
(setq #ENT (car (entsel "\nPick an object for an area: ")))

(if #ENT
(if (member (cdr (assoc 0 (entget #ENT)))
(list "ELLIPSE" "CIRCLE" "LWPOLYLINE" "POLYLINE" "REGION"))
(progn
(command "_.area" "_o" #ENT)

(setq #AA (getvar "area")
#CV (getreal "\nEnter a conversion factor: <1.0> ")
#UN (getstring T "\nEnter the type of units: <SQ FT> ")
#PT (getpoint "\nSpecify start point of text: "))
(if (not #CV)
(setq #CV 1.0))
(if (= #UN "")
(setq #UN "SQ FT"))
(if (/= #UN "")
(setq #TXT (strcat (rtos (* #AA #CV)) " " #UN))
(setq #TXT (rtos (* #AA #CV))))

(entmake (list (cons 0 "TEXT")
(cons 10 #PT)
(cons 40 (getvar "TEXTSize"))
(cons 1 #TXT))))))

(setq *error* #OLDERR)
(setvar "cmdecho" #ECHO)

(princ))


(princ "\n\nType AC to start.")
(princ)

 

[CarlAK]

Here's my shot at your requested revisions. Comments in caps. You could delete the "commented out" lines:
======================================================

(defun C:AC (/ #ENT #AA #CV #UN #PT #TXT #ECHO #OLDERR @NEWERR)
;;(command "-units" "2" "0" "1" "0" "0" "y"):EL UNITS RESET, AREA DECIMALS SET BY RTOS
(defun @NEWERR (%A)
(setq *error* #OLDERR)
(setvar "cmdecho" #ECHO)
(cond
((= %A "Function cancelled") nil)
(T (princ (strcat "\nerror: " %A ":\n"))))
(princ))

(setq #OLDERR *error*)
(setq #ECHO (getvar "cmdecho"))

(setq *error* @NEWERR)
(setvar "cmdecho" 0)
(setq #ENT (car (entsel "\nPick an object for an area: ")))

(if #ENT
(if (member (cdr (assoc 0 (entget #ENT)))
(list "ELLIPSE" "CIRCLE" "LWPOLYLINE" "POLYLINE" "REGION"))
(progn
(command "_.area" "_o" #ENT)

(setq #AA (getvar "area")
;;#CV (getreal "\nEnter a conversion factor: <1.0> ");;DELETED-NOT NEEDED
;;#UN (getstring T "\nEnter the type of units: <SQ FT> ");;DELETED
#PT (getpoint "\nSpecify start point of text: "))
;;(if (not #CV);;DEL 7 LINES
;; (setq #CV 1.0))
;;(if (= #UN "")
;; (setq #UN "SQ FT"))
;;;(if (/= #UN "")
;;; (setq #TXT (strcat (rtos (* #AA #CV)) " " #UN))
;;; (setq #TXT (rtos (* #AA #CV))))
(setq #TXT (strcat (rtos #AA 2 2) " SQ FT"));;ADDED- ALWAYS SQ FT
(entmake (list (cons 0 "TEXT")
(cons 7 (getvar "TEXTSTYLE"));;ADDED-CURR STYLE
(cons 10 #PT)
(cons 40 (getvar "TEXTSize"))
(cons 1 #TXT))))))

(setq *error* #OLDERR)
(setvar "cmdecho" #ECHO)

(princ))


(princ "\n\nType AC to start.")
(princ)

 

[vbcad]

THANKS BELOW IS THE CODE SO FAR. IT WORKS ALMOST PERFECT. I ADDED A DIVISION FACTOR OF 144 SO THE TEXT WOULD BE IN TRUE SQ FT. THE ONLY PROBLEM IS NOW THE TEXT IS DISPLAYED WITH THE PROPER TEXTSTYLE BUT THE OBLIQUE ANGLE OF THE TEXT IS ZERO AND NOT TEN. THE TEXT STYLE SHOWS THE ANGLE AS TEN. I CAN'T SEEM TO FIND A REASON WHY IT WILL NOT RETRIEVE THIS PART OF THE STYLE.

(defun C:AC (/ #ENT #AA #CV #UN #PT #TXT #ECHO #OLDERR @NEWERR)
(defun @NEWERR (%A)
(setq *error* #OLDERR)
(setvar "cmdecho" #ECHO)
(cond
((= %A "Function cancelled") nil)
(T (princ (strcat "\nerror: " %A ":\n"))))
(princ))

(setq #OLDERR *error*)
(setq #ECHO (getvar "cmdecho"))

(setq *error* @NEWERR)
(setvar "cmdecho" 0)
(setq #ENT (car (entsel "\nPick an object for an area: ")))

(if #ENT
(if (member (cdr (assoc 0 (entget #ENT)))
(list "ELLIPSE" "CIRCLE" "LWPOLYLINE" "POLYLINE" "REGION"))
(progn
(command "_.area" "_o" #ENT)

(setq #AA (getvar "area")
#PT (getpoint "\nSpecify start point of text: "))
(setq #TXT (strcat (rtos (/ #AA 144) 2 0) " SF"));;ADDED- ALWAYS SQ FT
(entmake (list (cons 0 "TEXT")
(cons 7 (getvar "TEXTSTYLE"));;ADDED-CURR STYLE
(cons 10 #PT)
(cons 40 (getvar "TEXTSize"))
(cons 1 #TXT))))))

(setq *error* #OLDERR)
(setvar "cmdecho" #ECHO)

(princ))

(princ "\n\nType AC to start.")
(princ)

 

[CarlAK]

It looks like the "oblique angle" is Group Code 51.
You have a few options.

1. Instead of 'entmake" use (command "text" etc......) - Uses current style. This gets around ahaving to code in obliquing, width, alignment, ......
2. get the current oblique angle with (setq ObAng (cdr (assoc 50 (Tblsearch "style" (getvar "textstyle")));;50 vs 51 in style table. Then in entmake add (cons 51 ObAng))

 

[vbcad]

THANKS YOU VERY MUCH. I CODED IN THE GROUP CODES FOR WIDTH AND HEIGHT TO ELIMINATE THE TEXTSIZE VARIABLE TO RETRIEVE ALL OF THE DATA FROM THE TEXT STYLE.

 

[vbcad]

Below is the final code. i added some coding to retrieve the old text style. change it then set it back to the old style to make it more user friendly.

(defun C:AC (/ #ENT #AA #CV #UN #PT #TXT #ECHO #OLDERR @NEWERR)
(defun @NEWERR (%A)
(setq *error* #OLDERR)
(setvar "cmdecho" #ECHO)
(cond
((= %A "Function cancelled") nil)
(T (princ (strcat "\nerror: " %A ":\n"))))
(princ))

(setq #OLDERR *error*)
(setq #ECHO (getvar "cmdecho"))

(setq *error* @NEWERR)
(setvar "cmdecho" 0)
(setq #ENT (car (entsel "\nPick an object for an area: ")))
(setq oldstyle (getvar "textstyle"));RETRIEVES OLD TEXT STYLE
(COMMAND "STYLE" "NOTES" "ROMANS.SHX" "9.0" "0.85" "10" "N" "N" "N");SETS NEW TEXT STYLE
(if #ENT
(if (member (cdr (assoc 0 (entget #ENT)))
(list "ELLIPSE" "CIRCLE" "LWPOLYLINE" "POLYLINE" "REGION"))
(progn
(command "_.area" "_o" #ENT)

(setq #AA (getvar "area")
#PT (getpoint "\nSpecify start point of text: "))
(setq #TXT (strcat (rtos (/ #AA 144) 2 0) " SF"));;ADDED- ALWAYS SQ FT
(setq ObAng (cdr (assoc 50 (Tblsearch "style" (getvar "textstyle")))))
(setq ObWID (cdr (assoc 41 (Tblsearch "style" (getvar "textstyle")))))
(setq ObHT (cdr (assoc 40 (Tblsearch "style" (getvar "textstyle")))))
(entmake (list (cons 0 "TEXT")
(cons 7 (getvar "TEXTSTYLE"));;ADDED-CURR STYLE
(cons 10 #PT)
(cons 51 ObAng)
(cons 41 ObWID)
(cons 40 OBHT)
(cons 1 #TXT))))))
(SETVAR "TEXTSTYLE" OLDSTYLE)
(setq *error* #OLDERR)
(setvar "cmdecho" #ECHO)

(princ))

(princ "\n\nType AC to start.")
(princ)