Lisp »Tips 'n Tricks »Area perimetro e vertici di un poligono

Ecco un lisp che chiede di selezionare un lato di un poligono e ne calcola l'area, il perimetro e i vertici.
Limiti: non funziona se i lati del poligono sono stati disegnati con il comando OFFSET.

;--------------------------------------------;
; Programma  : AREAL.LSP                     ;
; Autore     : Claudio Piccini               ;
; Data       : 20 Febbraio 1996              ;
; Funzione   : c:areal                       ;
;--------------------------------------------;

(defun C:AREAL (/ k s1 cod1 cod2 cod3 
  ent1 ent2 ent3
  l1 l2 l3 l4 l5 l6
  p1 p2 p3 p4
  lp pc pcf pf ang0 ang1 ang2
  kk areat areap perimp perimt 
  pp1 pp2 p1x p1y p2x p2y
 )
 (command "osnap" "_nea")
 (setq s1 (entsel "\n Seleziona un lato del poligono:"))
 (command "osnap" "_non")
 (if (= s1 nil)
  (progn
   (princ "\n Non e' stato selezionato il lato.")
  )
  (progn
   (setq cod1 (car s1))
   (setq ent1 (entget cod1))
   (setq l1 (assoc 10 ent1))
   (setq l2 (assoc 11 ent1))
   (setq pc (cdr l1))
   (setq pcf pc)
   (setq pf (cdr l2))
   (setq ang0 (angle pc pf))
   (setq lp (list pc))
   (setq k 1)
   (while (/= k nil)
    (setq pc1 
     (list 
      (- (car pc) 0.001)
      (+ (cadr pc) 0.001)
     )
    )
    (setq pc2 
     (list 
      (+ (car pc) 0.001)
      (- (cadr pc) 0.001)
     )
    )
    (setq s2 (ssget "_C" pc1 pc2))
    (setq cod2 (ssname s2 0))
    (setq cod3 (ssname s2 1))
    (setq ent2 (entget cod2))
    (setq l3 (assoc 10 ent2))
    (setq l4 (assoc 11 ent2))
    (setq p1 (cdr l3))
    (setq p2 (cdr l4))
    (setq ang1 (angle p1 p2))
    (setq ent3 (entget cod3))
    (setq l5 (assoc 10 ent3))
    (setq l6 (assoc 11 ent3))
    (setq p3 (cdr l5))
    (setq p4 (cdr l6))
    (setq ang2 (angle p3 p4))
    (if (= ang0 ang1)
     (progn
      (setq ang0 ang2)
      (if (= p3 pc)
       (setq pc p4)
       (setq pc p3)
      )
     )
     (progn
      (setq ang0 ang1)
      (if (= p1 pc)
       (setq pc p2)
       (setq pc p1)
      )
     )
    )
    (if 
     (and 
      (= (car pf)(car pc))
      (= (cadr pf)(cadr pc))
     )
     (progn
      (setq k nil)
      (setq lp (append lp (list pc)))
     )
     (setq lp (append lp (list pc)))
    )
   )
   (setq lp (append lp (list pcf)))
   (setq lung (- (length lp) 1))
   ;calcola il perimetro
   (setq perimp 0)
   (setq perimt 0)
   (setq kk 0)
   (if (/= lp nil)
    (progn
     (while (< kk lung)
      (setq pp1 (nth kk lp))
      (setq pp2 (nth (+ kk 1) lp))
      (setq perimp (distance pp1 pp2))
      (setq perimt (+ perimt perimp))
      (setq kk (+ 1 kk))
     )
    )
   )
   ;calcola l'area
   (setq areat 0)
   (setq areap 0)
   (setq kk 0)
   (if (/= lp nil)
    (progn
     (while (< kk lung)
      (setq p1x (car (nth kk lp)))
      (setq p1y (cadr (nth kk lp)))
      (setq p2x (car (nth (+ kk 1) lp)))
      (setq p2y (cadr (nth (+ kk 1) lp)))
      (setq areap (/ (* (- p1x p2x)(+ p1y p2y)) 2))
      (setq areat (+ areat areap))
      (setq kk (+ 1 kk))
     )
     (princ "\n Area: ")
     (princ (abs areat))
     (princ "  Perimetro: ")
     (princ perimt)
     (princ "  Vertici: ")
     (princ lung)
    )
   )
  )
 )
)
; eof

Lisp »Tips 'n Tricks