Ayuda con rutina similar a Overkill

Ir abajo

Ayuda con rutina similar a Overkill Empty Ayuda con rutina similar a Overkill

Mensaje por José Francisco el Jue Ago 01, 2019 10:55 pm

Buen día a todos.
Por favor, me pueden ayudar?
Pasa que tengo varias líneas unas encima de otras, algunas tienen la misma dirección, otras no, unas líneas están en una capa (layer) y otras en otra capa, en algunos casos la capa 1 está arriba, en otros casos la capa 1 está abajo.
Para eliminar las líneas repetidas uso el comando “overkill” y casi siempre elimina una de las líneas repetidas.
Mi pregunta: Que controla que línea se elimina?
Esto porque en algunas ocasiones elimina la línea que está arriba, otras la que está abajo y en alguna otra ocasión, no elimina ninguna.
Encontré por ahí un par de rutinas que eliminan líneas duplicadas pero el pasa lo mismo.
Por favor, me pueden ayudar, puedo hacer que las líneas que ocupo eliminar queden arriba o abajo para que todas tengan esa característica.
Y ocupo eliminar las de una capa en especifico.
Les agradezco su ayuda.

Esta son las dos rutinas que he encontrado

Código:

(defun unique ( linlst )
  (if (car linlst) (cons (car linlst) (unique (_vl-remove (car linlst) (_vl-remove (list (cadar linlst) (caar linlst)) (cdr linlst) 1e-6) 1e-6))))
)

