Unir 3DPOLY

Ir abajo

Unir 3DPOLY Empty Unir 3DPOLY

Mensaje por saulo2016 el Vie Ene 18, 2019 12:34 am

Hola a todos

Tengo varias 3DPOLY en un modelo 3D, pero necesito unirlas.

Alguien tendrá alguna rutina que haga esto??

Utilizo AutoCAD Plant 3D 2019


Saludos
saulo2016
saulo2016

Mensajes : 163
Fecha de inscripción : 17/03/2016
Edad : 53
Localización : Monterrey, Nuevo León, Mexico

Ver perfil de usuario

Volver arriba Ir abajo

Unir 3DPOLY Empty Re: Unir 3DPOLY

Mensaje por Luis Alberto Benitez el Sáb Ene 19, 2019 2:01 pm

Saulo aquí tienes uno que lo uso espero te sea de utilidad.
Un Saludo.
Código:
;La rutina junta curvas 3dpol en una sola. La condición es que deben
;tocarse en sus extremos. Se pueden juntar sucesivamente 3dpol.

;La función inicial solicita señalar las 3dpol a unir. Se establecen
;controles para rechazar entidades que no sean 3dpol, y para prevenir
;que se designe la misma 3dpol.

(DEFUN inic_unepol ( )
  (WHILE (NOT (SETQ polb (ENTSEL "\nDesignar 3dpol: "))))
  (SETQ polb (CAR polb))
  (WHILE (OR (/= (CDR (ASSOC 0 (ENTGET polb))) "POLYLINE")
             (/= 1 (FIX (/ (CDR (ASSOC 70 (ENTGET polb))) 8))))
    (PROMPT "\nEntidad designada no es 3dpol")(TERPRI)
    (WHILE (NOT (SETQ polb (ENTSEL "\nDesignar 3dpol: "))))
    (SETQ polb (CAR polb))
  )
    (WHILE (NOT (SETQ polj (ENTSEL "\nDesignar 3dpol a juntar: "))))
    (SETQ polj (CAR polj))
  (WHILE (OR (EQUAL polb polj)
             (/= (CDR (ASSOC 0 (ENTGET polj))) "POLYLINE")
             (/= 1 (FIX (/ (CDR (ASSOC 70 (ENTGET polj))) 8))))
    (IF (EQUAL polb polj)
        (PROMPT "\nSe ha designado la misma 3dpol.")
        (PROMPT "\nEntidad designada no es 3dpol.") )
    (WHILE (NOT (SETQ polj (ENTSEL "\nDesignar 3dpol a juntar: "))))
    (SETQ polj (CAR polj))
  )
)

;La función para juntar extrae las listas de cabecera, vértices y SEQEND
;de las dos 3dpol a unir, y las almacena en listas. Comprueba por qué
;extremos se tocan las 3dpol y llama a las funciones para construir la
;lista completa de la entidad unida, en el orden correcto. Si ninguno de
;los extremos de toca, visualiza un mensaje.
;Construye en la Base de Datos la lista de cabecera, llama a las funciones
;para construir las listas de vértices, en el orden correcto,
;y construye la lista de SEQEND

