Placing numbers, perimeters and areas via lisp routines

[Hattie]

I have a lisp routine to place mtext on a polygon for room names and their areas as below. In this routine I would like to add the perimeter to display too. I have tried many ways to work the routine unfortunately it doesn't work. Would you able to help me to display perimeters of polygones or polylines as well as their numbers and areas. Thank you very much your help.

 

;        

(defun drtxt (/ rn tx ls vl lt ht lb hb nr pt)
 (setq tx (strcat "Area: " 
      (rtos (/ (getvar "area") 1000000) 2 2) 
      " m2"
      )         
      rn (getstring "\nRoom Name: ")
 )
 (setq ls (list (cons 1 tx))
     vl (textbox ls)
     vl (cadr vl)
     lt (car vl)
     ht (cadr vl)
     vl (grread T)
     nr (car vl)
     pt (cadr vl)
 )
 (princ "\nInsert Point: ")
 (while (/= nr 3)
   (command "redraw")
   (grdraw pt (setq pt (polar pt 0 lt)) 7)
   (grdraw pt (setq pt (polar pt (* pi 0.5) ht)) 7)
   (grdraw pt (setq pt (polar pt pi lt)) 7)
   (grdraw pt (polar pt (* pi 1.5) ht) 7)
   (setq vl (grread T)
     nr (car vl)
     pt (cadr vl)
   )
   ) ;end while function
 (command "-mtext" pt "w" 0 rn tx "")
 (redraw)
) ; end drtxt function

(defun c:pla ()
 (setvar "cmdecho" 0)
 (while (setq et 
      (car 
            (entsel "\nSelect polyline: ")
        ) ;end car function
    ) ;end setq function
 (command "area" "o" et)
 (drtxt)
 ) ; wnd while funtion

(setvar "cmdecho" 1)
(princ)

) ; end c:pla function

[lpseifert]

I didn't test it but you could try this

;        

(defun drtxt (/ rn tx ls vl lt ht lb hb nr pt)
 (setq tx (strcat "Area: " 
      (rtos (/ (getvar "area") 1000000) 2 2) 
      " m2"
      )         
      rn (getstring "\nRoom Name: ")
   [color=Red]per (strcat "Perimeter: " (rtos (/ (getvar "perimeter") 1000) 2 2) " m")[/color]
 )
 (setq ls (list (cons 1 tx))
     vl (textbox ls)
     vl (cadr vl)
     lt (car vl)
     ht (cadr vl)
     vl (grread T)
     nr (car vl)
     pt (cadr vl)
 )
 (princ "\nInsert Point: ")
 (while (/= nr 3)
   (command "redraw")
   (grdraw pt (setq pt (polar pt 0 lt)) 7)
   (grdraw pt (setq pt (polar pt (* pi 0.5) ht)) 7)
   (grdraw pt (setq pt (polar pt pi lt)) 7)
   (grdraw pt (polar pt (* pi 1.5) ht) 7)
   (setq vl (grread T)
     nr (car vl)
     pt (cadr vl)
   )
   ) ;end while function
 (command "-mtext" pt "w" 0 rn tx[color=Red] per[/color] "")
 (redraw)
) ; end drtxt function

(defun c:pla ()
 (setvar "cmdecho" 0)
 (while (setq et 
      (car 
            (entsel "\nSelect polyline: ")
        ) ;end car function
    ) ;end setq function
 (command "area" "o" et)
 (drtxt)
 ) ; wnd while funtion

(setvar "cmdecho" 1)
(princ)

) ; end c:pla function

[rkmcswain]

Here is one way.

 

(defun drtxt (ar px rn / ls vl lt ht lb hb nr pt pr tx)
;;;  (setq tx (strcat "Area: " 
;;;       (rtos (/ (getvar "area") 1000000) 2 2) 
;;;       " m2"
;;;       )         
;;;       rn (getstring "\nRoom Name: ")
;;;       	
;;;
;;;  )
 (setq tx (strcat (rtos (/ ar 1000000.0) 2 2) " m2")
pr (strcat "P= " (rtos px 2 2))
ls (list (cons 1 tx))
       vl (textbox ls)
       vl (cadr vl)
       lt (car vl)
       ht (cadr vl)
       vl (grread T)
       nr (car vl)
       pt (cadr vl)
 )
 (princ "\nInsert Point: ")
 (while (/= nr 3)
   (command "redraw")
   (grdraw pt (setq pt (polar pt 0 lt)) 7)
   (grdraw pt (setq pt (polar pt (* pi 0.5) ht)) 7)
   (grdraw pt (setq pt (polar pt pi lt)) 7)
   (grdraw pt (polar pt (* pi 1.5) ht) 7)
   (setq vl (grread T)
     nr (car vl)
     pt (cadr vl)
   )
   ) ;end while function
 (command "-mtext" pt "w" 0 rn tx pr "")
 (redraw)
) ; end drtxt function

(defun c:pla ( / et obj ar px rn)
 (vl-load-com)
 (setvar "cmdecho" 0)
 (while (setq et 
      (car 
            (entsel "\nSelect polyline: ")
        ) ;end car function
    ) ;end setq function
 (setq obj (vlax-ename->vla-object et))
 (setq ar (vla-get-Area obj))
 (setq px (vla-get-Length obj))
 (setq rn (getstring "\nRoom Name: "))
 
 ;(command "area" "o" et)
 (drtxt ar px rn)
 ) ; wnd while funtion

(setvar "cmdecho" 1)
(princ)

)

[Hattie]

Thank you very much it works perfectly! Now I know where did I do wrong. I need to work harder to learn.

 

 

 

 

