LISP to calculate length and width of shape

Is there a way to calculate the length and width of a shape using LISP? For example, getting the length and width of a room that is drawn on a floor plan.

Thanks

It should be possible, is the room constructed using polylines?

yes it is constructed using polylines

Quick and dirty:

(defun c:lenwid    (/ ent nlist d1 d2)
   (if    (and
       (setq ent (car (entsel "\nSelect Object: ")))
       (= "LWPOLYLINE" (cdr (assoc 0 (entget ent))))
   ) ;_  end and
   (progn
       (foreach x (entget ent)
       (if (eq 10 (car x))
           (setq nlist (cons (cdr x) nlist))
       ) ;_  end if
       ) ;_  end foreach
       (setq nlist (reverse nlist))
       (setq d1 (distance (nth 0 nlist)
                  (nth 1 nlist)
            ) ;_  end distance
         d2 (distance (nth 1 nlist)
                  (nth 2 nlist)
            ) ;_  end distance
       ) ;_  end setq
       (if    (> d1 d2)
       (princ (strcat "\nLength of Room = "
                  (rtos d1 2 2)
                  "\tWidth of Room = "
                  (rtos d2 2 2)
              ) ;_  end strcat
       ) ;_  end princ
       (princ (strcat "\nLength of Room = "
                  (rtos d2 2 2)
                  "\tWidth of Room = "
                  (rtos d1 2 2)
              ) ;_  end strcat
       ) ;_  end princ
       ) ;_  end if
   ) ;_  end progn
   (princ "\n<!> No Object Selected or Object is not Polyline! <!>")
   ) ;_  end if
   (princ)
) ;_  end defun

How will this work on rooms that are not rectangles?

Also, can it be shown on screen inside the shape instead of in the command line?

How will this work on rooms that are not rectangles?

I said it was quick and dirty

Just typed it quickly to get you by.

I will have a look

Haha sorry bout that.

Thanks for your help. i greatly appreciate it.

This puts text in the drawing:

(defun c:lenwid    (/ ent pt nlist d1 d2 len)

   (defun makelay (x)
   (if (not (tblsearch "Layer" x))
       (progn
       (setvar "cmdecho" 0)
       (command "-layer" "m" x "")
       (setvar "cmdecho" 1)
       ) ;_  end progn
   ) ;_  end if
   ) ;_  end defun
   (makelay "TEXT")

   (defun Make_Text (txt_pt txt_val)
   (entmake
       (list '(0 . "TEXT")
         '(8 . "TEXT")
         (cons 10 txt_pt)
         (cons 40 (max 2.5 (getvar "TEXTSIZE")))
         (cons 1 txt_val)
         '(50 . 0.0)
         '(7 . "STANDARD")
         '(71 . 0)
         '(72 . 1)
         '(73 . 2)
         (cons 11 txt_pt)
       ) ; end list
   ) ; end entmake
   ) ;_  end defun

   (if    (and
       (setq ent (car (entsel "\nSelect Object > ")))
       (= "LWPOLYLINE" (cdr (assoc 0 (entget ent))))
       (setq pt (getpoint "\nSelect Point for Text > "))
   ) ;_  end and
   (progn
       (foreach x (entget ent)
       (if (eq 10 (car x))
           (setq nlist (cons (cdr x) nlist))
       ) ;_  end if
       ) ;_  end foreach
       (setq nlist (reverse nlist))
       (setq d1 (distance (nth 0 nlist)
                  (nth 1 nlist)
            ) ;_  end distance
         d2 (distance (nth 1 nlist)
                  (nth 2 nlist)
            ) ;_  end distance
       ) ;_  end setq
       (if    (> d1 d2)
       (setq len (strcat "Length of Room = "
                 (rtos d1 2 2)
                 ",  Width of Room = "
                 (rtos d2 2 2)
             ) ;_  end strcat
       ) ;_  end setq
       (setq len (strcat "Length of Room = "
                 (rtos d2 2 2)
                 ",  Width of Room = "
                 (rtos d1 2 2)
             ) ;_  end strcat
       ) ;_  end setq
       ) ;_  end if
       (Make_Text pt len)
   ) ;_  end progn
   (princ "\n<!> No Object Selected or Object is not Polyline! <!>")
   ) ;_  end if
   (princ)
) ;_  end defun

Haha sorry bout that.

 

