Eliminacion (EXTRIM MEJORADO)

Ir abajo

Eliminacion (EXTRIM MEJORADO) Empty Eliminacion (EXTRIM MEJORADO)

Mensaje por SushyM el Vie Mayo 31, 2019 1:59 pm

Buenos días amigos,

Conectándome después de tiempo, esperando contar con el apoyo de uds.
Se me presenta esta situación que colgué en mi drive, donde necesito eliminar toda entidad que se encuentre fuera del polígono, similar cuando usas el comando extrim, pero esta ves necesito seleccionar varios polígonos como se visualiza en el dwg.


Link
https://drive.google.com/open?id=1K42IJ_GBwW2nk7UGGecoobdlfaXfjQ-M

saludos.


SushyM

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

Volver arriba Ir abajo

Eliminacion (EXTRIM MEJORADO) Empty Re: Eliminacion (EXTRIM MEJORADO)

Mensaje por bernie67 el Dom Jun 02, 2019 5:47 am

Hola tengo este lisp pero ni idea de programar. te lo dejo a ver si alguien sabe
saludos
Bernardo

;
; -- Orden PolErase
; Borra objetos por ventana/captura interior/exterior,
; o borra y recorta interior/exterior.
; :copyright:2004/7 scaner, Spain
; Notas:
; Utiliza la función etrim de la orden extrim.
;
(defun c:PolErase (/ pol typ vrt lyr pto ssx ssv ssc n ent ky1 ky2)
(defun dxf (ass lst) (cdr (assoc ass lst)))
(setq old_error *error*)
(setq old_cmdecho (getvar "cmdecho")
old_highlight (getvar "highlight")
old_ucsfollow (getvar "ucsfollow")
)
(setvar "cmdecho" 0)
(setvar "ucsfollow" 0)
(command "_undo" "_begin")
(command "_ucs" "_world")
(while (/= typ "LWPOLYLINE")
(while (not (setq pol (car (entsel "\nDesigne la polilínea de borde: ")))))
(setq typ (dxf 0 (entget pol)))
)
(setq vrt (LstVrt2LWPol pol)
lyr (append '((-4 . "<or"))
(mapcar (function (lambda (n) (cons 8 n))) (LstLyrUtlAct))
'((-4 . "or>"))
)
)
(initget "V C R")
(if (not (setq ky1 (getkword "\nBorrar por Ventana, Captura o <borrar y Recortar>: ")))
(setq ky1 "R")
)
(initget 1)
(command "_point" (setq pto (getpoint "\nDesigne el lado a borrar/recortar: ")))
(setq ssx (ssdel pol (ssget "_x" lyr))
ssv (ssget "_wp" vrt)
ssc (ssdel pol (ssget "_cp" vrt))
n -1
)
(while (setq ent (ssname ssc (setq n (1+ n))))
(if (= (dxf 5 (entget (entlast))) (dxf 5 (entget ent)))
(setq ky2 T) ;interior
)
)
(cond ((and (or (= ky1 "V") (= ky1 "R")) ky2) (command "_erase" ssv ""))
((or (= ky1 "V") (= ky1 "R")) (command "_erase" ssx "_remove" ssc ""))
((and (= ky1 "C") ky2) (command "_erase" ssc ""))
((= ky1 "C") (command "_erase" ssx "_remove" ssv ""))
)
(cond ((= ky1 "R") (load "extrim") (etrim pol pto)))
(command "_ucs" "_prev")
(command "_undo" "_end")
(setvar "ucsfollow" old_ucsfollow)
(setvar "highlight" old_highlight)
(setvar "cmdecho" old_cmdecho)
(setq *error* old_error)
(princ)
)
(prompt "\nNuevo comando PolErase definido en AutoCAD - :copyright:2004/7 scaner, Spain.")
;
; -- Función *error*
; Tratamiento de errores
;
(defun *error* (msg)
(command "_ucs" "_prev")
(command "_undo" "_end")
(setvar "ucsfollow" old_ucsfollow)
(setvar "highlight" old_highlight)
(setvar "cmdecho" old_cmdecho)
(setq *error* old_error)
)
;
; -- Función LstVrt2LWPol
; Forma una lista con los vértices (x,y) de una polilínea optimizada.
; :copyright:2004/7 scaner, Spain
; Argumentos [Tipo]:
; pol = Nombre de entidad (LWPOLYLINE) [ENAME]
; Retorna [Tipo]:
; > Lista de coordenadas de vértices (x,y) [LIST]
; Notas:
; Ninguna
;
(defun LstVrt2LWPol (pol / ass lst)
(foreach ass (entget pol)
(if (= (car ass) 10)
(setq lst (cons (cdr ass) lst))
)
)
(reverse lst)
)
;
; -- Función LstLyrUtlAct
; Forma una lista con las capas utilizadas y activadas.
; :copyright:2004/7 scaner, Spain
; Argumentos [Tipo]:
; Ninguno
; Retorna [Tipo]:
; > Lista de nombres de capas [LIST]
; Notas:
; Las capas se colocan por orden alfabético.
;
(defun LstLyrUtlAct (/ lyr lst)
(setq lyr (tblnext "layer" T))
(while lyr
(if (and (= (logand (cdr (assoc 70 lyr)) 1) 0) (> (cdr (assoc 62 lyr)) 0))
(setq lst (cons (cdr (assoc 2 lyr)) lst))
)
(setq lyr (tblnext "layer"))
)
(acad_strlsort lst)
)
(princ)

