acad hispano
¿Quieres reaccionar a este mensaje? Regístrate en el foro con unos pocos clics o inicia sesión para continuar.

INVERTIR VÉRTICES DE POLILINEA

+2
carlosmgilp
Jap_AI
6 participantes

Ir abajo

INVERTIR VÉRTICES DE POLILINEA Empty INVERTIR VÉRTICES DE POLILINEA

Mensaje por Jap_AI Jue Abr 12, 2018 6:11 pm

Hola a todos:
Espero que me podáis ayudar. debido a la rotura de mi ordenador he perdido parte de la información que contenía, entre ella la carpeta donde guardaba mis LISP.
Necesito encontrar el LISP que cambiaba la dirección de los vertices de la polilinea.

Un saludo y gracias

Jap_AI

Mensajes : 2
Fecha de inscripción : 31/03/2016
Localización : Euskadi

Volver arriba Ir abajo

INVERTIR VÉRTICES DE POLILINEA Empty Re: INVERTIR VÉRTICES DE POLILINEA

Mensaje por carlosmgilp Jue Abr 12, 2018 7:15 pm

Hola como estas.
Autocad tiene su propio comando que se llama reverse y funciona con polilineas, lineas, arcos, helix, etc.
Y así no tienes que tener una aplicación aparte.
Saludos.

carlosmgilp

Mensajes : 149
Fecha de inscripción : 17/03/2016
Edad : 42
Localización : Venezuela

Volver arriba Ir abajo

INVERTIR VÉRTICES DE POLILINEA Empty Re: INVERTIR VÉRTICES DE POLILINEA

Mensaje por Luis Alberto Benitez Vie Abr 13, 2018 9:31 pm

Jap.
Aquí encontré Uno
Código:
; Reverse.lsp - invierte la dimensión, el texto, la línea, el arco, el círculo, la elipse, la spline o la polilínea
; Invierte el Inicio de Polilinea 3d y 2d
; copyright(c)2005 Tom Davis <tdavis@eng.usf.edu>
; Invierte todas las entidades de texto, línea, arco, círculo, elipse, spline y polilínea.
; Preserva el color, la capa, el tipo de línea, la escala de tipo de línea, el estilo de trazado,
; Espesor, elevación, anchura global y propiedades de justificación. Conservas
; Circular, cuadrático y cúbico. Preserva la protuberancia del vértice, segmento
; Anchura y vértice tangente.
;
; El soporte de cotas se limita al texto de cota centrado verticalmente. Radial
; Y el texto de la dimensión del diámetro también deben ser desalineados.
;
; Referencias:
;  RvrsLine by CAD Studio
;    http://www.cadforum.cz/cadforum_en/qaID.asp?tip=4570
;  Reverse by Jeff Foster
;    http://www.cadresource.com/library/lispps.html
;  Reverse Polyline by Joseph Kappel
;    http://new.cadalyst.com/code/browseyear.cfm?fullyear=2000
;  3DPEDIT by Glenn Wilson
;    http://www.cadinfo.net/scripts/lisplib-software.cfm?areano=331
;  PLREV by Tee Square Graphics
;    http://www.turvill.com/t2/free_stuff/plrev.lsp
;  RPOLY
;    http://www.vizikos.com/lisp/rpoly.lsp
;  ELL2P by Fuccaro
;    http://www.cadtutor.net/forum/viewtopic.php?t=1721
;  [23] Polylines
;    http://www.faqs.org/faqs/CAD/autolisp-faq/part2/section-5.html

