AfraLisp Blog

The AutoLisp/Visual Lisp/VBA Resource Website

AfraLisp Blog

Home Newsletter Utter Rubbish Coding Tips AutoCAD Tips Contact Downloads WAUN

Home.

Page I.

Working With Areas (Cont.)

Nice to see you back and glad that you could make it.
Where were we? Oh yes. We were going to try and make AutoCAD determine the area to be calculated. Let's see! We could try bribes! We could threaten!
Naaw, back to the keyboard.......

;;;M2 Lisp - Version 1.0 - 17th October 2001
;;;=============================================================
;;;This function will calculate an irregular area (m2)
;;;using boundary detection. The user then has the
;;;option of placing a text label into the drawing using
;;;the current text style/height at a user defined
;;;insertion point.
;;;=============================================================
;;;Written by Kenny Ramage October 2001
;;;=============================================================
;;;=============================================================
;;;Define Main Function
;;;=============================================================

(defun C:M2A ( / os oom laag oec oudosmode p q opp opp1 oppm
		 oppma oppmat tekst pos pos2 flag1 antw lw a b)

   (setvar "cmdecho" 0)

   (command "undo" "m")

   (setq oom (getvar "orthomode")
         laag (getvar "clayer")
	 oudosmode (getvar "osmode")
         olderr *error*
         *error* opperr
   );setq

   (setvar "orthomode" 0)
   (print)
   (prompt "\nIrregular Area Lisp V-1.0 Written by Kenny Ramage
	     - kramage@mweb.com.na")
    
	(setq opp 0.0)

	(command "Layer" "m" "2" "")

	(while

	(setq a (getpoint "\nSelect Internal Point: "))

	(command "-Boundary" a "")

	(setq b (entlast))

	(redraw b 1)

   	(command "area" "O" "L")

   	(setq opp1 (getvar "area"))

	(setq opp (+ opp opp1))

	;(redraw b 4)

	);while


   (setq oppm (/ opp 1000000.0)
         oppma (rtos oppm 2 3)
         oppmat (strcat oppma "m")
         tekst (strcat "\nArea = " oppmat "2")
   );setq

   (command "layer" "m" laag "")

   (prompt tekst)

   (setq flag1 T)

   (while flag1
   
   (setq antw (getstring "\nInsert Area Label? [y/n]  : "))

   (setq antw (strcase antw))

   (if (or (= antw "Y")(= antw ""))

       (progn
             (if (not (tblsearch "layer" "4"))
                 (command "layer" "m" "4" "c" "4" "4" "")
                 (command "layer" "t" "4" "on" "4" "u" "4" "s" "4" "")
             );if

             (setvar "osmode" 0)
             (setq pos (getpoint "\nInsertion Point : "))

             (if (= (cdr (assoc 40 (tblsearch "style"
		 (getvar "textstyle")))) 0)
                 (command "text" "j" "c" pos "" "0" oppmat)
                 (command "text" "j" "c" pos "0" oppmat)
             );if

             (setq pos2 (cadr (textbox (entget (entlast))))
                   pos2 (list (+ (car pos)(/ (car pos2) 2.0))
			(+ (cadr pos)(cadr pos2)))
             );setq

             (if (= (cdr (assoc 40 (tblsearch "style" 
		(getvar "textstyle")))) 0)
                 (command "text" "j" "tl" pos2 "" "0" "2")
                 (command "text" "j" "tl" pos2 "0" "2")
             );if

             (command "scale" "l" "" pos2 ".5")

       );progn

   );if

	(if (or (or (= antw "Y")(= antw "N")(= antw "")))
		
		(setq flag1 nil)
	);if

   );while


;;;========================================================
;;;Reset System Variables and Restore Error Handler
;;;=======================================================
   (setq *error* olderror)
   (command "layer" "m" laag "")
   (setvar "osmode" oudosmode)
   (setvar "orthomode" oom)

   (princ)
);defun C:M2A
;;;========================================================
;;;Define Error Trap
;;;========================================================

(defun opperr (s)

      (if (/= s "Function cancelled") 
          (princ (strcat "\nError: " s))
      );if

      (setq *error* olderr)
      (setvar "osmode" oudosmode)
      (setvar "orthomode" oom)
      (command "undo" "b"
               "layer" "m" laag ""
               "redrawall"
      );command

);defun opperr
;;;========================================================
(princ)
;;;End Area Lisp
;;;=======================================================
;;;=======================================================
    
This time, select a point within the area that you would like to calculate. A boundary box will be drawn around the area you have chosen. You can add to the area if you wish by selecting more points resulting in an accumulation of areas. Again, you have the option of a label being added.

Would you like the source coding for both of these applications?
Go on, I bet you do? O.K. then, position you mouse here and go for it.

 
The AutoLisp/Visual Lisp/VBA Resource Website

Copyright © 1999-Perpetuity by AfraLisp

All rights reserved.
Information in this document is subject to change without notice.
Site created and maintained by Kenny Ramage

The AutoLisp/Visual Lisp/VBA Resource Website