Transponer una lista

Buen día señores.

Por medio de un lisp, obtengo una lista de valores, así:

Código:


(setq conjk(ssget "_W" pmedio unoini(list(cons 0 "*text")(cons 62 256))))


Y la lista es:
("0-Corte" "0-Terraplén" "0-Pedraplén" "0-Subrasante" "0-Base" "0-Asfalto" "0-banqueta")

Hasta aquí todo bien. Mi problema es que necesito pasar esa lista a un archivo de texto, la paso, pero... en forma vertical. Yo necesito pasarla en forma horizontal.
Es decir transponer la lista y entonces, pasarla al archivo de texto.
Espero haber sido claro.

Alguna sugerencia???
Saludos y gracias

Que tal Eliasp.
Podrías colocar el código Completo.
Gracias

Si, claro:

Código:


(vl-load-com)
(defun crea(xlista)
  ;(setq titulo "")
  (setq nombre(STRCAT(SUBSTR (GETVAR "DWGNAME") 1 (- (STRLEN (GETVAR "DWGNAME")) 3)) "CSV"))
  (setq ruta(getvar "dwgprefix"))
  ;(setq entit(car(entsel "\n Selecciona el Título...")))
  (if(/= entit nil)
    (progn
      (setq otitulo(vlax-ename->vla-object entit) titulo(vlax-get-property otitulo 'textstring))
      (vla-put-color otitulo 111)))
  ;(setq lista(reverse xlista))
  (setq nombrearch (strcat ruta nombre))
  (setq ar(open nombrearch "a"))
  (if(/= entit nil)
    (write-line titulo ar))
  (foreach renglon ren1
    (write-line renglon ar))
  (close ar)
  ;(startapp "excel" nombrearch)
  )
(defun titulos()
  ;(while(/=(setq ENT (ENTSEL "\nSeleccione el Cadenamiento: "))nil)
  (setq ENT (ENTSEL "\nSeleccione el Cadenamiento: "))
  (setq titlista nil)
  (SETQ Otxt (vlax-ename->vla-object (car ENt )))
  (vla-put-color Otxt acyellow)
  (setq pto(vlax-get-property Otxt 'insertionpoint))
  ;(setq pto(vlax-get-property Otxt 'TextAlignmentPoint))
  (setq pto1(vlax-safearray->list(vlax-variant-value pto)))
  ;(command "_.pline" pto1 (polar pto1(* 1.5 pi)1.5)"")
  (setq pto2(polar pto1(* pi 1)0.75))
  (setq pto3(polar pto2(* pi 0.5)0.5))
  (setq pto4(polar pto1(* pi 1.5)0.5))
  (vl-cmdf "_line" pto4 pto1 pto2 pto3 "")

  (setq blancavert(SSGET "_C" pto1 pto2 (LIST (CONS 0 "*LINE")(cons 62 7))))
  (setq ent(ssname blancavert 0))
  (setq obuno(vlax-ename->vla-object ent))

  (setq unoini(vlax-curve-getstartpoint obuno))
  (setq unofin(vlax-curve-getendpoint obuno))
  (vl-cmdf "_circle" unoini 0.2)
  (vl-cmdf "_circle" unofin 0.1)

  (setq blancahor(SSGET "_C" pto1 pto4 (LIST (CONS 0 "*LINE")(cons 62 7))))
  (setq ent(ssname blancahor 0))
  (setq obdos(vlax-ename->vla-object ent))

  (setq dosini(vlax-curve-getstartpoint obdos))
  (setq dosfin(vlax-curve-getendpoint obdos))
  (vl-cmdf "_circle" dosini 0.2)
  (vl-cmdf "_circle" dosfin 0.1)
  
    ;-------------punto medio de la línea horizontal
  (setq pmx(/(+ (car dosini) (car dosfin))2)
        pmy(/(+ (cadr dosini) (cadr dosfin))2)
        )
  (setq pmedio(list pmx pmy))l
  (vl-cmdf "_circle" pmedio 0.25)
  (setq conjk(ssget "_W" pmedio unoini(list(cons 0 "*text")(cons 62 256))))
  (setq cuantos(sslength conjk))

  (setq pnuevo(list (car dosfin)(cadr unoini)))

  (repeat cuantos
    (setq ent(ssname conjk i))
    (setq obj(vlax-ename->vla-object ent))
    (setq txt(vlax-get-property obj 'textstring))
    (setq titlista(cons txt titlista))
    (setq i(1+ i))
    )
  (setq titlista(cdr titlista))
  (setq cual nil ren0 nil ren1 nil)
  
  (setq cuantos2(length titlista))
  (setq cind 0)
  (foreach capas titlista
    (setq cual(nth cind titlista))
    (setq ren0(strcat cual))
    (setq ren1(cons ren0 ren1))
    (setq cind(1+ cind))
    )

  (setq ren1(reverse ren1))
  (crea ren1)
  
  )

;(defun mitad(obj)(setq pmedio(vlax-curve-getpointatdist obj(/(vlax-curve-getdistatparam obj)(vlax-curve-getendparam obj))2.0))))
(defun c:zarea()
  ;(setvar "echo" "off")
  (setq i 0)
  (setvar "modemacro" "Ing. José Elías Pelayo")
  ;(setq antes(getvar "osmode"))
  ;(setq lista(list "0-Corte" "0-Terraplén" "0-Pedraplén""0-Subrasante" "0-Base" "0-Asfalto" "0-banqueta"))  
  (setvar "osmode" 0)
  (titulos)
  
    
    (foreach capa lista
      ;(alert capa)
      (leer)
      )
    ;(setvar "echo""on")
    
  ;(setvar "osmode" antes)
  (setvar "clayer" "0")
  )
(defun leer()
  (setq ind 0 suma 0 area 0)
  ;(setq conj(ssget "_W" pto2 pto3(list(cons 0 "*line")
  (setq conj(ssget "_W" pto2 pto3(list(cons 0 "hatch")
                                      (cons 8 capa)
                                      )))
  (if(= conj nil)
    ()
    (progn
      (setq cuantos(sslength conj))
      (if(= conj 0)
        (setq area 0)
        (progn
          (repeat cuantos
            (setq ent(ssname conj ind))
            (setq obj(vlax-ename->vla-object ent))
            (setq area(vlax-get-property obj 'area))
            (setq suma(+ area suma))
            (setq ind(1+ ind))
            )
          )
        )
      )
    )
  ;(alert (strcat capa" " (rtos suma 2 2)" m²"))
  (setq lugar(vlax-ename->vla-object(car(entsel "\n Texto a Cambiar..."))))
  (vla-put-color lugar accyan)  
  (vla-put-textstring lugar (strcat(rtos suma 2 2)" m²"))
  )
;para escribir "Límite de Derecho de Vía" en las líneas que lo representan en las secciones...

(defun c:zlmdvtxt()
  (setq zcapa "eps_LDV")
  (if(null(tblobjname "layer" zcapa))
    (COMMAND "_-layer" "make" zcapa "_color" "71" zcapa "")
    ;(setvar "clayer" zcapa)
    )
  
  (setvar "clayer" zcapa)
  (setq acadobj(vlax-get-acad-object))
  (setq acaddoc(vla-get-activedocument acadobj))
  (setq acadesp(vla-get-modelspace acaddoc))
  (setq appa  (VLA-GET-APPLICATION acaddoc))
  
  (setq i 0)
  (setq conj(ssget "_X" (list(cons 0 "*line")
                             (cons 8 zcapa)
                             ;(cons 62 256)
                             )
                   )
        )
  (setq cuantos(sslength conj))
  (repeat cuantos
    (setq ent(ssname conj i))
    (setq obj(vlax-ename->vla-object ent))
    ;(setq pto(vlax-curve-getstartpoint obj))
    (setq pto(vlax-curve-getendpoint obj))

    (setq txt(vla-addtext acadesp "Límite de Derecho de Vía" (vlax-3d-point pto)0.3))
    (vla-put-alignment txt acAlignmentright)
    (vla-put-rotation  txt (dtr 90))
    (vla-put-textalignmentpoint txt(vlax-3d-point(polar pto(* pi 0.5)-0.1)))
    (setq i(1+ i))
    
    )
  )

(defun safefill(ptlist)
  (vlax-safearray-fill(vlax-make-safearray vlax-vbdouble(cons 0 (1-(length(apply 'append ptlist)))))(apply 'append ptlist)))

(defun c:creceDV()
  (while(/=(setq ent(car(entsel "\n Selecciona Línea para LDV...")))nil)
    (setq limite(vlax-ename->vla-object ent))
    (setq pto1(vlax-curve-getstartpoint limite)
          pto2(vlax-curve-getendpoint limite))
    (setq ptlist(list pto1 pto2))
    (setq linea(vla-addpolyline acadesp(safefill ptlist)))
    (vla-put-ConstantWidth linea "0.025")
    (vla-put-layer linea "eps_LDV")
    (vla-delete limite)
    )
  )

(defun c:zcrecemuchos()
  (setq i 0)
  (prompt "\n selecciona Líneas...")
  (setq conj(ssget ))
  (setq cuantos(sslength conj))
  (repeat cuantos
    (setq ent(ssname conj i))
    (setq limite(vlax-ename->vla-object ent))
    (setq pto1(vlax-curve-getstartpoint limite)
          pto2(vlax-curve-getendpoint limite))
    (setq ptlist(list pto1 pto2))
    (setq linea(vla-addpolyline acadesp(safefill ptlist)))
    (vla-put-ConstantWidth linea "0.025")
    (vla-put-layer linea "eps_LDV")
    (vla-delete limite)
    (setq i(+ 1 i))
    )
  )
(defun c:zselec()
  (setq obj(vlax-ename->vla-object(car(entsel "\n Selecciona Objeto para Obtener CAPA..."))))
  (setq capa(vlax-get-property obj 'layer))
  (setvar "clayer" capa)
  (setq conj1(ssget "_C" pto2 pto3(list
                                    ;(cons 0 "Text")
                                    ;(cons 8 "Borrar")
                                    (cons 0 "HATCH")
                                    (cons 8 capa)
                                    ;(cons 62 131)
                                    )))
  (setq cuantos(sslength conj1))
  (SSSETFIRST conj1 conj1)
  (princ (strcat(itoa cuantos)" Elementos Seleccionados"))
  )

(defun c:verificarea()
  (setvar "modemacro" "Ing. José Elías Pelayo")  
  (setq lista(list "0-Corte" "0-Terraplén" "0-Pedraplén""0-Subrasante" "0-Base" "0-Asfalto" "0-banqueta"))
  
  (while(/=(setq ENT (ENTSEL "\nSeleccione el Cadenamiento: "))nil)
    (SETQ Otxt (vlax-ename->vla-object (car ENt )))
    (setq pto(vlax-get-property Otxt 'insertionpoint))
    (setq pto1(vlax-safearray->list(vlax-variant-value pto)))
    (setq pto2(polar pto1(* pi 1)53))
    (setq pto3(polar pto1(* pi 1.5)8.5))
    (foreach capa lista
      (leer1)
      )
    )
  (setvar "clayer" "0")
  )
(defun leer1()
  (setq ind 0 suma 0 area 0)
  (setq conj(ssget "_W" pto2 pto3(list(cons 0 "hatch")
                                      (cons 8 capa)
                                      )))
  (if(= conj nil)
    ()
    (progn
      (setq cuantos(sslength conj))
      (if(= conj 0)
        (setq area 0)
        (progn
          (repeat cuantos
            (setq ent(ssname conj ind))
            (setq obj(vlax-ename->vla-object ent))
            (setq area(vlax-get-property obj 'area))
            (setq suma(+ area suma))
            (setq ind(1+ ind))          
            )
            (alert (strcat capa" ---> " (rtos suma 2 2)))
          )
        )
      )
    )
  
  )
(defun c:xzselec()
  (setq ind 0)
  (setq ob(vlax-ename->vla-object(car(entsel "\n Selecciona objeto Verificar Área..."))))
  (setq capa(vlax-get-property obj 'layer))
  (prompt "Selecciona las áreas...")
  ;(setq conj(ssget))
  ;(setq obj(vlax-ename->vla-object(car(entsel "\n Selecciona Objeto para Obtener CAPA..."))))
  (setq pto2(getpoint "\n Selecciona una esquina...")
        pto3(getcorner pto2 "\n Esquina Opuesta..."))
  (setq conj1(ssget "_C" pto2 pto3(list
                                    ;(cons 0 "Text")
                                    ;(cons 8 "Borrar")
                                    (cons 0 "HATCH")
                                    (cons 8 capa)
                                    ;(cons 62 131)
                                    )))
  ;----------
  (setq cuantos(sslength conj1))
  (repeat cuantos
    (setq ent(ssname conj1 ind))
    (setq obj(vlax-ename->vla-object ent))
    (setq area(vlax-get-property obj 'area))
    (setq suma(+ area suma))
    (setq ind(1+ ind))
    )
  ;----------
  (alert (strcat "Área de "capa " m²"))
  (setq cuantos(sslength conj1))
  (SSSETFIRST conj1 conj1)
  (princ (strcat(itoa cuantos)" Elementos Seleccionados"))
  )


Elias me da el siguiente error:
error: tipo de argumento erróneo:
VLA-OBJECT nil

Hola...

A ver si lo he entendido bien y te funciona esto:

Código:


(defun C:TST (/ err fib lst tsterr)

  (defun tsterr (s)
    (princ s)
    (if fib (close fib))
    (setq *error* err)
    )
  
  (setq
    err *error*
    *error* tsterr
    ;Esto a continuación es la forma de ordenar la lista en horizontal, formateada para fichero CSV
    ;El método te servirá para formatear el resto de datos que quieras meter en el CSV y ordenarlos según los encabezamientos
    lst (apply 'strcat (mapcar '(lambda (x) (strcat x ";")) '("0-Corte" "0-Terraplén" "0-Pedraplén" "0-Subrasante" "0-Base" "0-Asfalto" "0-banqueta")))
    fia (vl-filename-mktemp "TST.csv")
    fib (open fia "w")
    )
  ;escribes la línea completa en el fichero
  (write-line lst fib)
  (close fib)
  ;Acuérdate de borrar el fichero de prueba: está en la variable "fia"
  ; (teclea !fia en la línea de comandos)
  (startapp "notepad" fia)
  (setq *error* err)
  (princ)
  )


Un saludo.

Muchas gracias maestro, la pruebo y comento

Saludos

Elias el que uso es este lisp pero copia en un sola columna si alguien lo mejora para colocar
en varias columnas bienvenido sea.:

Código:

(defun c:CL2CLIP ( / lista_pasar pasar obj tipo )
;Por Nolo 01-06-2012
(vl-load-com)
;seleccionar objetos y ponerlos en una lista ordenada
; By Nolo

;(SETQ S (SSGET '((0 . "TEXT"))))

;(setq lista_pasar (list) tipo (SSGET '((0 . "TEXT"))))

;seleccionar objetos y ponerlos en una lista ordenada
(PRINC "\nSeleccione Texto A Copiar (presione ESC para salir): ")
(setq lista_pasar (list) tipo "TEXT")
(while (wcmatch tipo "*TEXT,LWPOLYLINE")

(if (setq obj(car(entsel"\nSeleccione Texto A Copiar (presione ESC para salir): ")))
   (progn
   (setq tipo (cdr (assoc 0 (setq ent (entget obj )))))
   (cond
   ((wcmatch tipo "*TEXT") (setq pasar (cdr(assoc 1 ent))) )  
   ((wcmatch tipo "LWPOLYLINE") (command "._area" "_e" obj)(setq pasar (rtos (getvar "area") 2 2)))
   (T (setq pasar nil) )
   )
   (if pasar (setq lista_pasar (append lista_pasar(list pasar))) )
   )
   (setq tipo " ")
  
)
)
;(setq pasar (apply 'strcat (mapcar '(lambda (a) (strcat a (chr 13))) (reverse lista_pasar) )))
(setq pasar (apply 'strcat (mapcar '(lambda (a) (strcat a (chr 13))) lista_pasar )))

;mardar el dato al portapapeles
; Original de Topward
  (vlax-invoke
   (vlax-get
      (vlax-get
         (setq portapa (vlax-create-object "htmlfile"))
      'PARENTWINDOW)
   'CLIPBOARDDATA)
          'setdata
          "Text"
          pasar)
  (vlax-release-object portapa )
(alert (strcat "Los Datos \n"pasar"\nSe han Cargado en el Portapapeles" ))
)
(prin1)

(prompt "\n*** nuevo comando CL2CLIP definido ***")
(prin1)