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 : 33
Fecha de inscripción : 13/09/2017

Ver perfil de usuario

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 : 73
Fecha de inscripción : 22/03/2016
Edad : 51
Localización : Bogota DC-Colombia

Ver perfil de usuario

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 : 33
Fecha de inscripción : 13/09/2017

Ver perfil de usuario

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 : 73
Fecha de inscripción : 22/03/2016
Edad : 51
Localización : Bogota DC-Colombia

Ver perfil de usuario

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.