(defun c:reverse1 ( / oldecho oldsnap e etyp)
  ;reverse dimension, text, line, arc, circle, ellipse, spline, or polyline
  (setq oldecho (getvar "cmdecho")
        oldsnap (getvar "osmode")
  )
  (setvar "cmdecho" 0)                                          ;Apagar el eco
  (if (< oldsnap 16384) (setvar "osmode" (+ oldsnap 16384)))    ;Apagar el osnap
  (setvar "OSMODE" 0)                                ;Anular la selección de todo
  (while (setq e (car (entsel "\nSeleccionar objeto a revertir: ")))
    (setq etyp (cdr (assoc 0 (entget e))))
    (command "_undo" "_begin")
    (cond
      ((= etyp "LWPOLYLINE")(revlwpline e))
      ((= etyp "POLYLINE")  (revhwpline e))
      ((= etyp "LINE")      (revline    e))
      ((= etyp "ARC")      (revarc    e))
      ((= etyp "CIRCLE")    (revcircle  e))
      ((= etyp "ELLIPSE")  (revellipse e))
      ((= etyp "MTEXT")    (revmtext  e))
      ((= etyp "TEXT")      (revtext    e))
      ((= etyp "RTEXT")    (revrtext  e))
      ((= etyp "DIMENSION") (revdim    e))
      ((= etyp "SPLINE")    (command "_splinedit" e "e" ""))
      (t (prompt (strcat " selected " etyp)))
    )
    (command "_undo" "_end")
  )
  (setvar "cmdecho" oldecho)
  (setvar "osmode"  oldsnap)
  (princ)
)
;------------------------------------------------------------------------------
;LWPOLYLINE
(defun revlwpline (e / footer header vertices done)
  ;reverse lw polyline
  (foreach item (reverse (entget e))
    (cond
      ((not done)
        (cond
          ((= (car item) 40)
            (setq footer (cons (cons 41 (cdr item)) footer)      ;Ancho de intercambio
                  done t
            )
          )
          ((= (car item) 41)
            (setq footer (cons (cons 40 (cdr item)) footer))    ;Ancho de intercambio
          )
          ((= (car item) 42)
            (setq footer (cons (cons 42 (- (cdr item))) footer)) ;Negar bulto
          )
          ((= (car item) 210)
            (setq footer (cons item footer))
          )
        )
      )
      ((= (car item) 10)
        (setq vertices (cons item vertices))
      )
      ((= (car item) 40)
        (setq vertices (cons (cons 41 (cdr item)) vertices))    ;Ancho de intercambio
      )
      ((= (car item) 41)
        (setq vertices (cons (cons 40 (cdr item)) vertices))    ;Ancho de intercambio
      )
      ((= (car item) 42)
        (setq vertices (cons (cons 42 (- (cdr item))) vertices)) ;Negar bulto
      )
      (t (setq header (cons item header)))
    )
  )
  (setq flag (assoc 70 header))
  (if (< (cdr flag) 128)                ;Activar la generación de tipo de línea
    (setq header (subst (cons 70 (+ (cdr flag) 128)) flag header))
  )
  (entmod (append header (reverse vertices) footer))
)
;------------------------------------------------------------------------------
;POLYLINE
(defun revhwpline (e /
  oldname old ent1 buldge end start ent tangent radians vertex vertices flag)
  ;Inversa hw polilínea
  (setq oldname  e
        old  (entget oldname)
        e    (entnext e)
        ent1  (entget e)                ;Obtener el primer vértice
        bulge (cdr (assoc 42 ent1))
        end  (cdr (assoc 41 ent1))
        start (cdr (assoc 40 ent1))
        e    (entnext e)
        ent  (entget e)                ;Obtener segundo vértice
  )
  (while (= (cdr (assoc 0 ent)) "VERTEX")
    (if (= (logand (cdr (assoc 70 ent)) 2) 2)
      (setq tangent (assoc 50 ent)
            radians (- (cdr tangent) pi) ;Tangente inversa
            ent    (subst (cons 50 radians) tangent ent)
      )
    )
    (setq vertex  (subst (cons 42 (- bulge))(assoc 42 ent) ent)    ;Negar bulto
          vertex  (subst (cons 41 start)    (assoc 41 ent) vertex) ;Ancho de intercambio
          vertex  (subst (cons 40 end)      (assoc 40 ent) vertex) ;Ancho de intercambio
          bulge    (cdr  (assoc 42 ent))                       
          end      (cdr  (assoc 41 ent))
          start    (cdr  (assoc 40 ent))
          vertices (cons vertex vertices)
          e        (entnext e)
          ent      (entget e)            ;Obtener el siguiente vértice o seqend
    )
  )
  (setq flag (assoc 70 old))
  (if (< (cdr flag) 128)                ;Activar la generación de tipo de línea
    (setq old (subst (cons 70 (+ (cdr flag) 128)) flag old))
  )
  (entmake old)                          ;Hacer nueva polilínea
  (foreach ent vertices (entmake ent))  ;Hacer nuevos vértices
  (if (= (logand (cdr (assoc 70 ent1)) 2) 2)
    (setq tangent (assoc 50 ent1)
          radians (- (cdr tangent) pi)  ;Tangente inversa
          ent1    (subst (cons 50 radians) tangent ent1)
    )
  )
  (setq ent1 (subst (cons 42 (- bulge))(assoc 42 ent1) ent1) ;Negar bulto
        ent1 (subst (cons 41 start)    (assoc 41 ent1) ent1) ;Ancho de intercambio
        ent1 (subst (cons 40 end)      (assoc 40 ent1) ent1) ;Ancho de intercambio
  )
  (entmake ent1)                        ;make last new vertex
  (entmake ent)                          ;make new seqend
  (entdel oldname)                      ;delete old polyline
)
;------------------------------------------------------------------------------
;LINE
(defun revline (e / ent start end)
  ;swap line endpoints
  (setq ent  (entget e)
        start (assoc 10 ent)
        end  (assoc 11 ent)
        ent  (subst (cons 10 (cdr end)) start ent)
        ent  (subst (cons 11 (cdr start)) end ent)
  )
  (entmod ent)
)
;------------------------------------------------------------------------------
;ARC
(defun revarc (e)
  ;reverse arc
  (command "_pedit" e "y" "l" "on" "")    ;Convertir arco en polilínea
  (setq e (entlast))
  (if (> (getvar "plinetype") 0)
    (revlwpline e)
    (revhwpline e)
  )
)
;------------------------------------------------------------------------------
;CIRCLE
(defun revcircle (e / ent radius center pt1 pt2)
  ;reverse circle
  (setq ent    (entget e)
        radius (cdr (assoc 40 ent))
        center (cdr (assoc 10 ent))
        pt1    (mapcar '+ center (list radius 0 0))
        pt2    (mapcar '- center (list radius 0 0))
  )
  (command "_break" e pt1 pt2)            ;Gire el círculo en semicírculo
  (command "_pedit" e "y" "l" "on" "c" "");Gire semicírculo en polilínea cerrada
  (setq e (entlast))
  (if (> (getvar "plinetype") 0)
    (revlwpline e)
    (revhwpline e)
  )
)
;------------------------------------------------------------------------------
;DIMENSION
(defun revdim (e / ent ang rot)
  ;reverse dimension text
  (command "_undo" "mark")
  (command "dimstyle" "restore" "" e)
  (command "_dimblk"  "none")
  (command "_dimblk1" "none")
  (command "_dimblk2" "none")
  (command "_dimcen" 0)
  (command "_dimstyle" "apply" e "")
  (command "_explode" e)
  (setq ent (entget (entlast))
        ang (cdr (assoc 50 ent))                ;Rotación de mtext
  )
  (command "_undo" "back")
  (setq ent (entget e)
        rot (assoc 53 ent)                      ;Rotación de texto de dimensión
        ang (rem (+ ang pi) (* 2 pi))            ;Normalizar el ángulo
        ent (subst (cons 53 ang) rot ent)
  )
  (entmod ent)
)
;------------------------------------------------------------------------------
;RTEXT
(defun revrtext (e / ent ins w h rot ang hd vd new)
  ;reverse rtext
  (command "_explode" e)                          ;Explotar el texto en mtext
  (setq ent  (entget (entlast))                  ;Obtener mtext
        w    (cdr (assoc 42 ent))                ;ancho
        h    (cdr (assoc 43 ent))                ;Altura
  )
  (command "_undo" "1")
  (setq ent  (entget e)                          ;Obtener texto
        ins  (assoc 10 ent)                      ;punto de inserción
        rot  (assoc 50 ent)                      ;rotacion
        ang  (cdr rot)
        hd  (polar '(0 0 0)    ang          w) ;Desplazamiento horizontal
        vd  (polar '(0 0 0) (- ang (/ pi 2)) h) ;Desplazamiento vertical
        new  (mapcar '+ (cdr ins) hd vd)        ;Nuevo punto de inserción
        ang  (rem (+ ang pi) (* 2 pi))          ;Normalizar el ángulo
        ent  (subst (cons 50 ang) rot ent)      ;direccion contraria
        ent  (subst (cons 10 new) ins ent)      ;Establecer nuevo punto de inserción

  )
  (entmod ent)
)
;------------------------------------------------------------------------------
;TEXT
(defun revtext (e / ent box hj vj rot ang p1 p2 w h dist phi hd vd new)
  ;reverse text
  (setq ent  (entget e)
        box  (textbox ent)
        hj  (cdr (assoc 72 ent))                    ;Justificación horizontal
        vj  (cdr (assoc 73 ent))                    ;Justificación vertical
        rot  (assoc 50 ent)                          ;rotacion
        ang  (cdr rot)                              ;angulo
        p1  (assoc 10 ent)                          ;Primer punto de alineación
        p2  (assoc 11 ent)                          ;Segundo punto de alineación
        w    (- (caadr box) (caar box))              ;ancho
        h    (cdr (assoc 40 ent))                    ;Altura
  )
  (if (= vj 1)                          ;bottom
    (setq dist (distance (cdr p1) (cdr p2))
          phi  (angle    (cdr p1) (cdr p2))
          dist (* dist (sin (- phi ang)))            ;Profundidad de descenso
          h    (+ h (abs dist))
    )
  )
  (setq hd  (polar '(0 0 0)    ang          w)    ;Desplazamiento horizontal
        vd  (polar '(0 0 0) (+ ang (/ pi 2)) h)    ;Desplazamiento vertical
  )
  (cond                                  ;Calcular un nuevo punto de alineación
    ((and (= vj 1) (= hj 0))            ;Abajo a la izquierda
      (setq new  (mapcar '+ (cdr p2) hd vd))
    )
    ((and (= vj 2) (= hj 0))            ;Medio izquierdo
      (setq new  (mapcar '+ (cdr p2) hd))
    )
    ((and (= vj 3) (= hj 0))            ;arriba a la izquierda
      (setq new (mapcar '+ (cdr p2) hd)
            new (mapcar '- new vd)
      )
    )
    ((or (and (= vj 0) (= hj 1))        ;center or
        (and (= vj 1) (= hj 1)))        ;bottom center
      (setq new (mapcar '+ (cdr p2) vd))
    )
    ((or (and (= vj 0) (= hj 4))        ;Medio o
        (and (= vj 2) (= hj 1)))        ;Centro medio
      (setq new (cdr p2))
    )
    ((and (= vj 3) (= hj 1))            ;centro Superior
      (setq new  (mapcar '- (cdr p2) vd))
    )
    ((or (and (= vj 0) (= hj 2))        ;Derecho o
        (and (= vj 1) (= hj 2)))        ;abajo a la derecha
      (setq new (mapcar '- (cdr p2) hd)
            new (mapcar '+ new vd)
      )
    )
    ((and (= vj 2) (= hj 2))            ;Medio derecho
      (setq new  (mapcar '- (cdr p2) hd))
    )
    ((and (= vj 3) (= hj 2))            ;parte superior derecha
      (setq new  (mapcar '- (cdr p2) hd vd))
    )
  )
  (cond
    ((= (+ hj vj) 0)                    ;izquierda
      (setq new  (mapcar '+ (cdr p1) hd vd)
            ent (subst (cons 10 new) p1 ent)        ;Establecer un nuevo punto de alineación
            ent (subst (cons 50 (+ ang pi)) rot ent) ;direccion contraria
      )
    )
    ((or (= hj 5) (= hj 3))              ;Ajustado o alineado
      (setq new (mapcar '+ (cdr p2) vd)
            ent (subst (cons 10 new) p1 ent)        ;Intercambiar puntos de alineación
            new (mapcar '+ (cdr p1) vd)
            ent (subst (cons 11 new) p2 ent)
      )
    )
    (t
      (setq ent (subst (cons 11 new) p2 ent)        ;Establecer un nuevo punto de alineación
            ent (subst (cons 50 (+ ang pi)) rot ent) ;direccion contraria
      )
    )
  )
  (entmod ent)
)
;------------------------------------------------------------------------------
;MTEXT
(defun revmtext (e / ent ins w h just rot hd vd new)
  ;reverse mtext
  (setq ent  (entget e)
        ins  (assoc 10 ent)              ;punto de inserción
        w    (cdr (assoc 42 ent))        ;Ancho
        h    (cdr (assoc 43 ent))        ;Altura
        just (cdr (assoc 71 ent))        ;justificacion
        rot  (assoc 50 ent)              ;rotacion
        hd  (polar '(0 0 0)    (cdr rot)          w)  ;Desplazamiento horizontal
        vd  (polar '(0 0 0) (- (cdr rot) (/ pi 2)) h)  ;Desplazamiento vertical
        ent  (subst (cons 50 (+ (cdr rot) pi)) rot ent) ;direccion contraria
  )
  (cond                                  ;Calcular nuevo punto de inserción
    ((= just 1)                          ;arriba a la izquierda
      (setq new (mapcar '+ (cdr ins) hd vd))
    )
    ((= just 2)                          ;centro Superior
      (setq new (mapcar '+ (cdr ins) vd))
    )
    ((= just 3)                          ;parte superior derecha
      (setq new (mapcar '- (cdr ins) hd)
            new (mapcar '+ new vd)
      )
    )
    ((= just 4)                          ;Medio izquierdo
      (setq new (mapcar '+ (cdr ins) hd))
    )
    ((= just 5)                          ;Centro medio
      (setq new (cdr ins))
    )
    ((= just 6)                          ;Medio derecho
      (setq new (mapcar '- (cdr ins) hd))
    )
    ((= just 7)                          ;Abajo a la izquierda
      (setq new (mapcar '+ (cdr ins) hd)
            new (mapcar '- new vd)
      )
    )
    ((= just 8)                          ;parte inferior central
      (setq new (mapcar '- (cdr ins) vd))
    )
    ((= just 9)                          ;abajo a la derecha
      (setq new (mapcar '- (cdr ins) hd vd))
    )
  )
  (setq ent (subst (cons 10 new) ins ent))  ;Establecer nuevo punto de inserción
  (entmod ent)
)
;------------------------------------------------------------------------------
;ELLIPSE
(defun revellipse (e / old oldent center p1 ratio start end major a b rot
                      minor inc tol 2pi i j phi tan ent)
  ;Elipse reversa
  (setq old    e
        oldent (entget old)
        center (cdr (assoc 10 oldent))
        p1    (cdr (assoc 11 oldent))
        ratio  (cdr (assoc 40 oldent))
        start  (cdr (assoc 41 oldent))
        end    (cdr (assoc 42 oldent))
        major  (mapcar '+ center p1)
        a      (distance center major)
        b      (* ratio a)
        rot    (angle center major)
        minor  (polar center (+ rot (/ pi 2)) b)
  )
  (setq inc 64                          ;Número de vértices en la elipse completa
        tol 1e-5                        ;Tolerancia de cierre
        2pi (* 2 pi)
        i  (1+ (fix (+ (* (/ inc 2pi) start) 0.5))) ;Índice de comienzo
        j      (fix (+ (* (/ inc 2pi)  end) 0.5))  ;Índice final
        phi (list start)
  )
  (while (< i j)                        ;build parameter list
    (setq phi (cons (* (/ 2pi inc) i) phi)
          i  (1+ i)
    )
  )
  (if (and (< start tol) (< (abs (- end 2pi)) tol))
    (setq closed t)
    (setq closed nil
          phi    (cons end phi)
    )
  )
  ;Elipse paramétrica en el sistema de coordenadas del objeto
  ;  x = a cos(q);  y = b sin(q);  r = b/a
  ;  dx/dq = -a sin(q);  dy/dq = b cos(q)
  ;  dy/dx = -b/a cot(q) = -r^2 x/y
  ;  tangent direction = atan(dy/dx)
 
  (setq p  (mapcar '(lambda (q)        ;Calcular los puntos OCS en la elipse
                      (list (* a (cos q)) (* b (sin q)))
                    )
                    phi
            )
        tan (mapcar '(lambda (q)        ;Calcular las direcciones tangentes WCS
                      (+ (atan (* (- (expt ratio 2)) (car q)) (cadr q)) rot)
                    )
                    p
            )
  )
  (command "_ucs" "n" "3" center major minor)        ;Crear OCS
  (setq p (mapcar '(lambda (q)(trans q 1 0)) p))    ;Transformar de OCS a WCS
  (command "ucs" "p")                                ;Restaurar UCS
  (command "_pline")
  (mapcar 'command p)
  (command "")
  (command "_matchprop" old (entlast) "")
  (if closed
    (command "_pedit" (entlast) "l" "on" "c" "f" "")  ;Forzar la creación de hwpline
    (command "_pedit" (entlast) "l" "on"    "f" "")
  )
  (setq e  (entnext (entlast))
        ent (entget e)                  ;Obtener el primer vértice
        i  0
  )
  (while (= (cdr (assoc 0 ent)) "VERTEX")
    (setq flag (assoc 70 ent))
    (if (/= (logand (cdr flag) 1) 1)    ;Saltar los vértices de ajuste de la curva
      (progn                            ;Conjunto tangente y bit de bandera
        (setq ent  (subst (cons 50 (nth i tan)) (assoc 50 ent) ent)
              i    (1+ i)
              ent  (subst (cons 70 (+ (cdr flag) 2)) flag ent)
        )
        (entmod ent)
      )
    )
    (setq e    (entnext e)
          ent  (entget e)                ;Obtener el siguiente vértice o seqend
    )
  )
  (command "_pedit" (entlast) "f" "")    ;Actualizar
  (entdel old)                          ;Eliminar elipse
)
(princ)
(princ "\nLlamar con reverse1
Un Saludo
Luis

Luis Alberto Benitez

Mensajes : 112
Fecha de inscripción : 29/03/2016

Volver arriba Ir abajo

INVERTIR VÉRTICES DE POLILINEA Empty Re: INVERTIR VÉRTICES DE POLILINEA

Mensaje por kasperle Lun Abr 16, 2018 2:06 pm

Otra posibilidad...
Código:
(defun C:TEST (/ crd cre len oba)
  (vl-load-com)
  (princ "\nSeleccionar Polilínea: ")
  (while (null oba)
    (setq oba (vl-catch-all-apply 'ssget (list "_:S+." (list (cons 0 "LWPOLYLINE")))))
    (and oba
      (cond
        ((vl-catch-all-error-p oba)
         (setq oba T)
         )
        (T
         (setq oba (vlax-ename->vla-object (ssname oba 0)))
         (setq len (/ (length (setq crd (vlax-safearray->list (vlax-variant-value (vla-get-coordinates oba))))) 2))
         (repeat len
           (setq cre (cons (nth 1 crd) cre))
           (setq cre (cons (nth 0 crd) cre))
           (setq crd (cdr (cdr crd)))
           )
         (vla-put-coordinates oba (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length cre)))) cre)))
         (vlax-release-object oba)
         (gc)
         )
        )
      )
    )
  (princ)
  )

Un saludo.

kasperle

Mensajes : 28
Fecha de inscripción : 18/03/2016

Volver arriba Ir abajo

INVERTIR VÉRTICES DE POLILINEA Empty Re: INVERTIR VÉRTICES DE POLILINEA

Mensaje por nolo Mar Abr 17, 2018 6:20 pm

Hola Kasperle, saludos
Tu rutina me falla en las curvas y no se como se controla el bulge de la curva en vlisp
Al final me he hecho esto
Código:
(defun c:repol( / ent enta tem)
(setq ent (entget (car (entsel "\nSeleccionar 2DPolilínea: ")))
   enta (member(assoc 10 ent)ent)
   p (vl-remove-if '(lambda(a)(/= (car a) 10))enta)
)
(entmod
(apply 'append (list
;; cabecera
(reverse(cdr(member (car p) (reverse ent))))
;; invertir puntos
(setq tem (reverse(mapcar '(lambda(x / n) (setq n (member x enta))
   (mapcar '(lambda(a / b) (setq b (assoc a n))
        ;; invertir bulge
      (if (= a 42) (cons 42 (- (cdr b))) b))'(40 41 42 91))
   )p))
      ;; corregir orden dxf de los tramos
   tem (append (cdr tem)(list(last tem)))
   tem (apply 'append(mapcar 'cons (reverse p) tem))
)
; extrusion
(list(last ent)))
))
(princ)
)

Pero si sabes como controlarlo desde vlisp y tienes tiempo para corregirlo, agradecería que me lo enseñaras .....
Un saludo

nolo

Mensajes : 182
Fecha de inscripción : 17/03/2016

Volver arriba Ir abajo

INVERTIR VÉRTICES DE POLILINEA Empty Re: INVERTIR VÉRTICES DE POLILINEA

Mensaje por Dominguez Mar Abr 17, 2018 11:30 pm

Aqui hay otra opcion para invertir polilineas.
Código:
 ; Invierte principio y final de una polilinea
 ; Program by Tony Hotchkiss.  Enter RPL to start the program.
;;;oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
(defun dxf (code ename) (cdr (assoc code (entget ename)))) ;_ end of dxf
;;;oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
(defun c:rpl ()
  (setq again nil)
  (setq p-ent nil)
  (prompt "\nSelecciona polilinea: ")
  (while (not p-ent)
      (setq p-ent (car (entsel)))
      (if (not p-ent)
        (prompt "\nNingun objeto selecionado; selecciona otra vez: ")
        (progn (if (and (/= (dxf 0 p-ent) "POLYLINE") (/= (dxf 0 p-ent) "LWPOLYLINE"))
                  (progn (prompt "\nNingun objeto selecionado; selecciona otra vez: ") (setq p-ent nil))
                )
        )
      )
  )
  (setq etype    (dxf 0 p-ent)
        x-ent    p-ent
        is-closed (dxf 70 p-ent)
  )
  (if (= etype "LWPOLYLINE")
      (progn (setq num-vert (dxf 90 p-ent)
                  elist    (entget p-ent)
                  elist    (member (assoc 10 elist) elist)
                  vvlist  nil
            )
            (repeat num-vert
                (setq vlist (list (cdr (assoc 10 elist))))
                (setq vlist (append vlist (list (cdr (assoc 42 elist)))))
                (setq vvlist (append vvlist (list vlist)))
                (setq elist (cdr elist)
                      elist (member (assoc 10 elist) elist)
                )
            )
      )
      (progn (setq vvlist nil
                  p-ent  (entnext p-ent)
            )
            (while (/= "SEQEND" (cdr (assoc 0 (entget p-ent))))
                (setq vlist (list (dxf 10 p-ent)))
                (setq vlist (append vlist (list (dxf 42 p-ent))))
                (setq vvlist (append vvlist (list vlist)))
                (setq p-ent (entnext p-ent))
            )
      )
  )
  (setq p-list  (mapcar 'car vvlist)
        p-list  (reverse p-list)
        b-list  (mapcar 'cadr vvlist)
        b-list  (reverse b-list)
        b-first (car b-list)
        b-list  (cdr b-list)
        b-list  (append b-list (list b-first))
        b-list  (mapcar '- b-list)
  )
  (setq enlist (list '(0 . "LWPOLYLINE")
                      '(100 . "AcDbEntity")
                      '(100 . "AcDbPolyline")
                      (cons 90 (length p-list))
                      (cons 70 (dxf 70 x-ent))
                      (cons 8 (dxf 8 x-ent))
                )
  )
  (setq elst nil)
  (repeat (length p-list)
      (setq elst (append elst (list (cons 10 (car p-list)))))
      (setq elst (append elst (list (cons 42 (car b-list)))))
      (setq p-list (cdr p-list))
      (setq b-list (cdr b-list))
  )
  (setq enlist (append enlist elst))
  (entdel x-ent)
  (entmake enlist)
  (prompt "\nPolyline direction is reversed.\n ")
  (princ)
)
;;;oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
Saludos
Dominguez
Dominguez

Mensajes : 151
Fecha de inscripción : 20/03/2016
Edad : 74
Localización : Zaragoza (España)

Volver arriba Ir abajo

INVERTIR VÉRTICES DE POLILINEA Empty Re: INVERTIR VÉRTICES DE POLILINEA

Mensaje por kasperle Miér Abr 18, 2018 2:23 pm

Pues tienes razón, nolo... no había caído en los bulges (campo para investigar).

Un saludo,

kasperle

Mensajes : 28
Fecha de inscripción : 18/03/2016

Volver arriba Ir abajo

INVERTIR VÉRTICES DE POLILINEA Empty Re: INVERTIR VÉRTICES DE POLILINEA

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.