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

Ayuda con Lisp suma de lineas y polilineas

Ir abajo

Ayuda con Lisp suma de lineas y polilineas Empty Ayuda con Lisp suma de lineas y polilineas

Mensaje por vecan Lun Dic 07, 2020 3:53 am

Hola amigos de acad hispano buenas a todos
mi consulta es si se me podrian ayudar a modificar esta rutina lisp, ya que años anteriores funcionaba perfectamente y ahora da error en la version de AUTOCAD 2019

comando: CC2

Indique el tipo de objeto [Polilínea/Línea/Ambas] <Polilínea>

cuando pongo Ambas me da ERROR y la opcion por capa falla.

quisiera que me ayuden a solucionar ese error
quisiera también agregar la opción de colocar el TEXTO directamente
porque lo que tiene la rutina es reemplazar a un texto si se podría.
Que tenga las 2 opciones una de colocar directamente y otra reemplazar
se los agradecería mucho
gracias

Código:

(defun suma ()
  (initget "Polilinea Linea Ambas")
  (setq   tipo
    (getkword
     "\nIndique el tipo de objeto [Polilínea/Línea/Ambas] <Polilínea>: "
    )
  )
  (if (= tipo nil)
    (setq tipo "Polilinea")
  )
  (cond   ((= tipo "Polilinea") (suma-pol))
   ((= tipo "Linea") (suma-lin))
   ((= tipo "Ambas") (suma-amb))
  )
)

