Hola, buenas tardes.
Estoy trabajando en una rutina lisp que dibuje una tabla con las áreas y perímetros de polilineas cerradas, he desarrollado la rutina pero algo me esta faltando que no me saca los datos en orden, lo que quiero es que me las ordene en función a la elevación de cada contorno (de menor a mayor)
En la figura que adjunto se muestra como dibuja la tabla.
Adjunto la rutina para que la vean y si la pueden corregir, también sería de utilidad para otros miembros del foro.
(defun c:apol()
;;;modo seleccion
(initget "Grupo Individual")
(setq resp (getkword "\nSeleccionar en [G]rupo/ [I]ndividual (Grupo): "))
(if (= resp nil)(setq resp "Grupo"))
(setq htext (getint "\ntamaño de texto [10]:"))
(if (= htext nil)(setq htext 10))
(setq pto_ubic (getpoint "\nUbicación de tabla"))
(setq osdata (getvar "osmode"))
(setvar "osmode" 0)
(if (= resp "Grupo")
(sel_gru)
(sel_ind)
)
(dibuja_tabla)
(setvar "osmode" osdata)
)
(defun sel_ind()
(setq gentidades (entsel "Seleccionar polilinea a evaluar"))
(setq lista (entget (car gentidades)))
(setq long (length lista))
(setq n 0)
(setq lista_coor nil)
(repeat long
(if (= (car (nth n lista)) 10)
(if (= (length lista_coor) 0)
(setq lista_coor (list(nth n lista)))
(setq lista_coor (append lista_coor (list(nth n lista))))
)
)
(setq n (+ n 1))
)
(setq n 0)
(setq perimetro 0)
(setq area_pos 0)
(setq area_neg 0)
(repeat (- (length lista_coor) 1)
(setq perimetro
(+ perimetro
(sqrt(+
(expt (- (cadr (nth n lista_coor)) (cadr (nth (+ n 1) lista_coor))) 2)
(expt (- (caddr (nth n lista_coor)) (caddr (nth (+ n 1) lista_coor))) 2)
))))
(setq area_pos (+ area_pos (* (cadr (nth n lista_coor))(caddr (nth (+ n 1) lista_coor)))))
(setq area_neg (+ area_neg (* (caddr (nth n lista_coor))(cadr (nth (+ n 1) lista_coor)))))
(setq n (+ n 1))
)
;;;;completar el perimetro y area
(setq perimetro
(+ perimetro
(sqrt(+
(expt (- (cadr (nth 0 lista_coor)) (cadr (nth n lista_coor))) 2)
(expt (- (caddr (nth 0 lista_coor)) (caddr (nth n lista_coor))) 2)
))))
(setq area_pos (+ area_pos (* (cadr (nth n lista_coor))(caddr (nth 0 lista_coor)))))
(setq area_neg (+ area_neg (* (caddr (nth n lista_coor))(cadr (nth 0 lista_coor)))))
(setq area (/(- area_pos area_neg) 2)
)
(setq lista_areas (list area))
(setq lista_cotas (list cota))
(setq lista_perimetros (list perimetro))
)
(defun sel_gru()
(setq gentidades (ssget))
(setq rep1 (sslength gentidades))
(setq n1 0)
(setq lista_perimetros nil)
(setq lista_areas nil)
(setq lista_cotas nil)
(repeat rep1
(setq entidad (entget(ssname gentidades n1) ))
(setq lista_coor nil)
(setq n 0)
(setq cota (cdr (assoc 38 entidad)))
(repeat (length entidad)
(if (= (car (nth n entidad)) 10)
(if (= (length lista_coor) 0)
(setq lista_coor (list(nth n entidad)))
(setq lista_coor (append lista_coor (list(nth n entidad))))))
(setq n (+ n 1))(nth n entidad)
)
(setq n 0)
(setq perimetro 0)
(setq area_pos 0)
(setq area_neg 0)
(repeat (- (length lista_coor) 1)
(setq perimetro
(+ perimetro
(sqrt(+
(expt (- (cadr (nth n lista_coor)) (cadr (nth (+ n 1) lista_coor))) 2)
(expt (- (caddr (nth n lista_coor)) (caddr (nth (+ n 1) lista_coor))) 2)
))))
(setq area_pos (+ area_pos (* (cadr (nth n lista_coor))(caddr (nth (+ n 1) lista_coor)))))
(setq area_neg (+ area_neg (* (caddr (nth n lista_coor))(cadr (nth (+ n 1) lista_coor)))))
(setq n (+ n 1))
)
(setq perimetro
(+ perimetro
(sqrt(+
(expt (- (cadr (nth 0 lista_coor)) (cadr (nth n lista_coor))) 2)
(expt (- (caddr (nth 0 lista_coor)) (caddr (nth n lista_coor))) 2)
))))
(setq area_pos (+ area_pos (* (cadr (nth n lista_coor))(caddr (nth 0 lista_coor)))))
(setq area_neg (+ area_neg (* (caddr (nth n lista_coor))(cadr (nth 0 lista_coor)))))
(setq area (/(- area_pos area_neg) 2))
(if (= n1 0)
(progn
(setq lista_areas (list area))
(setq lista_cotas (list cota))
(setq lista_perimetros (list perimetro))
)
(progn
(setq lista_areas (append lista_areas (list area)))
(setq lista_cotas (append lista_cotas (list cota)))
(setq lista_perimetros (append lista_perimetros (list perimetro)))
)
)
(setq n1 (+ n1 1))
);;fin rep1
)
(defun dibuja_tabla()
(cond
((<= htext 10)(setq espacio 1))
((> htext 10)(setq espacio 2))
((> htext 50)(setq espacio 3))
((> htext 100)(setq espacio 5))
)
(setq ancho (* 0.4 htext 15))
(setq alto_total (* (+ htext (* espacio 2)) (+(length lista_areas) 1)))
;;;dibuja cabecera
(command "_line" pto_ubic (list (+( car pto_ubic)(* ancho 4)) (cadr pto_ubic)) "")
(setq n 0)
(repeat 5
(command "_line" (list (+(car pto_ubic) (* ancho n)) (cadr pto_ubic))
(list (+(car pto_ubic) (* ancho n)) (-(cadr pto_ubic) alto_total))
"")
(setq n (+ n 1))
)
(setq n 0)
(setq hparc (+ htext (* espacio 2)))
(repeat (+(length lista_areas) 1)
(command "_line" (list (car pto_ubic) (-(cadr pto_ubic) (* hparc (+ n 1))) )
(list ( + (car pto_ubic)(* ancho 4)) (-(cadr pto_ubic) (* hparc (+ n 1))) )
"")
(setq n (+ n 1))
)
(command "_text" "j" "mc" (list (+ (car pto_ubic) (* 0.5 ancho))(- (cadr pto_ubic) (* 0.5 hparc))) htext 0 "ITEM" "")
(command "_text" "j" "mc" (list (+ (car pto_ubic) (* 1.5 ancho))(- (cadr pto_ubic) (* 0.5 hparc))) htext 0 "AREA" "")
(command "_text" "j" "mc" (list (+ (car pto_ubic) (* 2.5 ancho))(- (cadr pto_ubic) (* 0.5 hparc))) htext 0 "PERIM." "")
(command "_text" "j" "mc" (list (+ (car pto_ubic) (* 3.5 ancho))(- (cadr pto_ubic) (* 0.5 hparc))) htext 0 "COTA" "")
(setq n 0)
(repeat (length lista_areas)
(command "_text" "j" "mc" (list (+ (car pto_ubic) (* 0.5 ancho))(- (cadr pto_ubic) (* (+ n 1.5) hparc))) htext 0 (itoa(+ n 1)) "")
(command "_text" "j" "mc" (list (+ (car pto_ubic) (* 1.5 ancho))(- (cadr pto_ubic) (* (+ n 1.5) hparc))) htext 0 (rtos(nth n lista_areas) 2 1) "")
(command "_text" "j" "mc" (list (+ (car pto_ubic) (* 2.5 ancho))(- (cadr pto_ubic) (* (+ n 1.5) hparc))) htext 0 (rtos(nth n lista_perimetros) 2 1) "")
(command "_text" "j" "mc" (list (+ (car pto_ubic) (* 3.5 ancho))(- (cadr pto_ubic) (* (+ n 1.5) hparc))) htext 0 (rtos(nth n lista_cotas) 2 1) "")
(setq n (+ n 1))
)
)
(princ "\n:::: cargar con APOL:::::")