Thanks for your help. i greatly appreciate it.

No probs, I understand what you're getting at - I wasn't satisfied with the LISP either.

That worked great, but for shapes that are not straight rectangles, couldnt the lisp be written to subtract the min x value from the max x value to get the length and the same for the width by substituting y for x?

on a side note, where do you learn how to write these?

Haha, wrote this as you replied

(defun c:lenwid    (/ ent pt nlist xlist ylist xmax xmin ymax ymin xlen ylen len)

   (defun makelay (x)
   (if (not (tblsearch "Layer" x))
       (progn
       (setvar "cmdecho" 0)
       (command "-layer" "m" x "")
       (setvar "cmdecho" 1)
       ) ;_  end progn
   ) ;_  end if
   ) ;_  end defun
   (makelay "TEXT")

   (defun Make_Text (txt_pt txt_val)
   (entmake
       (list '(0 . "TEXT")
         '(8 . "TEXT")
         (cons 10 txt_pt)
         (cons 40 (max 2.5 (getvar "TEXTSIZE")))
         (cons 1 txt_val)
         '(50 . 0.0)
         '(7 . "STANDARD")
         '(71 . 0)
         '(72 . 1)
         '(73 . 2)
         (cons 11 txt_pt)
       ) ; end list
   ) ; end entmake
   ) ;_  end defun

   (if    (and
       (setq ent (car (entsel "\nSelect Object > ")))
       (= "LWPOLYLINE" (cdr (assoc 0 (entget ent))))
       (setq pt (getpoint "\nSelect Point for Text > "))
   ) ;_  end and
   (progn
       (foreach x (entget ent)
       (if (eq 10 (car x))
           (setq nlist (cons (cdr x) nlist))
       ) ;_  end if
       ) ;_  end foreach
       (setq nlist (reverse nlist))
       (foreach n nlist
       (setq xlist (cons (car n) xlist)
             ylist (cons (cadr n) ylist)
       ) ;_  end setq
       ) ;_  end foreach
       (setq xmax (apply 'max xlist)
         xmin (apply 'min xlist)
         ymax (apply 'max ylist)
         ymin (apply 'min ylist)
         xlen (- xmax xmin)
         ylen (- ymax ymin)
       ) ;_  end setq
       (if    (> xlen ylen)
       (setq len (strcat "Length of Room = "
                 (rtos xlen 2 2)
                 ",  Width of Room = "
                 (rtos ylen 2 2)
             ) ;_  end strcat
       ) ;_  end setq
       (setq len (strcat "Length of Room = "
                 (rtos ylen 2 2)
                 ",  Width of Room = "
                 (rtos xlen 2 2)
             ) ;_  end strcat
       ) ;_  end setq
       ) ;_  end if
       (Make_Text pt len)
   ) ;_  end progn
   (princ "\n<!> No Object Selected or Object is not Polyline! <!>")
   ) ;_  end if
   (princ)
) ;_  end defun

Sweet!! thanks!! it worked out great

Wait, the units are in inches. how do i change it to feet?

on a side note, where do you learn how to write these?

When working at a company during a gap year before going to university, some guy showed me a LISP and what it could do, and I was interested so I looked over the LISP and tried to figure it out (a lot of trial and error!)... then I stumbled over this forum and have learnt everything I know now from the guys on here.

Wait, the units are in inches. how do i change it to feet?

Like this?

(defun c:lenwid    (/ ent pt nlist xlist ylist xmax xmin ymax ymin xlen ylen len)

   (defun makelay (x)
   (if (not (tblsearch "Layer" x))
       (progn
       (setvar "cmdecho" 0)
       (command "-layer" "m" x "")
       (setvar "cmdecho" 1)
       ) ;_  end progn
   ) ;_  end if
   ) ;_  end defun
   (makelay "TEXT")

   (defun Make_Text (txt_pt txt_val)
   (entmake
       (list '(0 . "TEXT")
         '(8 . "TEXT")
         (cons 10 txt_pt)
         (cons 40 (max 2.5 (getvar "TEXTSIZE")))
         (cons 1 txt_val)
         '(50 . 0.0)
         '(7 . "STANDARD")
         '(71 . 0)
         '(72 . 1)
         '(73 . 2)
         (cons 11 txt_pt)
       ) ; end list
   ) ; end entmake
   ) ;_  end defun

   (if    (and
       (setq ent (car (entsel "\nSelect Object > ")))
       (= "LWPOLYLINE" (cdr (assoc 0 (entget ent))))
       (setq pt (getpoint "\nSelect Point for Text > "))
   ) ;_  end and
   (progn
       (foreach x (entget ent)
       (if (eq 10 (car x))
           (setq nlist (cons (cdr x) nlist))
       ) ;_  end if
       ) ;_  end foreach
       (setq nlist (reverse nlist))
       (foreach n nlist
       (setq xlist (cons (car n) xlist)
             ylist (cons (cadr n) ylist)
       ) ;_  end setq
       ) ;_  end foreach
       (setq xmax (apply 'max xlist)
         xmin (apply 'min xlist)
         ymax (apply 'max ylist)
         ymin (apply 'min ylist)
         xlen (- xmax xmin)
         ylen (- ymax ymin)
       ) ;_  end setq
       (if    (> xlen ylen)
       (setq len (strcat "Length of Room = "
                 (rtos (/ xlen 12.0) 2 2)
                 ",  Width of Room = "
                 (rtos (/ ylen 12.0) 2 2)
             ) ;_  end strcat
       ) ;_  end setq
       (setq len (strcat "Length of Room = "
                 (rtos (/ ylen 12.0) 2 2)
                 ",  Width of Room = "
                 (rtos (/ xlen 12.0) 2 2)
             ) ;_  end strcat
       ) ;_  end setq
       ) ;_  end if
       (Make_Text pt len)
   ) ;_  end progn
   (princ "\n<!> No Object Selected or Object is not Polyline! <!>")
   ) ;_  end if
   (princ)
) ;_  end defun

May want this also (ft):

(defun c:lenwid    (/ ent pt nlist xlist ylist xmax xmin ymax ymin xlen ylen len)

   (defun makelay (x)
   (if (not (tblsearch "Layer" x))
       (progn
       (setvar "cmdecho" 0)
       (command "-layer" "m" x "")
       (setvar "cmdecho" 1)
       ) ;_  end progn
   ) ;_  end if
   ) ;_  end defun
   (makelay "TEXT")

   (defun Make_Text (txt_pt txt_val)
   (entmake
       (list '(0 . "TEXT")
         '(8 . "TEXT")
         (cons 10 txt_pt)
         (cons 40 (max 2.5 (getvar "TEXTSIZE")))
         (cons 1 txt_val)
         '(50 . 0.0)
         '(7 . "STANDARD")
         '(71 . 0)
         '(72 . 1)
         '(73 . 2)
         (cons 11 txt_pt)
       ) ; end list
   ) ; end entmake
   ) ;_  end defun

   (if    (and
       (setq ent (car (entsel "\nSelect Object > ")))
       (= "LWPOLYLINE" (cdr (assoc 0 (entget ent))))
       (setq pt (getpoint "\nSelect Point for Text > "))
   ) ;_  end and
   (progn
       (foreach x (entget ent)
       (if (eq 10 (car x))
           (setq nlist (cons (cdr x) nlist))
       ) ;_  end if
       ) ;_  end foreach
       (setq nlist (reverse nlist))
       (foreach n nlist
       (setq xlist (cons (car n) xlist)
             ylist (cons (cadr n) ylist)
       ) ;_  end setq
       ) ;_  end foreach
       (setq xmax (apply 'max xlist)
         xmin (apply 'min xlist)
         ymax (apply 'max ylist)
         ymin (apply 'min ylist)
         xlen (- xmax xmin)
         ylen (- ymax ymin)
       ) ;_  end setq
       (if    (> xlen ylen)
       (setq len (strcat "Length of Room = "
                 (rtos (/ xlen 12.0) 2 2)
                 "ft,  Width of Room = "
                 (rtos (/ ylen 12.0) 2 2)
                 "ft"
             ) ;_  end strcat
       ) ;_  end setq
       (setq len (strcat "Length of Room = "
                 (rtos (/ ylen 12.0) 2 2)
                 "ft,  Width of Room = "
                 (rtos (/ xlen 12.0) 2 2)
                 "ft"
             ) ;_  end strcat
       ) ;_  end setq
       ) ;_  end if
       (Make_Text pt len)
   ) ;_  end progn
   (princ "\n<!> No Object Selected or Object is not Polyline! <!>")
   ) ;_  end if
   (princ)
) ;_  end defun