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.
Ayuda con una modificación en rutina de mediciones.
-
- Moderador General
- Posts: 314
- Joined: Sat Apr 08, 2006 11:00 pm
- Location: S34 54.578 W56 07.819
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.
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.
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.
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.
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)
)
Who is online
Users browsing this forum: No registered users and 0 guests