(DEFUN juntar_unepol ( / cabec listob lis e1 e2 pb1 pb2 pj1 pj2 endb liston)
   (SETQ cabec (ENTGET polb))
   (SETQ e1 (ENTNEXT polb))
   (SETQ lis (ENTGET e1))(SETQ listob (LIST lis))
   (SETQ pb1 (CDR (ASSOC 10 lis)))
   (WHILE (/= (CDR (ASSOC 0 lis)) "SEQEND")
     (SETQ pb2 (CDR (ASSOC 10 lis)))
     (SETQ e2 (ENTNEXT e1))
     (SETQ lis (ENTGET e2))
     (SETQ listob (CONS lis listob))
     (SETQ e1 e2)
   )
   (SETQ endb lis)
   (SETQ listob (CDR listob))
   (SETQ e1 (ENTNEXT polj))
   (SETQ lis (ENTGET e1))(SETQ liston (LIST lis))
   (SETQ pj1 (CDR (ASSOC 10 lis)))
   (WHILE (/= (CDR (ASSOC 0 lis)) "SEQEND")
     (SETQ pj2 (CDR (ASSOC 10 lis)))
     (SETQ e2 (ENTNEXT e1))
     (SETQ lis (ENTGET e2))
     (SETQ liston (CONS lis liston))
     (SETQ e1 e2)
   )
   (SETQ liston (CDR liston))
   (COND ((EQUAL pb2 pj1) (PROGN (SETQ listob (CDR listob))
                              (ENTDEL polj)(ENTDEL polb)
                              (ENTMAKE cabec)
                              (makeb_unepol)(makej_unepol)
                              (ENTMAKE endb)))
         ((EQUAL pb2 pj2) (PROGN (SETQ listob (CDR listob))
                              (SETQ liston (REVERSE liston))
                              (ENTDEL polb)(ENTDEL polj)
                              (ENTMAKE cabec)
                              (makeb_unepol)(makej_unepol)
                              (ENTMAKE endb)))
         ((EQUAL pb1 pj2) (PROGN (SETQ liston (CDR liston))
                              (ENTDEL polb)(ENTDEL polj)
                              (ENTMAKE cabec)
                              (makej_unepol)(makeb_unepol)
                              (ENTMAKE endb)))
         ((EQUAL pb1 pj1) (PROGN (SETQ liston (CDR liston))
                              (SETQ liston (REVERSE liston))
                              (ENTDEL polb)(ENTDEL polj)
                              (ENTMAKE cabec)
                              (makej_unepol)(makeb_unepol)
                              (ENTMAKE endb)))
         (T (PROMPT "Entidades no se tocan por un extremo"))
   )
)

;Construye en la Base de Datos los vértices de la 3dpol designada en
;primer lugar.

(DEFUN makeb_unepol ( / n longl lis)
   (SETQ longl (LENGTH listob))
   (SETQ n 1)
   (REPEAT longl
     (SETQ lis (NTH (- longl n) listob))
     (ENTMAKE lis)(SETQ n (+ n 1))
   )
)

;Construye en la Base de Datos los vértices de la 3dpol designada en
;segundo lugar.

(DEFUN makej_unepol ( / n long lis)
   (SETQ longl (LENGTH liston))
   (SETQ n 1)
   (REPEAT longl
     (SETQ lis (NTH (- longl n) liston))
     (ENTMAKE lis)(SETQ n (+ n 1))
   )
)

;Define un nuevo comando UNEPOL, desactiva eco, establece función de
;errores, y llama sucesivamente a las dos funciones de usuario intermedias.
;Pone señales de "Inicio" y "Fin" mediante el comandon DESHACER.

(DEFUN c:unepol ( )
   (SETQ error0 *error* *error* err_unepol)
   (SETVAR "cmdecho" 0)
   (inic_unepol)
   (COMMAND "_undo" "_begin")
   (juntar_unepol)
   (COMMAND "_undo" "_end")
   (SETVAR "cmdecho" 1)(PRIN1)
)

;La función de control de errores, restituye la función de error original,
;Visualiza el mensaje de error producido, salvo cuando se ha abortado el
;programa desde dentro mediante (exit) o (quit). Restituye los estados de
;activación originales de referencia, marcas y eco. Pone la marca "fin" en
;el comando "Deshacer".

(DEFUN err_unepol (mens)
   (SETQ *error* error0)
   (IF (= mens "quitar / salir abandonar")
       (PRIN1)
       (PRINC (STRCAT "\nError: " mens " "))
   )
   (COMMAND "_undo" "_end")
   (SETVAR "cmdecho" 1)(PRIN1)
)

;El mensaje se visualiza cada vez que se carga la rutina en memoria, e informa
;al usuario del nombre del nuevo comando definido.

(PROMPT "Nuevo comando UNEPOL definido.")(PRIN1)


Luis Alberto Benitez

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

Ver perfil de usuario

Volver arriba Ir abajo

Unir 3DPOLY Empty Re: Unir 3DPOLY

Mensaje por saulo2016 el Lun Ene 21, 2019 4:43 pm

Excelente Luis Alberto Benitez, me sirvió perfectamente bien.

te agradezco el apoyo.



Saludos
saulo2016
saulo2016

Mensajes : 163
Fecha de inscripción : 17/03/2016
Edad : 53
Localización : Monterrey, Nuevo León, Mexico

Ver perfil de usuario

Volver arriba Ir abajo

Unir 3DPOLY Empty Re: Unir 3DPOLY

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.