(defun _vl-remove ( el lst fuzz )
  (vl-remove-if '(lambda ( x ) (and (equal (car x) (car el) fuzz) (equal (cadr x) (cadr el) fuzz))) lst)
)

(defun eraseduplin ( ss / i lin p1 p2 lay col62 col420 linlst linlsta linlstn )
  (setq i -1)
  (while (setq lin (ssname ss (setq i (1+ i))))
    (setq p1 (cdr (assoc 10 (entget lin)))
          p2 (cdr (assoc 11 (entget lin)))
          lay (cdr (assoc 8 (entget lin)))
          col62 (cdr (if (assoc 62 (entget lin)) (assoc 62 (entget lin)) nil))
          col420 (cdr (if (assoc 420 (entget lin)) (assoc 420 (entget lin)) nil))
    )
    (setq linlsta (cons (list p1 p2 lay col62 col420) linlsta))
    (setq linlst (cons (list p1 p2) linlst))
    (entdel lin)
  )
  (setq linlstn (unique linlst))
  (foreach lin linlsta
    (if (vl-some '(lambda ( x ) (and (equal (car x) (car lin) 1e-8) (equal (cadr x) (cadr lin) 1e-8))) linlstn)
      (setq linlstn (subst lin (list (car lin) (cadr lin)) linlstn))
    )
  )
  (foreach lin linlstn
    (entmake (vl-remove nil (list '(0 . "LINE") (cons 8 (caddr lin)) (if (cadddr lin) (cons 62 (cadddr lin))) (if (caddr (cddr lin)) (cons 420 (caddr (cddr lin)))) (cons 10 (car lin)) (cons 11 (cadr lin)))))
  )
  (- (length linlsta) (length linlstn))
)

(defun c:bld ( / ss s i k lin )

  (setq ss (ssget "_x" '((0 . "LINE"))))
  ;(setq ss (ssget "_:L" '((0 . "LINE"))))
  (setq s (ssadd))
  (setq i -1)
  (setq k 0)
  (while (setq lin (ssname ss (setq i (1+ i))))
    (if (equal (cdr (assoc 10 (entget lin))) (cdr (assoc 11 (entget lin))) 1e-4) (progn (setq k (1+ k)) (entdel lin)) (ssadd lin s))
  )
  (prompt "\nTotal : ")(princ (eraseduplin s))(prompt " duplicate-lines erased")
  (prompt "\nTotal : ")(princ k)(prompt " zero-lines erased")
  (princ)
)



y esta otra

Código:
(defun c:ddl (/ ss item)
(if (setq ss (ssget))
(progn
;(command "-overkill" ss "" "Ignore" "lweight" "Ignore" "Layer" "")
(command "-overkill" ss "" "Ignore" "all" "")
(foreach item (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(if (not (entget item))
(setq ss (ssdel item ss))
)
)
)
)
(princ)
)

José Francisco

Mensajes : 30
Fecha de inscripción : 30/03/2016

Volver arriba Ir abajo

Ayuda con rutina similar a Overkill Empty Re: Ayuda con rutina similar a Overkill

Mensaje por Marco Jacinto el Lun Sep 23, 2019 4:32 pm

Elimina por defecto las que estén arriba, es decir, las que se dibujaron al final y que dentro de la base de datos de AutoCAD están encima.

Marco Jacinto

Mensajes : 63
Fecha de inscripción : 12/08/2016

Volver arriba Ir abajo

Ayuda con rutina similar a Overkill Empty Re: Ayuda con rutina similar a Overkill

Mensaje por José Francisco el Miér Sep 25, 2019 7:56 pm

Buen día a todos.
Marco Jacinto, muchas gracias por su respuesta, pero (perdón por mi poco conocimiento) como?
En el dwg que adjunto, trato de explicar que es lo que hago para que al final me queden líneas de una capa (lindero) sobre líneas de otra capa (en este caso, lines) y busco mediante una ventana eliminar las líneas que están en la segunda capa (lines).
En verdad, espero puedan ayudarme.
Este es el dwg de ejemplo:

https://www.dropbox.com/s/k5a51x7ioto0948/Ejemplo%20%283%29.dwg?dl=0

Saludos cordiales.

José Francisco

Mensajes : 30
Fecha de inscripción : 30/03/2016

Volver arriba Ir abajo

Ayuda con rutina similar a Overkill Empty Re: Ayuda con rutina similar a Overkill

Mensaje por Marco Jacinto el Jue Sep 26, 2019 12:15 am

Hay muchos puntos para trabajar:

1. ¿Es necesario recortar el interior de los circulos? podrias usar un block con wipeout y se vería igual.

2. ¿Porque debes borrar lo que queda debajo de la linea azul? al hacerla polilínea con ancho lo que esta abajo quedaría oculto sin mas., y si necesitaras regresarte un paso, podrías sin problemas borrar la polilínea azul y dejar tu dibujo como antes.

3. Hacer un comando manteniendo la polilinea y usando un bloque con atributos sería mas o menos sencillo



Marco Jacinto

Mensajes : 63
Fecha de inscripción : 12/08/2016

Volver arriba Ir abajo

Ayuda con rutina similar a Overkill Empty Re: Ayuda con rutina similar a Overkill

Mensaje por Marco Jacinto el Jue Sep 26, 2019 3:21 am

José, prueba este código con el archivo que anexo.

Código:
(defun c:PlineAzul (/ CT EDATA ELASTOLD OLDATTDIA OLDATTREQ PAUSE PLINE PLINEOBJ
    PLVTX)
  (vl-load-com)
  (if (not command-s)
    (setq command-s command))
  (DEFUN whcmd (cmd /)
    (SETVAR "cmdecho" 1)
    (SETVAR "texteval" 1)
    (WHILE (= (GETVAR "CMDACTIVE") 1) cmd (command-s pause))
 ; _ end of
 ; while
  ) ;_ end of defun
  (princ "\n Primer punto para la polilinea azul: ")
  (setq elastold (entlast))
  (command-s "_.pline")
  (whcmd "_.pline")
  (setq pline (entlast))
  (setq ct 0)
  (setq oldattdia (getvar "attdia"))
  (setq oldattreq (getvar "attreq"))
  (setvar "attreq" 1)
  (if (/= pline elastold)
    (progn
      (setq plvtx (massoc 10 (setq edata (entget pline))))
      (setq plineObj (vlax-ename->vla-object pline))
      (vla-put-ConstantWidth plineObj 0.10)
      (vla-put-layer PlineObj "Lindero")
      (foreach pt plvtx
 (setvar "attdia" 0)
 (command "insert"
 "VtxPline"
 pt
 1
 1
 0
 (itoa (setq ct (1+ ct)))
 )
      )
    )
  )
  (setvar "attdia" oldattdia)
  (setvar "attreq" oldattdia)
  (princ)
)

https://drive.google.com/file/d/1KgF6hSuRw9DcApJTvMkDrmk0F9EkLWtC/view?usp=sharing

Marco Jacinto

Mensajes : 63
Fecha de inscripción : 12/08/2016

Volver arriba Ir abajo

Ayuda con rutina similar a Overkill Empty Re: Ayuda con rutina similar a Overkill

Mensaje por José Francisco el Lun Sep 30, 2019 10:08 pm

Buen día.
Marco Jacinto, mil gracias por su ayuda.
Es verdad, usted tiene razón, no es necesario eliminar lo que esta bajo la línea azul, el detalle para mi persona( solo para mi persona), es el saber que hay líneas bajo la línea azul, como cuando en la pantalla del teléfono hay una pequeña burbuja.
Las rutinas que encontré, a veces eliminan las lineas sobre puestas, en otras ocaciones no lo hacen.
En cuanto a los circulos, si, me lo pide un reglamento, debe identificarse cada vértice por medio de un circulo. El "wipeout" es genial y trabaja excelente, hasta que, por culpa de la escala, un"wipeout" toca a otro y uno se verá completo pero el otro se verá como un arco.

https://www.dropbox.com/s/3hx5vby22oue2c5/Ejemplo%20%283%29.dwg?dl=0

Lo que busco es saber que controla que líneas se borran, las que están sobre o las que están bajo.

En verdad, le agradezco su tiempo.

Saludos cordiales

José Francisco

Mensajes : 30
Fecha de inscripción : 30/03/2016

Volver arriba Ir abajo

Ayuda con rutina similar a Overkill Empty Re: Ayuda con rutina similar a Overkill

Mensaje por Marco Jacinto el Lun Sep 30, 2019 11:11 pm

Que mal que no te sirvío, saludos.

Marco Jacinto

Mensajes : 63
Fecha de inscripción : 12/08/2016

Volver arriba Ir abajo

Ayuda con rutina similar a Overkill Empty Re: Ayuda con rutina similar a Overkill

Mensaje por José Francisco el Mar Oct 01, 2019 11:31 pm

Buen día a todos.
No Marco Jacinto, el lisp que usted plantea no me sirve para lo que especificamente busco pero si me sirve para otro tipo de presentaciones, aunque no me queda muy claro como hago para cambiar el tamaño, tanto del "wipeout" como del identificador (número), esto por las distintas escalas, y otro detalle, se pudede modificar para que busque y carge el bloque?

En verdad le agradezco por su ayuda, principalmente por su tiempo.

Y lo que son las cosas, encontré un lisp que me parece (lo he probado poco) hace lo que busco, no recuerdo la pagina en la que lo encontré, por lo que no cito al autor

Código:
(defun c:findclin (/ ss en ed p10 p11 dl cl)

;;;ROUND A POINT VALUE
;;;ARG -> Pointlist Decimalplace
;;;RET -> POINT LIST
(defun roundpt (p d)
 (list (atof (rtos (car p) 2 d))
      (atof (rtos (cadr p) 2 d))
      (atof (rtos (caddr p) 2 d))))


 (princ "\nPass #1...\n")
 (and (setq ss (ssget "X" (list (cons 0 "LINE"))))
      (while (setq en (ssname ss 0))
            (princ "\r") (prin1 en)
            (setq ed (entget en)
                  p10 (roundpt (cdr (assoc 10 ed)) 8)
                  p11 (roundpt (cdr (assoc 11 ed)) 8)
                  dl (cons (list p10 p11) dl)
                  dl (cons (list p11 p10) dl))
            (ssdel en ss)))

 (princ "\nPass #2...\n")
 (and (setq ss (ssget "X" (list (cons 0 "LINE"))))
      (while (setq en (ssname ss 0))
            (princ "\r") (prin1 en)
            (setq ed (entget en)
                  p10 (roundpt (cdr (assoc 10 ed)) 8)
                  p11 (roundpt (cdr (assoc 11 ed)) 8))
            (if (or (member (list p10 p11) (cdr (member (list p10 p11) dl)))
                    (member (list p11 p10) (cdr (member (list p11 p10) dl))))
                (entmod (subst '(8 . "COMMON") (assoc 8 ed) ed)))
            (ssdel en ss)))

 (princ "\nPass #3...\n")
 (setq cl nil)
 (and (setq ss (ssget "X" (list (cons 0 "LINE")(cons 8 "COMMON"))))
      (while (setq en (ssname ss 0))
            (princ "\r") (prin1 en)
            (setq ed (entget en)
                  p10 (roundpt (cdr (assoc 10 ed)) 8)
                  p11 (roundpt (cdr (assoc 11 ed)) 8))
            (if (not (or (member (list p10 p11) cl)
                          (member (list p11 p10) cl)))
                (setq cl (cons (list p10 p11) cl)
                      cl (cons (list p11 p10) cl))
                (entdel en))
            (ssdel en ss)))

  (if (setq ss (ssget "X" '((8 . "COMMON"))))
      (command "_.CHPROP" ss "" "_C" "BYLAYER" ""))

  (redraw))
Le he modificado
8 . "COMMON"
por
8. "Lindero"

De nuevo, mil gracias

José Francisco

Mensajes : 30
Fecha de inscripción : 30/03/2016

Volver arriba Ir abajo

Ayuda con rutina similar a Overkill Empty Re: Ayuda con rutina similar a Overkill

Mensaje por Contenido patrocinado


Contenido patrocinado


Volver arriba Ir abajo

Volver arriba

- Temas similares

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