Lisp para "trim Inside Circles"

Ir abajo

Lisp para "trim Inside Circles" Empty Lisp para "trim Inside Circles"

Mensaje por José Francisco el Miér Sep 25, 2019 10:11 pm

Buen día a todos.
Yo y las rutinas lisp que busco.
Estoy tras una rutina lisp que haga "trim" dentro de un circulo, esto es, que elimine lo que se encuentre dentro del circulo que se seleccione.
Por ahí encontré un lisp que lo hace y lo hace muy bien pero lo hace con un circulo y busco que se seleccione una serie de circulos y haga el "trim" en cada uno de ellos.
Más o menos he logrado adaptar el lisp que encontré pero a la hora de ejecutarlo hace algo muy curioso, selecciona el primer circulo que encuentra, realiza el "trim", busca el segundo circulo pero al encontrarlo, regresa al primero, vuelve al segundo, hace el "trim", busca el tercer circulo, pero regresa al primero, luego al segundo y pasa al tercero, y así hasta terminar.
Por ahí, encontré que el comando "extrim" hace lo que busco, pero se tarda bastante en realizar la limpieza de los circulos.
Este es el lisp que encontré:
Código:
(defun c:trim_between_2_concentic_circles ( / inner_circle outer_circle c1 c2 c r1 r2 r k p pl )

 (setq inner_circle (car (entsel "\nPick inner circle")))
 (setq outer_circle (car (entsel "\nPick outer circle")))
 (setq c1 (cdr (assoc 10 (entget inner_circle))))
 (setq c2 (cdr (assoc 10 (entget outer_circle))))
 (setq c (mapcar '* (mapcar '+ c1 c2) '(0.5 0.5 0.5)))
 (setq r1 (cdr (assoc 40 (entget inner_circle))))
 (setq r2 (cdr (assoc 40 (entget outer_circle))))
 (setq r (/ (+ r1 r2) 2.0))
 (setq k -1.0)
 (repeat 360
  (setq p (polar c (cvunit (setq k (1+ k)) "degrees" "radians") r))
  (setq pl (cons p pl))
 )
 (setq pl (cons (polar c 0.0 r) pl))
 (command "_.trim" inner_circle outer_circle "" "_F")
 (foreach p pl
  (command p)
 )
 (while (> (getvar 'cmdactive) 0) (command ""))
 (princ)
)

(defun c:tb2cc nil (c:trim_between_2_concentic_circles))

y este es el lisp que he adaptado:
Código:

(defun C:TC (/ ss1 sc Et Lt Pc Ra c1 c2 c r1 r2 r k p pl)
  (setvar "cmdecho" 0)
  (vl-cmdf "_ORTHO" "_OFF" "_SNAP" "_OFF" "_OSNAP" "_OFF" "_UCS"
     "_WORLD")
  (vl-cmdf "_UNITS" "2" "4" "1" "0" "0" "_N")
               ;(vl-cmdf "layer" "N" "vertice" "c" "1" "vertice" "")
  (graphscr)
  (vl-cmdf "_LAYER" "_LOCK" "vertice" "")
               
               
               
  (setq ss1 (ssget))
  (setq sc (ssget "P" '((0 . "circle"))))


  (if (= Sc nil)
    (setq Na 0)
    (setq Na (sslength Sc))
  )
  (setq Ka 0)
  (repeat Na
    (setq Et (ssname Sc Ka))
    (setq Et1 (ssname Sc Ka))
    (setq Lt (entget Et))
    (setq Lt1 (entget Et1))


    (setq c1 (cdr (assoc 10 (entget Et))))
    (setq c2 (cdr (assoc 10 (entget Et1))))
    (setq c (mapcar '* (mapcar '+ c1 c2) '(0.5 0.5 0.5)))
    (setq r1 (cdr (assoc 40 (entget Et))))
    (setq r2 (cdr (assoc 40 (entget Et1))))
    (setq r2 (* r2 0.9))
    (setq r (/ (+ r1 r2) 2.0))
    (setq k -1.0)
    (repeat 360
      (setq p (polar c (cvunit (setq k (1+ k)) "degrees" "radians") r))
      (setq pl (cons p pl))
    )
    (setq pl (cons (polar c 0.0 r) pl))
    (command "_.trim" Et Et1 "" "_F")
    (foreach p pl
      (command p)
    )

    (while (> (getvar 'cmdactive) 0) (command ""))
    (princ)

    (setq Ka (+ Ka 1))
  )
  (vl-cmdf "_UCS" "_PREVIOUS")
  (vl-cmdf "_REDRAW")
  (setvar "CMDECHO" 0)
  (vl-cmdf "_UNITS" "2" "3" "2" "3" "90" "_Y")
  (vl-cmdf "_setvar" "angdir" "1")
  (vl-cmdf "_setvar" "angbase" "270")
  (SETVAR "OSMODE" 45)
  (vl-cmdf "_OSNAP" "_END,_CEN,_INT,_NOD")
               
  (vl-cmdf "_LAYER" "_UNLOCK" "vertice" "")
 
)
Si tienen el chance de revisar el lisp, se los agradezco.
Subo también un dwg con el antes y el después para mayor explicación.

Gracias desde ya por su ayuda.

José Francisco

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

Volver arriba Ir abajo

Lisp para "trim Inside Circles" Empty Re: Lisp para "trim Inside Circles"

Mensaje por José Francisco el Miér Sep 25, 2019 10:15 pm


José Francisco

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

Volver arriba Ir abajo

Lisp para "trim Inside Circles" Empty Re: Lisp para "trim Inside Circles"

Mensaje por Admin el Mar Oct 22, 2019 1:23 am

Hola , tengo la solucion , pero no puedo adjuntarlo. Por favor envíame un correo a

devitg@gmail.com


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

Lisp para "trim Inside Circles" Empty Re: Lisp para "trim Inside Circles"

Mensaje por Admin el Mar Oct 22, 2019 3:44 pm


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

Lisp para "trim Inside Circles" Empty Re: Lisp para "trim Inside Circles"

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.