Tabla de Puntos

Ver el tema anterior Ver el tema siguiente Ir abajo

Tabla de Puntos

Mensaje por SushyM el Lun Oct 16, 2017 2:37 am

Que tal chicos, como han estado.
Aca de nuevo tratando de conseguir solucionar un trabajo sistemático.
Tengo un grupo de Lineas y Polilineas, algunas colineales y otras no y necesito enumerarlas, la numeración por tramos seria ideal número continuo pero no necesario.
y necesito armar un cuadro similar como el ejemplo que adjunto.
https://drive.google.com/open?id=0B3HBbf2wcY4neXRsX1dzaDllU2M

Mis datos iniciales son las lineas y polilineas nada más, espero contar con el apoyo de uds. en darme sugerencias de como trabajarlo y lograr una solucion

Saludos.

SushyM

Mensajes : 25
Fecha de inscripción : 13/09/2017

Ver perfil de usuario

Volver arriba Ir abajo

Re: Tabla de Puntos

Mensaje por Zicaryd el Sáb Oct 21, 2017 4:58 pm

Hola amiga, revisando el foro he visto esto
http://acadhispano.foroargentina.net/t29-distancias-entre-puntos
Talvez por ahy pueda haber algo que te ayude, muy aparte ten un poco de paciencia, acá me he topado con compañeros que me han sabido dar la mano pero si tienes que esperar a que ellos puedan ver tu Post.
Saludos.

Zicaryd

Mensajes : 23
Fecha de inscripción : 23/10/2016

Ver perfil de usuario

Volver arriba Ir abajo

Re: Tabla de Puntos

Mensaje por nolo el Dom Oct 22, 2017 8:39 pm

