Page 1 of 1
Ayuda con una modificación en rutina de mediciones.
Posted: Sat Nov 29, 2008 3:07 am
by ricaurtem
La verdad es que no se nada de programación en visual lisp, aunque si se programar en vb6 y vba, asi que me ayudara toda lo que me puedan decir o programar.
Resulta que uso mucho la rutina de suma de polilineas, pero entonces como tengo muchas polilineas y se me ocurre diferenciarlas por color las unas de las otras, pero al final las tengo que sumar y todas son el mismo layer. Entonces quisiera y aqui es donde necesito la ayuda, es que esa misma rutina de suma de polilineas me sume las que son de igual color, por ejemplo las seleccionos todas las polilineas que tengo y me las suma por su color y al final me enseña las suma por color y total.
Sum pl color azul
Sum pl color rojo
Sum pl color cyan
etc.
Por favor diganme que si se puede hacer y ayudenme.
Gracias y saludos.
Posted: Mon Dec 01, 2008 7:52 pm
by MDpilo1Egg
Hola, hasta donde recuerdo, se puede hacer con los comandos
entsel(ssget( y aqui el codigo de entidad, codigo de color))
si puedes subir el codigo de tu rutina, trataremos de ayudarte.
suerte
MDP
Posted: Wed Dec 17, 2008 10:10 pm
by ricaurtem
es la misma rutina de medicones de esta pagina
esta es la que quiero modificar para que la sume por colores de polilineas como dije antes.
Code: Select all
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Written by Joshua M Orth. February 2000
; Modificado por InnerCity <itspanish> <http>
(defun C:sumlp (/ p l e sxy exy sum1 sum2 sum3)
(setq p (ssget (list (cons -4 "<or")
(cons 0 "LINE")
(cons 0 "LWPOLYLINE")
(cons -4 "<and")
(cons 0 "POLYLINE")
(cons -4 "<not>")
(cons -4 "and>")
(cons -4 "or>")
)
)
sum1 0.0
sum2 0.0
sum3 0.0
)
;check for null selection set
(if p
(progn
(setq l 0)
(repeat (sslength p)
(cond
((= "LINE" (cdr (assoc 0 (setq e (entget (ssname p l))))))
(setq sxy (cdr (assoc 10 e))
exy (cdr (assoc 11 e))
sum1 (+ sum1 (distance sxy exy))
)
(terpri)
)
((= "LWPOLYLINE" (cdr (assoc 0 (entget (setq e (ssname p l))))))
(command "_.area" "_E" e)
(setq sum2 (+ sum2 (getvar "perimeter")))
(terpri)
)
((= "POLYLINE" (cdr (assoc 0 (entget (setq e (ssname p l))))))
(command "_.area" "_E" e)
(setq sum2 (+ sum2 (getvar "perimeter")))
(terpri)
)
)
(setq l (1+ l))
)
(setq sum3 (+ sum1 sum2))
(princ "\nLa suma total de longitudes para lineas es: ")
(princ (rtos sum1))
(princ "\nLa suma total de longitudes para polilineas es: ")
(princ (rtos sum2))
(princ "\nLa suma total de longitudes para lineas y/o polilineas es: ")
(princ (rtos sum3))
)
(princ "\nNo has seleccionado ninguna linea o polilinea")
)
(princ)
)
Ayuda con una modificación en rutina de mediciones.
Posted: Sat Jan 10, 2009 2:45 am
by RoyBatty
Hola. esta mañana he visto tu mensaje y no se si ya habrás resuelto tu problema. De cualquier forma esta rutina creo que te puede ayudar.
Code: Select all
;-------------------------------------------------------------
; SUMPL
; Obtiene la suma de las longitudes de todas las LWPOLYLINE
; del dibujo y las muestras desglosadas por colores
; (c) enero 2009 by Roy Batty
;-------------------------------------------------------------
(defun C:sumpl (/ sss lst i e col clrs icol d c p1 p2 it)
(setq clrs (list (cons 256 "PORCAPA......" )
(cons 0 "PORBLOQUE...." )
(cons 1 "ROJO........." )
(cons 2 "AMARILLO....." )
(cons 3 "VERDE........" )
(cons 4 "CIANO........" )
(cons 5 "AZUL........." )
(cons 6 "MAGENTA......" )
(cons 7 "BLANCO/NEGRO." )))
(setq sss (ssget "X" (list (cons 0 "LWPOLYLINE"))))
(if sss
(progn
(setq lst nil i 0)
(repeat (sslength sss)
(setq e (entget (ssname sss i)))
(if (null (setq col (cdr (assoc 62 e))))
(setq col 256))
(setq icol (assoc col clrs))
(if icol (setq col (cdr icol))
(setq col (strcat (itoa col) "..........")))
(setq c (member (assoc 10 e) e) d 0.0)
(setq p1 (list (cadar c) (caddar c)))
(while c
(setq c (member (assoc 10 (cdr c)) (cdr c)))
(if c (progn
(setq p2 (list (cadar c) (caddar c)))
(setq d (+ d (distance p1 p2)))
(setq p1 p2)
))
)
(if lst
(if (setq it (assoc col lst))
(setq lst (subst (cons (car it)
(+ (cdr it) d)) it lst))
(setq lst (append (list (cons col d)) lst))
)
(setq lst (list (cons col d)))
)
(setq i (1+ i))
)
(setq tot 0.0)
(foreach it lst
(setq tot (+ tot (cdr it)))
(prompt (strcat "\nColor " (car it) (rtos (cdr it))))
)
(prompt (strcat "\n-------------------------------"
"\nTotal.............." (rtos tot)))
(setq sss nil)
)
(prompt "\nNo hay polilineas (LWPOLYLINE) !!!")
)
(princ)
)
Ten en cueta que solo trabaja con entidades LWPOLYLINE y que no tienes que seleccionar nada ya que calcula la suma de todas las polilineas existentes en el dibujo, desglosando la medición por colores.
Posted: Wed Jan 14, 2009 9:03 pm
by ricaurtem
gracias, creo que me servira bastante, voy a probarlo.
Me gustaria aprender lisp a fondo, se programar en vb6 y vba, asi que mas o menos por pensar no tengo lio, solo me falta saber el lenguaje.