(defun suma-pol   ()
  (initget "Capa Seleccion")
  (setq opt (getkword "\nSumar por [Capa/Selección] <Selección>: "))
  (if (= opt nil)
    (setq opt "Seleccion")
  )
  (if (= opt "Seleccion")
    (progn
      (setq polilineas (ssget '((0 . "LWPOLYLINE"))))
      (if (/= polilineas nil)
   (progn
     (setq   n-pol (sslength polilineas)
      n    0
     )
     (repeat n-pol
       (setq nombre (ssname polilineas n))
       (progn
         (command "_.area" "_O" nombre)
         (setq lon (getvar "perimeter"))
         (setq longitud (cons lon longitud))
       )
       (setq n (1+ n))
     )
     (setq lon-total (apply '+ longitud))
          (cambia-texto lon-total)
;;;     (alert (strcat "Longitud total de la(s) Polilínea(s) es : "
;;;          (rtos lon-total)  " ud."
;;;       )
;;;     )
   ) ;_progn
     (alert "No se han encontrado Polilínea(s)")
      ) ;_if
    ) ;_progn
    (progn
      (setq sel-capa
       (cdr
         (assoc 8
            (entget (car (entsel "\nSeleccione entidad: ")))
         )
       )
      )
      (setq polilineas
       (ssget "_x"
          (list '(0 . "LWPOLYLINE") (cons 8 sel-capa))
       )
      )
      (if (/= polilineas nil)
   (progn
     (setq   n-pol (sslength polilineas)
      n    0
     )
     (repeat n-pol
       (setq nombre (ssname polilineas n))
       (if   (= "LWPOLYLINE" (cdr (assoc 0 (entget nombre))))
         (progn
      (command "_.area" "_O" nombre )
      (setq lon (getvar "perimeter"))
      (setq longitud (cons lon longitud))
         )
       )
       (setq n (1+ n))
     )
     (setq lon-total (apply '+ longitud))
          (cambia-texto lon-total)
;;;     (alert
;;;       (strcat "Longitud total de la(s) Polilínea(s) por capa "
;;;          "\""
;;;          sel-capa
;;;          "\""
;;;          " es : "
;;;          (rtos lon-total)  " ud."
;;;       )
;;;     )
   ) ;_progn
   (alert "No se han encontrado Polilínea(s)")
      ) ;_if
    ) ;_progn
  ) ;_if
)

(defun suma-lin   ()
  (initget "Capa Seleccion")
  (setq opt (getkword "\nSumar por [Capa/Selección] <Selección>: "))
  (if (= opt nil)
    (setq opt "Seleccion")
  )
  (if (= opt "Seleccion")
    (progn
      (setq polilineas (ssget '((0 . "LINE"))))
      (if (/= polilineas nil)
   (progn
     (setq   n-pol (sslength polilineas)
      n    0
     )
     (repeat n-pol
       (setq nombre (ssname polilineas n))
           (progn
      (setq p1 (cdr (assoc 10 (entget nombre)))
            p2 (cdr (assoc 11 (entget nombre)))
      )
      (setq distancia-l (distance p1 p2))
      (setq lst-distancia (cons distancia-l lst-distancia))
         )
      
       (setq n (1+ n))
     )
     (setq lon-total (apply '+ lst-distancia))
          (cambia-texto lon-total)
;;;     (alert (strcat "Longitud total de la(s) Línea(s) es : "
;;;          (rtos lon-total) " ud."
;;;       )
;;;     )
   ) ;_progn
   (alert "No se han encontrado Línea(s)")
      ) ;_if
    ) ;_prong
    (progn
      (setq sel-capa
       (cdr
         (assoc 8
            (entget (car (entsel "\nSeleccione entidad: ")))
         )
       )
      )
      (setq polilineas
       (ssget "_x"
          (list '(0 . "LINE") (cons 8 sel-capa))
       )
      )
      (if (/= polilineas nil)
   (progn
     (setq   n-pol (sslength polilineas)
      n    0
     )
     (repeat n-pol
       (setq nombre (ssname polilineas n))
       (if   (= "LINE" (cdr (assoc 0 (entget nombre))))
         (progn
      (setq p1 (cdr (assoc 10 (entget nombre)))
            p2 (cdr (assoc 11 (entget nombre)))
      )
      (setq distancia-l (distance p1 p2))
      (setq lst-distancia (cons distancia-l lst-distancia))
         )
       )
       (setq n (1+ n))
     )
     (setq lon-total (apply '+ lst-distancia))

        (cambia-texto lon-total)
;;;     (alert (strcat "Longitud total de la(s) Línea(s) por capa "
;;;          "\""
;;;          sel-capa
;;;          "\""
;;;          " es : "
;;;          (rtos lon-total) " ud."
;;;       )
;;;     )
   ) ;_progn
   (alert "No se han encontrado Línea(s)")
      ) ;_if
    ) ;_progn
  ) ;_if
)

(defun suma-amb   ()
  (initget "Capa Seleccion")
  (setq opt (getkword "\nSumar por [Capa/Selección] <Selección>: "))
  (if (= opt nil)
    (setq opt "Seleccion")
  )
  (if (= opt "Seleccion")
    (progn
      (setq poli-lineas (ssget '((0 . "*LINE"))))
      (if (/= poli-lineas nil)
   (progn
     (setq   n-pol (sslength poli-lineas)
      n    0
     )
     (repeat n-pol
       (setq nombre (ssname poli-lineas n))
       (command "_.lengthen" nombre "")
       (setq lon (getvar "perimeter"))
       (setq longitud (cons lon longitud))
       (setq n (1+ n))
     )
     (setq lon-total (apply '+ longitud))
          (cambia-texto lon-total)
;;;     (alert (strcat "Longitud total de la(s) *línea(s) es : "
;;;          (rtos lon-total)  " ud."
;;;       )
;;;     )
   ) ;_progn
   (alert "No se han encontrado ninguna entidad(s) válida")
      ) ;_if
    ) ;_progn
    (progn
      (setq sel-capa
       (cdr
         (assoc 8
            (entget (car (entsel "\nSeleccione entidad: ")))
         )
       )
      )
      (setq poli-lineas
       (ssget "_x"
          (list '(0 . "*LINE") (cons 8 sel-capa))
       )
      )
      (if (/= poli-lineas nil)
   (progn
     (setq   n-pol (sslength poli-lineas)
      n    0
     )
     (repeat n-pol
       (setq nombre (ssname poli-lineas n))
       (progn
         (command "_.lengthen" nombre "")
         (setq lon (getvar "perimeter"))
         (setq longitud (cons lon longitud))
       )
       (setq n (1+ n))
     )
     (setq lon-total (apply '+ longitud))
          (cambia-texto lon-total)
;;;     (alert
;;;       (strcat "Longitud total de la(s) *línea(s) por capa "
;;;          "\""
;;;          sel-capa
;;;          "\""
;;;          " es : "
;;;          (rtos lon-total)  " ud."
;;;       )
;;;     )
   ) ;_progn
   (alert "No se han encontrado ninguna entidad(s) válida")
      ) ;_if
    ) ;_progn
  ) ;_if
)
;;********************************************************
;Esta defun cambia el texto
(defun cambia-texto (lon-total)
(setq conj3 (car (entsel "\nSelecionar Texto a Cambiar: "))) (terpri)
      (setq ent (entget conj3))     
      (setq entac (subst (cons 1 (rtos lon-total 2 2)) (assoc 1 ent) ent)); cambia el segundo 2 para determinar el nro de decimales
      (entmod entac)
)
;;********************************************************


(defun c:CC2   (/ tipo         polilineas  n-pol      n
        nombre      lon     longitud    lon-total
        p1         p2     distancia-l lst-distancia
        opt         sel-capa     poli-lineas
        )
  (setvar "cmdecho" 0)
  (suma)
  (setvar "cmdecho" 1)
  (prin1)
)

(prompt "\n*** Nuevo comando SUMA-L v.2 definido. ***")
(prin1)




vecan

Mensajes : 3
Fecha de inscripción : 07/05/2016

http://luiyizevallos.blogspot.com/

Volver arriba Ir abajo

Ayuda con Lisp suma de lineas y polilineas Empty Re: Ayuda con Lisp suma de lineas y polilineas

Mensaje por robierzo Vie Dic 11, 2020 10:12 am

A ver si te sirve así:
Código:
(defun suma ()
  (initget "Polilinea Linea Ambas")
  (setq   tipo
    (getkword
     "\nIndique el tipo de objeto [Polilínea/Línea/Ambas] <Polilínea>: "
    )
  )
  (if (= tipo nil)
    (setq tipo "Polilinea")
  )
  (cond   ((= tipo "Polilinea") (suma-pol))
   ((= tipo "Linea") (suma-lin))
   ((= tipo "Ambas") (suma-amb))
  )
)

(defun suma-pol   ()
  (initget "Capa Seleccion")
  (setq opt (getkword "\nSumar por [Capa/Selección] <Selección>: "))
  (if (= opt nil)
    (setq opt "Seleccion")
  )
  (if (= opt "Seleccion")
    (progn
      (setq polilineas (ssget '((0 . "LWPOLYLINE"))))
      (if (/= polilineas nil)
   (progn
     (setq   n-pol (sslength polilineas)
      n    0
     )
     (repeat n-pol
       (setq nombre (ssname polilineas n))
       (progn
         (command "_.area" "_O" nombre)
         (setq lon (getvar "perimeter"))
         (setq longitud (cons lon longitud))
       )
       (setq n (1+ n))
     )
     (setq lon-total (apply '+ longitud))
          (cambia-texto lon-total)
;;;     (alert (strcat "Longitud total de la(s) Polilínea(s) es : "
;;;          (rtos lon-total)  " ud."
;;;       )
;;;     )
   ) ;_progn
     (alert "No se han encontrado Polilínea(s)")
      ) ;_if
    ) ;_progn
    (progn
      (setq sel-capa
       (cdr
         (assoc 8
            (entget (car (entsel "\nSeleccione entidad: ")))
         )
       )
      )
      (setq polilineas
       (ssget "_x"
          (list '(0 . "LWPOLYLINE") (cons 8 sel-capa))
       )
      )
      (if (/= polilineas nil)
   (progn
     (setq   n-pol (sslength polilineas)
      n    0
     )
     (repeat n-pol
       (setq nombre (ssname polilineas n))
       (if   (= "LWPOLYLINE" (cdr (assoc 0 (entget nombre))))
         (progn
      (command "_.area" "_O" nombre )
      (setq lon (getvar "perimeter"))
      (setq longitud (cons lon longitud))
         )
       )
       (setq n (1+ n))
     )
     (setq lon-total (apply '+ longitud))
          (cambia-texto lon-total)
;;;     (alert
;;;       (strcat "Longitud total de la(s) Polilínea(s) por capa "
;;;          "\""
;;;          sel-capa
;;;          "\""
;;;          " es : "
;;;          (rtos lon-total)  " ud."
;;;       )
;;;     )
   ) ;_progn
   (alert "No se han encontrado Polilínea(s)")
      ) ;_if
    ) ;_progn
  ) ;_if
)

(defun suma-lin   ()
  (initget "Capa Seleccion")
  (setq opt (getkword "\nSumar por [Capa/Selección] <Selección>: "))
  (if (= opt nil)
    (setq opt "Seleccion")
  )
  (if (= opt "Seleccion")
    (progn
      (setq polilineas (ssget '((0 . "LINE"))))
      (if (/= polilineas nil)
   (progn
     (setq   n-pol (sslength polilineas)
      n    0
     )
     (repeat n-pol
       (setq nombre (ssname polilineas n))
           (progn
      (setq p1 (cdr (assoc 10 (entget nombre)))
            p2 (cdr (assoc 11 (entget nombre)))
      )
      (setq distancia-l (distance p1 p2))
      (setq lst-distancia (cons distancia-l lst-distancia))
         )
      
       (setq n (1+ n))
     )
     (setq lon-total (apply '+ lst-distancia))
          (cambia-texto lon-total)
;;;     (alert (strcat "Longitud total de la(s) Línea(s) es : "
;;;          (rtos lon-total) " ud."
;;;       )
;;;     )
   ) ;_progn
   (alert "No se han encontrado Línea(s)")
      ) ;_if
    ) ;_prong
    (progn
      (setq sel-capa
       (cdr
         (assoc 8
            (entget (car (entsel "\nSeleccione entidad: ")))
         )
       )
      )
      (setq polilineas
       (ssget "_x"
          (list '(0 . "LINE") (cons 8 sel-capa))
       )
      )
      (if (/= polilineas nil)
   (progn
     (setq   n-pol (sslength polilineas)
      n    0
     )
     (repeat n-pol
       (setq nombre (ssname polilineas n))
       (if   (= "LINE" (cdr (assoc 0 (entget nombre))))
         (progn
      (setq p1 (cdr (assoc 10 (entget nombre)))
            p2 (cdr (assoc 11 (entget nombre)))
      )
      (setq distancia-l (distance p1 p2))
      (setq lst-distancia (cons distancia-l lst-distancia))
         )
       )
       (setq n (1+ n))
     )
     (setq lon-total (apply '+ lst-distancia))

        (cambia-texto lon-total)
;;;     (alert (strcat "Longitud total de la(s) Línea(s) por capa "
;;;          "\""
;;;          sel-capa
;;;          "\""
;;;          " es : "
;;;          (rtos lon-total) " ud."
;;;       )
;;;     )
   ) ;_progn
   (alert "No se han encontrado Línea(s)")
      ) ;_if
    ) ;_progn
  ) ;_if
)

(defun suma-amb   ()
  (setq opt nil)
  (initget "Capa Seleccion")
  (setq opt (getkword "\nSumar por [Capa/Selección] <Selección>: "))
  (if (= opt nil)
    (setq opt "Seleccion")
  )
  (cond ((= opt "Seleccion")
 (setq poli-lineas (ssget '((0 . "*LINE"))))
 (setq n 0 lon-total 0)
 (repeat (sslength poli-lineas)
   (setq nombre (ssname poli-lineas n))
   (setq obj (vlax-ename->vla-object nombre))
   (setq lon1 (vlax-get-property obj 'Length))
   (setq lon-total (+ lon-total lon1))
   (setq n (1+ n))
 )
 )
 ((= opt "Capa")
 (setq sel-capa (cdr (assoc 8 (entget (car (entsel "\nSeleccione entidad: "))))))
         (setq poli-lineas (ssget "_x" (list '(0 . "*LINE") (cons 8 sel-capa))))
 (setq n 0 lon-total 0)
 (repeat (sslength poli-lineas)
   (setq nombre (ssname poli-lineas n))
   (setq obj (vlax-ename->vla-object nombre))
   (setq lon1 (vlax-get-property obj 'Length))
   (setq lon-total (+ lon-total lon1))
   (setq n (1+ n))
 )
 )
  )      
  (cambia-texto lon-total)
)
;;********************************************************
;Esta defun cambia el texto
(defun cambia-texto (lon-total)
  (setq opcion1 nil)
  (initget 128 "N")
  (setq opcion1 (entsel "\nSelecionar Texto a Cambiar / N para nuevo texto: "))
  (cond ((or (= opcion1 nil)(= opcion1 "N"))
 (setq pt_inser (getpoint "\nIndica el punto de inserción del texto: "))
 (initget 3)
 (setq altura_texto (getreal "\nIndica la altura de texto: "))
 ;(setq pt_inser
 (entmake
   (list
     '(0 . "TEXT")
             '(100 . "AcDbEntity")
             '(100 . "AcDbText")
              (cons 10 pt_inser)
              (cons 1 (rtos lon-total 2 2))
              (cons 11 pt_inser)
      (cons 40 altura_texto)
   )
 )
 )
 ((= (type opcion1) 'LIST)
 (setq ent (entget (car opcion1)))
 (setq entac (subst (cons 1 (rtos lon-total 2 2)) (assoc 1 ent) ent)); cambia el segundo 2 para determinar el nro de decimales
         (entmod entac)
 )
  )
)
;;********************************************************


(defun c:CC2   (/ tipo         polilineas  n-pol      n
        nombre      lon     longitud    lon-total
        p1         p2     distancia-l lst-distancia
        opt         sel-capa     poli-lineas
        )
  (vl-load-com)
  (setvar "cmdecho" 0)
  (suma)
  (setvar "cmdecho" 1)
  (prin1)
)

(prompt "\n*** Nuevo comando CC2 v.2 definido. ***")
(prin1)
robierzo
robierzo

Mensajes : 69
Fecha de inscripción : 17/03/2016
Localización : La Coruña

http://www.selmotopografia.es

A vecan le gusta esta publicaciòn

Volver arriba Ir abajo

Ayuda con Lisp suma de lineas y polilineas Empty Re: Ayuda con Lisp suma de lineas y polilineas

Mensaje por vecan Lun Dic 14, 2020 5:40 pm

Si funciona perfectamente gracias amigo Robierzo

vecan

Mensajes : 3
Fecha de inscripción : 07/05/2016

http://luiyizevallos.blogspot.com/

Volver arriba Ir abajo

Ayuda con Lisp suma de lineas y polilineas Empty Re: Ayuda con Lisp suma de lineas y polilineas

Mensaje por Contenido patrocinado


Contenido patrocinado


Volver arriba Ir abajo

Volver arriba


 
Permisos de este foro:
No puedes responder a temas en este foro.