I didn't test it but you could try this

;        

(defun drtxt (/ rn tx ls vl lt ht lb hb nr pt)
 (setq tx (strcat "Area: " 
      (rtos (/ (getvar "area") 1000000) 2 2) 
      " m2"
      )         
      rn (getstring "\nRoom Name: ")
   [color=Red]per (strcat "Perimeter: " (rtos (/ (getvar "perimeter") 1000) 2 2) " m")[/color]
 )
 (setq ls (list (cons 1 tx))
     vl (textbox ls)
     vl (cadr vl)
     lt (car vl)
     ht (cadr vl)
     vl (grread T)
     nr (car vl)
     pt (cadr vl)
 )
 (princ "\nInsert Point: ")
 (while (/= nr 3)
   (command "redraw")
   (grdraw pt (setq pt (polar pt 0 lt)) 7)
   (grdraw pt (setq pt (polar pt (* pi 0.5) ht)) 7)
   (grdraw pt (setq pt (polar pt pi lt)) 7)
   (grdraw pt (polar pt (* pi 1.5) ht) 7)
   (setq vl (grread T)
     nr (car vl)
     pt (cadr vl)
   )
   ) ;end while function
 (command "-mtext" pt "w" 0 rn tx[color=Red] per[/color] "")
 (redraw)
) ; end drtxt function

(defun c:pla ()
 (setvar "cmdecho" 0)
 (while (setq et 
      (car 
            (entsel "\nSelect polyline: ")
        ) ;end car function
    ) ;end setq function
 (command "area" "o" et)
 (drtxt)
 ) ; wnd while funtion

(setvar "cmdecho" 1)
(princ)

) ; end c:pla function

[Hattie]

Thank you very much it works perfectly! Now I know where did I do wrong. I need to work harder to learn.

 

 

Here is one way.

 

(defun drtxt (ar px rn / ls vl lt ht lb hb nr pt pr tx)
;;;  (setq tx (strcat "Area: " 
;;;       (rtos (/ (getvar "area") 1000000) 2 2) 
;;;       " m2"
;;;       )         
;;;       rn (getstring "\nRoom Name: ")
;;;           
;;;
;;;  )
 (setq tx (strcat (rtos (/ ar 1000000.0) 2 2) " m2")
   pr (strcat "P= " (rtos px 2 2))
   ls (list (cons 1 tx))
       vl (textbox ls)
       vl (cadr vl)
       lt (car vl)
       ht (cadr vl)
       vl (grread T)
       nr (car vl)
       pt (cadr vl)
 )
 (princ "\nInsert Point: ")
 (while (/= nr 3)
   (command "redraw")
   (grdraw pt (setq pt (polar pt 0 lt)) 7)
   (grdraw pt (setq pt (polar pt (* pi 0.5) ht)) 7)
   (grdraw pt (setq pt (polar pt pi lt)) 7)
   (grdraw pt (polar pt (* pi 1.5) ht) 7)
   (setq vl (grread T)
     nr (car vl)
     pt (cadr vl)
   )
   ) ;end while function
 (command "-mtext" pt "w" 0 rn tx pr "")
 (redraw)
) ; end drtxt function

(defun c:pla ( / et obj ar px rn)
 (vl-load-com)
 (setvar "cmdecho" 0)
 (while (setq et 
      (car 
            (entsel "\nSelect polyline: ")
        ) ;end car function
    ) ;end setq function
 (setq obj (vlax-ename->vla-object et))
 (setq ar (vla-get-Area obj))
 (setq px (vla-get-Length obj))
 (setq rn (getstring "\nRoom Name: "))
 
 ;(command "area" "o" et)
 (drtxt ar px rn)
 ) ; wnd while funtion

(setvar "cmdecho" 1)
(princ)

)

[Hattie]

I tried your routine first everything worked well. Thank you very much

 

 

I didn't test it but you could try this

;        

(defun drtxt (/ rn tx ls vl lt ht lb hb nr pt)
 (setq tx (strcat "Area: " 
      (rtos (/ (getvar "area") 1000000) 2 2) 
      " m2"
      )         
      rn (getstring "\nRoom Name: ")
   [color=Red]per (strcat "Perimeter: " (rtos (/ (getvar "perimeter") 1000) 2 2) " m")[/color]
 )
 (setq ls (list (cons 1 tx))
     vl (textbox ls)
     vl (cadr vl)
     lt (car vl)
     ht (cadr vl)
     vl (grread T)
     nr (car vl)
     pt (cadr vl)
 )
 (princ "\nInsert Point: ")
 (while (/= nr 3)
   (command "redraw")
   (grdraw pt (setq pt (polar pt 0 lt)) 7)
   (grdraw pt (setq pt (polar pt (* pi 0.5) ht)) 7)
   (grdraw pt (setq pt (polar pt pi lt)) 7)
   (grdraw pt (polar pt (* pi 1.5) ht) 7)
   (setq vl (grread T)
     nr (car vl)
     pt (cadr vl)
   )
   ) ;end while function
 (command "-mtext" pt "w" 0 rn tx[color=Red] per[/color] "")
 (redraw)
) ; end drtxt function

(defun c:pla ()
 (setvar "cmdecho" 0)
 (while (setq et 
      (car 
            (entsel "\nSelect polyline: ")
        ) ;end car function
    ) ;end setq function
 (command "area" "o" et)
 (drtxt)
 ) ; wnd while funtion

(setvar "cmdecho" 1)
(princ)

) ; end c:pla function

[Hattie]

i have been trying to reply your message but my messages go to the different replies. I tried yours at first and worked perfectly. Thanks again