Me ha llevado mas tiempo de lo que pensaba y aún no la tengo esta muy acabada pero mira si te sirve así.
Seleccionas con ventana o crosing y te numera los puntos de arriba hacia abajo y de izquierda a derecha, pone las longitudes y no crea la tabla pero la lista en la pantalla de texto para que la puedas copiar y pegar en un mtext, tabla o lo que sea...
Código:
(defun c:misZ( / ponte distinct old ss si se st i c ya y)
;; by NOLO octubre 2017
(defun ponte (p1 p2 tex h / pc)
(setq pc (mapcar '/ (mapcar '+ p1 p2)'(2 2))
 ang (angle p1 p2)
 ang (if (and (> ang (/ pi 2))(< ang (* 1.5 pi))) (angle p2 p1) ang)
 pc (polar pc (+ ang (/ pi 2)) (* 1.4 h))
)
 (entmake(list '(0 . "TEXT")
 (cons 10 pc)(cons 40 h)
 (cons 1  tex)(cons 50 ang)
 '(71 . 0) '(72 . 1)
 (cons 11 pc)'(73 . 2)
 ))
(list p1 tex p2)
)

(defun distinct(l) ; duplicados por YMG
(if l (cons (car l) (distinct (vl-remove (car l) l) )))
)

(setq old (getvar 'dimzin))
(setvar 'dimzin 0)

(setq ss(ssget '((0 . "*LINE")))
 ss (mapcar 'cadr (ssnamex ss))
 ss (vl-remove-if 'listp ss)
 ss (mapcar '(lambda(a) (mapcar 'cdr
 (vl-remove-if-not '(lambda(x)(member (car x) '(10 11))) (entget a))
 ))ss)
)
(setq si (apply 'append ss)
 si (distinct si)
 si ;; ordenar por GERARDO
 (vl-sort si '(lambda (A B)(if (= (cadr A)(cadr B))(< (car A)(car B))(> (cadr A)(cadr B)))))
 i 0
 si (mapcar '(lambda(a) (cons a (setq i (1+ i))) ) si)
 se (apply 'append
 (mapcar '(lambda(a)
 (mapcar '(lambda (x y )(ponte x y (rtos (distance x y) 2 4) 3.) )a (cdr a))
 )ss))
 se (mapcar '(lambda(a / c)
 (mapcar '(lambda(x) (if (setq c(assoc x si)) (cdr c) x) ) a)
 )se)
 st (mapcar '(lambda(a) (if (setq c (assoc (cdr a) se)) c (assoc (cdr a) (mapcar 'reverse se))))si)
)
(setvar 'clayer "TEXTO")
(foreach a si
 (ponte (car a) (polar (car a) 0 10) (setq i (strcat "P"(itoa (cdr a)))) 5)
 (setq c (assoc (cdr a) st)
 y (list (car c)(last c))
 )
 (princ (strcat (chr 10) i "  "
 (chr 9)(rtos (caar a) 2 4)
 (chr 9)(rtos (cadar a) 2 4)
 (if (not (member (reverse y) ya))
 (progn (setq ya (cons y ya))
 (strcat
 (chr 9)"P"(itoa(car c))"-P"(itoa(last c))
 (chr 9)(cadr c))
 )(progn (strcat (chr 9) (chr 9))
 ))
 ))

)
(princ (strcat (chr 10)"Total "))
(princ (apply '+ (mapcar 'atof (mapcar 'cadr se))))
(setvar 'clayer "0")
(setvar 'dimzin old)
(princ)
)
Solo puede funcionar con tramos rectos sean líneas o polilineas
Espero te sirva

Un saludo

nolo

Mensajes : 144
Fecha de inscripción : 17/03/2016

Ver perfil de usuario

Volver arriba Ir abajo

Re: Tabla de Puntos

Mensaje por SushyM el Lun Oct 23, 2017 2:41 am

Hola estimado: nolo
Veo que esta enrumbado la rutina, en algunos caso he notado que en el mismo punto los enumera 2 veces, y al borrar los repetidos me genera el trabajo de renumerar nuevamente, bueno igual gracias por el tiempo que te estas tomando para apoyarme con esto.

Saludos ;-)

SushyM

Mensajes : 25
Fecha de inscripción : 13/09/2017

Ver perfil de usuario

Volver arriba Ir abajo

Re: Tabla de Puntos

Mensaje por nolo el Lun Oct 23, 2017 10:51 am

Por favor, sube el dwg del caso en el que falla (mejor en 2010)

Un saludo

nolo

Mensajes : 144
Fecha de inscripción : 17/03/2016

Ver perfil de usuario

Volver arriba Ir abajo

Re: Tabla de Puntos

Mensaje por SushyM el Mar Oct 24, 2017 8:23 am


SushyM

Mensajes : 25
Fecha de inscripción : 13/09/2017

Ver perfil de usuario

Volver arriba Ir abajo

Re: Tabla de Puntos

Mensaje por nolo el Mar Oct 24, 2017 6:04 pm

Vale, se me pasó que las lwpolylineas guardan solo las coordenadas x e y (la z  es común y va en otro sitio del dxf) y las líneas normales guardan por cada punto las tres, x,y,z por lo que al aplicar la función distinct de YMG no eliminaba los puntos duplicados ....
Corrige el lisp en la parte de la selección:
Código:
(setq ss(ssget '((0 . "*LINE")))
 ss (mapcar 'cadr (ssnamex ss))
 ss (vl-remove-if 'listp ss)
 ss (mapcar '(lambda(a) (mapcar 'cdr
 (vl-remove-if-not '(lambda(x)(member (car x) '(10 11))) (entget a))
 ))ss)
)
Añadiendo el filtro, es decir que tienen que quedar así:
Código:
(setq ss(ssget '((0 . "*LINE")))
 ss (mapcar 'cadr (ssnamex ss))
 ss (vl-remove-if 'listp ss)
 ss (mapcar '(lambda(a) (mapcar 'cdr
 (vl-remove-if-not '(lambda(x)(member (car x) '(10 11))) (entget a))
 ))ss)
 ss (mapcar '(lambda(x) ;; filtro sin z para cada entidad
 (mapcar '(lambda(a)(list (car a)(cadr a))) x))
 ss);; <- nuevo filtro por cada selección
)

Un saludo

nolo

Mensajes : 144
Fecha de inscripción : 17/03/2016

Ver perfil de usuario

Volver arriba Ir abajo

Re: Tabla de Puntos

Mensaje por Contenido patrocinado


Contenido patrocinado


Volver arriba Ir abajo

Ver el tema anterior Ver el tema siguiente Volver arriba

- Temas similares

 
Permisos de este foro:
No puedes responder a temas en este foro.