Eliminacion (EXTRIM MEJORADO)
3 participantes
Página 1 de 1.
Eliminacion (EXTRIM MEJORADO)
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.
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
Re: Eliminacion (EXTRIM MEJORADO)
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
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- Mensajes : 98
Fecha de inscripción : 22/03/2016
Edad : 57
Localización : Bogota DC-Colombia
Re: Eliminacion (EXTRIM MEJORADO)
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.
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
Re: Eliminacion (EXTRIM MEJORADO)
Pues que pena que no sepa programar, espero que alguno de los gurus del foro te de una manito
Saludos
Bernardo C
Saludos
Bernardo C
bernie67- Mensajes : 98
Fecha de inscripción : 22/03/2016
Edad : 57
Localización : Bogota DC-Colombia
Re: Eliminacion (EXTRIM MEJORADO)
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
Re: Eliminacion (EXTRIM MEJORADO)
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.
slds.
SushyM- Mensajes : 38
Fecha de inscripción : 13/09/2017
Re: Eliminacion (EXTRIM MEJORADO)
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
slds.
https://drive.google.com/file/d/1K42IJ_GBwW2nk7UGGecoobdlfaXfjQ-M/view
SushyM- Mensajes : 38
Fecha de inscripción : 13/09/2017
va modificado
Ver los adjuntos
el comando es
https://drive.google.com/file/d/1saL3ZaeQ3C9ZdztdBSHCqrg2BuOuip2y/view?usp=sharing_eil&ts=5dadbc07
el comando es
- Código:
BORRA-AFUERA
https://drive.google.com/file/d/1saL3ZaeQ3C9ZdztdBSHCqrg2BuOuip2y/view?usp=sharing_eil&ts=5dadbc07
Re: Eliminacion (EXTRIM MEJORADO)
Te envié un correo para que me permitas bajar el archivo. Gracias de antemano
Bernardo Corradine M.
Bernardo Corradine M.
bernie67- Mensajes : 98
Fecha de inscripción : 22/03/2016
Edad : 57
Localización : Bogota DC-Colombia
ya lo envié por correo
bernie67 escribió:Te envié un correo para que me permitas bajar el archivo. Gracias de antemano
Bernardo Corradine M.
Re: Eliminacion (EXTRIM MEJORADO)
Muchas gracias Gabriel, esta de lujo tu rutina y ahorra un montón de trabajo. Agradecido con tu aporte.
Saludos
Bernardo Corradine M
Saludos
Bernardo Corradine M
bernie67- Mensajes : 98
Fecha de inscripción : 22/03/2016
Edad : 57
Localización : Bogota DC-Colombia
Re: Eliminacion (EXTRIM MEJORADO)
Hola te envié un correo para que me permitas bajar el archivo. Según lo que menciona Bernie67, ayuda a lo que requiero.
slds.
slds.
SushyM- Mensajes : 38
Fecha de inscripción : 13/09/2017
Re: Eliminacion (EXTRIM MEJORADO)
Gracias, por el apoyo, me ayuda en lo que estoy haciendo.
saludos.
saludos.
SushyM- Mensajes : 38
Fecha de inscripción : 13/09/2017
Página 1 de 1.
Permisos de este foro:
No puedes responder a temas en este foro.
|
|