Volver arriba


bernie67
bernie67

Mensajes : 76
Fecha de inscripción : 22/03/2016
Edad : 52
Localización : Bogota DC-Colombia

Volver arriba Ir abajo

Eliminacion (EXTRIM MEJORADO) Empty Re: Eliminacion (EXTRIM MEJORADO)

Mensaje por SushyM el Dom Jun 02, 2019 8:56 pm

Que tal amigo, bernie67
he corrido la rutina y tiene la función que deseo, solo que faltaría adicionar que me permita seleccionar mas polígonos cerrados ya que este solo trabaja con uno.

SushyM

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

Volver arriba Ir abajo

Eliminacion (EXTRIM MEJORADO) Empty Re: Eliminacion (EXTRIM MEJORADO)

Mensaje por bernie67 el Lun Jun 10, 2019 1:51 am

Pues que pena que no sepa programar, espero que alguno de los gurus del foro te de una manito
Saludos
Bernardo C
bernie67
bernie67

Mensajes : 76
Fecha de inscripción : 22/03/2016
Edad : 52
Localización : Bogota DC-Colombia

Volver arriba Ir abajo

Eliminacion (EXTRIM MEJORADO) Empty Re: Eliminacion (EXTRIM MEJORADO)

Mensaje por SushyM el Sáb Jun 22, 2019 12:56 pm

Que tal chicos, todavía no he podido encontrar una solución al problema planteado, que se adecue a lo que necesito, ojala alguno de los grandes en esto me pueda dar una manito. bernie67 gracias, se que esa rutina es de gran ayuda. slds.

SushyM

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

Volver arriba Ir abajo

Eliminacion (EXTRIM MEJORADO) Empty Re: Eliminacion (EXTRIM MEJORADO)

Mensaje por SushyM el Jue Sep 05, 2019 6:09 am

Hola chicos, que tal como han estado, he vuelto a retomar este tema, esperando si alguno de uds, me puedan ayudar a solucionar este pedido que publique hace un tiempo atrás. espero contar con el apoyo de alguno de los que tienen mas experiencia en la rutina que requiero.

slds.

SushyM

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

Volver arriba Ir abajo

Eliminacion (EXTRIM MEJORADO) Empty Re: Eliminacion (EXTRIM MEJORADO)

Mensaje por SushyM el Vie Oct 11, 2019 12:05 pm

Hola chicos, que tal como han estado, todavía sigo con esta solicitud esperando que alguien me pueda apoyar, bernie67 esta rutina es buena solo que son varios polígonos y se puede usar de uno en uno, espero que alguien me pueda ayudar a modificarla o mejorarla.

slds.

https://drive.google.com/file/d/1K42IJ_GBwW2nk7UGGecoobdlfaXfjQ-M/view

SushyM

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

Volver arriba Ir abajo

Eliminacion (EXTRIM MEJORADO) Empty va modificado

Mensaje por Admin el Lun Oct 21, 2019 4:13 pm

Ver los adjuntos
el comando es
Código:
BORRA-AFUERA
, debes elegir uno de los cuadros que quieres procesar , el lisp los seleccionas por capa y hace el recorte de lo que está afuera . Le cambia el color , tan solo para distinguirlos .  


https://drive.google.com/file/d/1saL3ZaeQ3C9ZdztdBSHCqrg2BuOuip2y/view?usp=sharing_eil&ts=5dadbc07

Admin
Admin

Mensajes : 201
Fecha de inscripción : 16/03/2016
Edad : 71
Localización : CORDOBA ARGENTINA

http://acadhispano.foroargentina.net

Volver arriba Ir abajo

Eliminacion (EXTRIM MEJORADO) Empty Re: Eliminacion (EXTRIM MEJORADO)

Mensaje por bernie67 el Lun Oct 21, 2019 9:50 pm

Te envié un correo para que me permitas bajar el archivo. Gracias de antemano
Bernardo Corradine M.
bernie67
bernie67

Mensajes : 76
Fecha de inscripción : 22/03/2016
Edad : 52
Localización : Bogota DC-Colombia

Volver arriba Ir abajo

Eliminacion (EXTRIM MEJORADO) Empty ya lo envié por correo

Mensaje por Admin el Lun Oct 21, 2019 10:02 pm

bernie67 escribió:Te envié un correo para que me permitas bajar el archivo. Gracias de antemano
Bernardo Corradine M.

Admin
Admin

Mensajes : 201
Fecha de inscripción : 16/03/2016
Edad : 71
Localización : CORDOBA ARGENTINA

http://acadhispano.foroargentina.net

Volver arriba Ir abajo

Eliminacion (EXTRIM MEJORADO) Empty Re: Eliminacion (EXTRIM MEJORADO)

Mensaje por bernie67 el Lun Oct 21, 2019 10:54 pm

Muchas gracias Gabriel, esta de lujo tu rutina y ahorra un montón de trabajo. Agradecido con tu aporte.
Saludos
Bernardo Corradine M
bernie67
bernie67

Mensajes : 76
Fecha de inscripción : 22/03/2016
Edad : 52
Localización : Bogota DC-Colombia

Volver arriba Ir abajo

Eliminacion (EXTRIM MEJORADO) Empty Re: Eliminacion (EXTRIM MEJORADO)

Mensaje por Admin el Lun Oct 21, 2019 11:35 pm

Me alegro. Cualquier cosa , a tus ordenes .

Admin
Admin

Mensajes : 201
Fecha de inscripción : 16/03/2016
Edad : 71
Localización : CORDOBA ARGENTINA

http://acadhispano.foroargentina.net

Volver arriba Ir abajo

Eliminacion (EXTRIM MEJORADO) Empty Re: Eliminacion (EXTRIM MEJORADO)

Mensaje por SushyM el Mar Oct 22, 2019 3:07 am

Hola te envié un correo para que me permitas bajar el archivo. Según lo que menciona Bernie67, ayuda a lo que requiero.
slds.

SushyM

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

Volver arriba Ir abajo

Eliminacion (EXTRIM MEJORADO) Empty Re: Eliminacion (EXTRIM MEJORADO)

Mensaje por SushyM el Lun Oct 28, 2019 11:29 am

Gracias, por el apoyo, me ayuda en lo que estoy haciendo.
saludos.

SushyM

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

Volver arriba Ir abajo

Eliminacion (EXTRIM MEJORADO) Empty Re: Eliminacion (EXTRIM MEJORADO)

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.