Código Fuente‎ > ‎

Capítulo 10.lsp

;;;Código fuente del libro "Experto AutoCAD con Visual LISP"
;;; (c) 2012 Ediciones ARTUAL, S.L. Barcelona, España.
;;; (c) 2012-2020 Reinaldo Togores. Todos los derechos reservados
;;; Se permite su uso mencionando la obra y su autor.
;;;Capítulo 10 Dibujar con Visual LISP

(defun cmd-circulo (centro radio /) 
  (cmd-entrar)
  (command "._circle" centro radio)
  (cmd-salir))
;;;Listado 10.1. Dibujo de un círculo utilizando COMMAND.

(defun cmdf-circulo (/ pt) 
  (cmd-entrar)
  (vl-cmdf "._circle" 
           (setq pt (getpoint "\nIndique centro:"))
           (getdist pt "\nEspecifique radio: "))
  (cmd-salir))
;;;Listado 10.2. Dibujo de un círculo utilizando VL-CMDF.

(defun cmd-ttr (pt1 pt2 radio /) 
  (setvar "cmdecho" 0)
  (vl-cmdf "._circle" "_ttr" pt1 pt2 radio)
  (setvar "cmdecho" 1))
;;;Listado 10.3. Dibujo de un círculo a partir de dos puntos de tangencia y el radio.

(defun cmd-circulo (centro radio /) 
  (if (> (getvar "CMDACTIVE"0
    (vl-cmdf))
  (cmd-entrar)
  (vl-cmdf "._circle" centro radio)
  (cmd-salir)
  (if (> (getvar "CMDACTIVE"0
    (progn (vl-cmdf) nil)
    t))
;;;Listado 10.4. Función CMD-CIRCULO con control de errores.

(defun cmd (cmd-nombre /) 
  (if (> (getvar "CMDACTIVE"0
    (vl-cmdf))
  (apply 'vl-cmdf (list cmd-nombre))
  (while (> (getvar "CMDACTIVE"0) (vl-cmdf pause)))
;;;Listado 10.5. Función universal para ejecutar comandos de manera interactiva.

(defun cmd-test () 
  (alert "Pulse Aceptar para elegir un Color")
  (initdia)
  (cmd "._COLOR")
  (alert "Pulse aceptar para dibujar un Círculo")
  (cmd "._CIRCLE"))
;;;Listado 10.6. Función de que lanza comandos desde un programa AutoLISP.

(defun cmd-poly (lista-puntos 2d cerrado /) 
  (if (> (getvar "CMDACTIVE"0
    (vl-cmdf))
  (cmd-entrar)
  (vl-cmdf 
    (if 2d 
      "._pline"
      "._3dpoly"))
  (foreach pt lista-puntos (vl-cmdf pt))
  (vl-cmdf 
    (if cerrado 
      "_cl"
      ""))
  (cmd-salir)
  (if (> (getvar "CMDACTIVE"0
    (progn (vl-cmdf) nil)
    t))
;;;Listado 10.7. Función para dibujar una polilínea 2D o 3D.

(defun ent-pt (xyz) 
  (entmake (list '(0 . "POINT") (cons 10 xyz))))
;;;Listado 10.8. Función para dibujo de un punto.

(defun valor-cod (clave ename) 
  (cdr (assoc clave (entget ename))))
;;;Listado 10.9. Extracción del valor asociado a un código DXF.

(defun ent-copia (lista-ent / ctr) 
  (if 
    (apply 'or 
           (mapcar '(lambda (x) (= x (cdr (assoc 0 lista-ent)))) 
                   '("CIRCLE" "ELLIPSE" "ARC" "INSERT" "POINT" "SHAPE" "TEXT" "MTEXT")))
    (while (setq ctr (getpoint "\nNueva ubicación: ")) 
      (entmake 
        (subst (cons 10 ctr) (assoc 10 lista-ent) lista-ent)))
    (prompt "\nObjeto no admitido"))
  (princ))
;;;Listado 10.10. Función que utiliza ENTMAKE para copiar objetos.

(defun ent-circ (centro radio capa normal-vec) 
  (entmake 
    (list '(0 . "CIRCLE"
          '(100 . "AcDbEntity")
          '(100 . "AcDbCircle")
          (cons 8 capa)
          (cons 10 centro)
          (cons 40 radio)
          (cons 210 normal-vec))))
;;;Listado 10.11. Función que dibuja círculos en diferentes capas y planos.

(defun ent-texto (txt-cadena estilo pt1 pt2 txt-altura h-just v-just) 
  (entmake 
    (list '(0 . "TEXT"
          '(100 . "AcDbEntity")
          '(100 . "AcDbText")
          (cons 1 txt-cadena)
          (cons 7 estilo)
          (cons 10 pt1)
          (cons 11 pt2)
          (cons 40 txt-altura)
          (cons 72 h-just)
          (cons 73 v-just))))
;;;Listado 10.12. Función que crea una entidad de texto en una línea.

(defun ent-dib-texto (pt-ins altura numeracion) 
  (ent-text 
    numeracion
    (getvar "TEXTSTYLE")
    pt-ins
    pt-ins
    altura
    1
    2))
;;;Listado 10.13. Reemplazo para la función dib-texto utilizando ENTMAKE.

(defun just-txt-ops (token /) 
  (list 
    (cond 
      ((or (wcmatch (strcase just) "@L") (wcmatch token "L*"))
       (cons 72 0))
      ((or (wcmatch (strcase just) "@C") (wcmatch token "C*"))
       (cons 72 1))
      ((or (wcmatch (strcase just) "@R") (wcmatch token "R*"))
       (cons 72 2))
      ((wcmatch (strcase token) "A*") (cons 72 3))
      ((wcmatch (strcase token) "M*") (cons 72 4))
      ((wcmatch (strcase token) "F*") (cons 72 5)))
    (cond 
      ((wcmatch (strcase token) "T@") (cons 73 3))
      ((wcmatch (strcase token) "M@") (cons 73 2))
      ((wcmatch (strcase token) "B@") (cons 73 1))
      (t (cons 73 0)))))
;;;Listado 10.14. Elección de los valores de código de grupo según los símbolos de las opciones de justificación.

(defun ent-just-txt (txt-cadena style pt1 pt2 txt-altura just ang /) 
  (entmake 
    (append 
      (list '(0 . "TEXT"
            '(100 . "AcDbEntity")
            '(100 . "AcDbText")
            (cons 1 txt-cadena)
            (cons 7 style)
            (cons 10 pt1)
            (cons 11 pt2)
            (cons 40 txt-altura)
            (cons 50 ang))
      (just-txt-ops just))))
;;;Listado 10.15. Función que crea texto justificado usando los símbolos de las opciones.

(defun C:ENT-TXT (/ just pt1 pt2 altura cadena-txt) 
  (prompt "\Justificación del texto: ")
  (initget 
    1
    "Left Align Fit Center Middle Right TL TC TR ML MC MR BL BC BR")
  (setq just (getkword 
               "[Left/Align/Fit/Center/Middle/Right/TL/TC/TR/ML/MC/MR/BL/BC/BR]:"))
  (cond 
    ((or (= just "Align") (= just "Fit"))
     (initget 1)
     (setq pt1 (getpoint 
                 "\nPrimer punto de la línea base del texto: "))
     (initget 1)
     (setq pt2 (getpoint 
                 pt1
                 "\nSegundo punto de la línea base del texto: ")))
    (t
     (initget 1)
     (setq pt1 (getpoint 
                 "\nIndique el punto de inserción del texto: ")
           pt2 pt1)))
  (initget 1)
  (setq altura (getdist 
                 pt1
                 "Altura del texto: "))
  (initget 1)
  (setq cadena-txt (getstring 
                     "\nTexto a insertar: "))
  (ent-just-txt 
    cadena-txt
    (getvar "TEXTSTYLE")
    pt1
    pt2
    altura
    just
    0)
  (princ))
;;;Listado 10.16. Programa de ejemplo usando ENT-JUST-TXT.

(defun valores (clave lista / sublista resultado) 
  (while (setq sublista (assoc clave lista)) 
    (setq resultado (cons (cdr sublista) resultado)
          lista     (cdr (member sublista lista))))
  (reverse resultado))
;;;Listado 10.17 Extracción de valores múltiples contenidos en una lista de asociación.

(defun vert-poly (lista / coord-z) 
  (setq coord-z (cdr (assoc 38 lista)))
  (mapcar '(lambda (2d) (reverse (cons coord-z (reverse 2d)))) 
          (valores 10 lista)))
;;;Listado 10.18. Función que devuelve los vértices de una LWPOLYLINE.

(defun ent-poly (vertices cerrado) 
  (entmake 
    (append 
      (list '(0 . "LWPOLYLINE"
            '(100 . "AcDbEntity")
            '(100 . "AcDbPolyline")
            (cons 38 
                  (if (> (length (car vertices)) 2
                    (nth 2 (car vertices))
                    (getvar "elevation")))
            (cons 90 (length vertices))
            (cons 70 
                  (if cerrado 
                    1
                    0)))
      (mapcar '(lambda (x) (cons 10 x)) vertices))))
;;;Listado 10.19. Creación de Polilíneas usando ENTMAKE.

(defun ent-poly-2 (vertices cerrado capa normal-vec) 
  (entmake 
    (append 
      (list '(0 . "LWPOLYLINE"
            '(100 . "AcDbEntity")
            '(100 . "AcDbPolyline")
            (cons 8 capa)
            (cons 38 
                  (if (> (length (car vertices)) 2
                    (nth 2 (car vertices))
                    (getvar "elevation")))
            (cons 90 (length vertices))
            (cons 70 
                  (if cerrado 
                    1
                    0))
            (cons 210 normal-vec))
      (mapcar '(lambda (x) (cons 10 x)) vertices))))
;;;Listado 10.20. Creación de una Polilínea especificando la capa y el sistema de coordenadas.

(defun ent-cabecera (capa cerrado) 
  (entmake 
    (list '(0 . "POLYLINE"
          '(100 . "AcDbEntity")
          '(100 . "AcDb3dPolyline")
          (cons 8 capa)
          '(10 0.0 0.0 0.0)
          (cons 70 
                (+ 8 
                   (if cerrado 
                     1
                     0))))))
;;;Listado 10.21. Función que crea la cabecera de la Polilínea 3D.

(defun ent-vertice (xyz capa) 
  (entmake 
    (list '(0 . "VERTEX"
          '(100 . "AcDbEntity")
          '(100 . "AcDbVertex")
          '(100 . "AcDb3dPolylineVertex")
          (cons 8 capa)
          (cons 10 xyz)
          '(70 . 32)
          '(50 . 0))))
;;;Listado 10.22. Función que crea una entidad VERTEX.

(defun ent-seqend (capa) 
  (entmake 
    (list '(0 . "SEQEND") '(100 . "AcDbEntity") (cons 8 capa))))
;;;Listado 10.23. Función que crea una entidad SEQEND.

(defun ent-3dpol (vertices capa cerrado) 
  (ent-cabecera capa cerrado)
  (foreach xyz vertices (ent-vertice xyz capa))
  (ent-seqend capa))
;;;Listado 10.24. Función que crea una Polilínea 3D usando ENTMAKE.

(defun enames-bloque (id-ent / tmp) 
  (while id-ent 
    (setq tmp    (cons (cdr (assoc -1 (entget id-ent))) tmp)
          id-ent (entnext id-ent)))
  (reverse tmp))
;;;Listado 10.25. Obtención de los componentes de un Bloque.

(defun ent-attdef (id msj valor pt-ins altura visible) 
  (entmake 
    (list '(0 . "ATTDEF"
          '(8 . "0")
          '(100 . "AcDbEntity")
          '(100 . "AcDbText")
          (cons 10 pt-ins)
          (cons 40 altura)
          (cons 1 valor)
          '(100 . "AcDbAttributeDefinition")
          (cons 3 msj)
          (cons 2 id)
          (cons 70 
                (if visible 
                  0
                  1)))))
;;;Listado 10.26. Entidad ATTDEF creada con ENTMAKE.

(defun ent-bloque (nombre pt-ins atrib-var) 
  (entmake 
    (list '(0 . "BLOCK"
          '(100 . "AcDbEntity")
          '(100 . "AcDbBlockBegin")
          '(8 . "0")
          (cons 2 nombre)
          (cons 10 pt-ins)
          (cons 70 
                (if atrib-var 
                  2
                  0)))))
;;;Listado 10.27. Creación de la cabecera del Bloque.

(defun ent-endblk () 
  (entmake 
    (list '(0 . "ENDBLK"
          '(100 . "AcDbEntity")
          '(100 . "AcDbBlockEnd")
          '(8 . "0"))))
;;;Listado 10.28. Creación de la entidad fin-de-secuencia del Bloque.

(defun ent-torre-block () 
  (ent-bloque "TORRE" '(0.0 0.0 0.0t)
  (ent-poly-2 
    '((-0.5 -0.5 0.0)
      (0.5 -0.5 0.0)
      (0.5 0.5 0.0)
      (-0.5 0.5 0.0))
    t
    "0"
    '(0.0 0.0 1.0))
  (ent-poly-2 
    '((-0.5 -0.5 0.0) (0.5 0.5 0.0))
    nil
    "0"
    '(0.0 0.0 1.0))
  (ent-poly-2 
    '((0.5 -0.5 0.0) (-0.5 0.5 0.0))
    nil
    "0"
    '(0.0 0.0 1.0))
  (ent-attdef 
    "ID-TORRE"
    "Número de Torre"
    "00"
    '(0.75 -0.5 0.0)
    0.5
    nil)
  (ent-endblk))
;;;Listado 10.29 Función para la creación de un Bloque.

(defun ed-torre-block () 
  (vl-cmdf "_BEDIT" "TORRE")
  (ent-poly-2 
    '((-0.5 -0.5 0.0)
      (0.5 -0.5 0.0)
      (0.5 0.5 0.0)
      (-0.5 0.5 0.0))
    t
    "0"
    '(0.0 0.0 1.0))
  (ent-poly-2 
    '((-0.5 -0.5 0.0) (0.5 0.5 0.0))
    nil
    "0"
    '(0.0 0.0 1.0))
  (ent-poly-2 
    '((0.5 -0.5 0.0) (-0.5 0.5 0.0))
    nil
    "0"
    '(0.0 0.0 1.0))
  (ent-attdef 
    "ID-TORRE"
    "Número de Torre"
    "00"
    '(0.75 -0.5 0.0)
    0.5
    nil)
  (vl-cmdf "_BCLOSE" "_Save"))
;;;Listado 10.30. Creación del bloque TORRE usando el Editor de Bloques.

(defun espacio-actual (dibujo /) 
  (vla-get-block (vla-get-ActiveLayout dibujo)))
;;;Listado 10.31. Función que devuelve el espacio actual.

(defun 3d->2d (pt) (list (car pt) (cadr pt)))
;;;Listado 10.32. Función auxiliar 3d->2d.

(defun ax-poly (vertices cerrado / obj) 
  (setq obj (vla-AddLightWeightPolyline 
              (espacio-actual *aevl:dibujo*)
              (vlax-make-variant 
                (ax-lista->matriz 
                  (apply 'append (mapcar '3d->2d vertices))))))
  (if cerrado 
    (vlax-put-property obj 'Closed :vlax-true))
  (if (nth 2 (car vertices)) 
    (vlax-put-property obj 'Elevation (nth 2 (car vertices))))
  obj)
;;;Listado 10.33. Creación de una LWPOLYLINE usando ActiveX.

(defun ax-3dpol (vertices cerrado / obj) 
  (setq obj (vla-Add3DPoly 
              (espacio-actual *aevl:dibujo*)
              (vlax-make-variant 
                (ax-lista->matriz (apply 'append vertices)))))
  (if cerrado 
    (vlax-put-property obj 'closed :vlax-true))
  obj)
;;;Listado 10.34. 3D polyline con métodos ActiveX.

(defun ax-col-bloques (/) 
  (if (null *aevl:bloques*) 
    (progn (setq *aevl:bloques* (vla-get-blocks *aevl:dibujo*)) 
           (pragma '((protect-assign *aevl:bloques*)))
           *aevl:bloques*)
    *aevl:bloques*))
;;;Listado 10.35. Referenciar la colección BLOCKS.

(defun ax-punto-cota (/ tmp atrib) 
  (setq tmp (vla-add (ax-col-bloques) 
                     (vlax-3d-point '(0.0 0.0 0.0))
                     "PUNTO-COTA"))
  (vla-addline 
    tmp
    (vlax-3d-point '(-0.5 0.0 0.0))
    (vlax-3d-point '(0.5 0.0 0.0)))
  (vla-addline 
    tmp
    (vlax-3d-point '(0.0 -0.5 0.0))
    (vlax-3d-point '(0.0 0.5 0.0)))
  (setq atrib (vla-addattribute 
                tmp
                0.5
                0
                "Point elevation"
                (vlax-3d-point '(0.0 -1.0 0.0))
                "ELEV"
                "0.0"))
  (vlax-put-property atrib "Alignment" acAlignmentTopCenter)
  (vlax-put-property 
    atrib
    "TextAlignmentPoint"
    (vlax-3d-point '(0.0 -1.0 0.0)))
  tmp)
;;;Listado 10.36. Creación de un bloque usando métodos ActiveX.

(defun cmd-capa (nombre color tipolin) 
  (vl-cmdf "._layer" "_m" nombre "_c" color nombre "_l" tipolin nombre ""))
;;;Listado 10.37. Función que crea una Capa usando el comando CAPA (_LAYER).

(defun cmd-cargatipolin (nombre) 
  (if (not (tblsearch "LTYPE" nombre)) 
    (vl-cmdf "._linetype" 
             "_l"
             nombre
             (if (= (getvar "measurement"1
               (findfile "acadiso.lin")
               (findfile "acad.lin"))
             "")))
;;;Listado 10.38. Cargar un Tipo de Línea.

(defun locale-ltyp (nombre / lang ltyps) 
  (setq lang  (vl-position 
                (getvar "UILocale")
                '("en-US" "de-DE" "es-ES" "fr-FR" "it-IT" "pt-BR"))
        ltyps '(("BORDER" "RAND" "MORSE_G" "BORDURE" "BORDO" "BORDA")
                ("BORDER2" "RAND2" "MORSE_G2" "BORDURE2" "BORDO2" "BORDA2")
                ("BORDERX2" "RANDX2" "MORSE_Gx2" "BORDUREX2" "BORDOX2" "BORDAX2")
                ("CENTER" "MITTE" "CENTRO" "AXES" "CENTRO" "CENTRO")
                ("CENTER2" "MITTE2" "CENTRO2" "AXES2" "CENTRO2" "CENTRO2")
                ("CENTERX2" "MITTEX2" "CENTROx2" "AXESX2" "CENTROX2" "CENTROX2")
                ("DASHDOT" "STRICHPUNKT" "TRAZO_Y_PUNTO" "TIRETPT" "TRATTOPUNTO" 
                           "TRAÇOPONTO")
                ("DASHDOT2" "STRICHPUNKT2" "TRAZO_Y_PUNTO2" "TIRETPT2" "TRATTOPUNTO2" 
                            "TRAÇOPONTO2")
                ("DASHDOTX2" "STRICHPUNKTX2" "TRAZO_Y_PUNTOX2" "TIRETPTX2" 
                             "TRATTOPUNTOX2" "TRAÇOPONTOX2")
                ("DASHED" "STRICHLINIE" "TRAZOS" "INTERROMPU" "TRATTEGGIATA" 
                          "TRACEJADA")
                ("DASHED2" "STRICHLINIE2" "TRAZOS2" "INTERROMPU2" "TRATTEGGIATA2" 
                           "TRACEJADA2")
                ("DASHEDX2" "STRICHLINIEX2" "TRAZOSX2" "INTERROMPUX2" 
                            "TRATTEGGIATAX2" "TRACEJADAX2")
                ("DIVIDE" "GETRENNT" "MORSE_D" "DIVISE" "DIVIDI" "DIVISA")
                ("DIVIDE2" "GETRENNT2" "MORSE_D2" "DIVISE2" "DIVIDI2" "DIVISA2")
                ("DIVIDEX2" "GETRENNTX2" "MORSE_DX2" "DIVISEX2" "DIVIDIX2" "DIVISAX2")
                ("DOT" "PUNKT" "PUNTOS" "POINTILLE" "PUNTO" "PONTO")
                ("DOT2" "PUNKT2" "PUNTOS2" "POINTILLE2" "PUNTO2" "PONTO2")
                ("DOTX2" "PUNKTX2" "PUNTOSX2" "POINTILLEX2" "PUNTOX2" "PONTOX2")
                ("HIDDEN" "VERDECKT" "LÍNEAS_OCULTAS" "CACHE" "NASCOSTA" "OCULTA")
                ("HIDDEN2" "VERDECKT2" "LÍNEAS_OCULTAS2" "CACHE2" "NASCOSTA2" 
                           "OCULTA2")
                ("HIDDENX2" "VERDECKTX2" "LÍNEAS_OCULTASX2" "CACHEX2" "NASCOSTAX2" 
                            "OCULTAX2")
                ("PHANTOM" "PHANTOM" "VALS" "FANTOME" "FANTASMA" "FANTASMA")
                ("PHANTOM2" "PHANTOM2" "VALS2" "FANTOME2" "FANTASMA2" "FANTASMA2")
                ("PHANTOMX2" "PHANTOMX2" "VALSX2" "FANTOMEX2" "FANTASMAX2" 
                             "FANTASMAX2")
                ("FENCELINE1" "GRENZE1" "LÍMITE1" "LIMITE1" "LIMITE1" "CERCA1")
                ("FENCELINE2" "GRENZE2" "LÍMITE2" "LIMITE2" "LIMITE2" "CERCA2")
                ("TRACKS" "EISENBAHN" "VÍAS" "RAILS" "BINARIO" "TRILHAS")
                ("BATTING" "ISOLATION" "AISLAMIENTO" "ISOLATION" "ISOLAMENTO" 
                           "ISOLAMENTO")
                ("HOT_WATER_SUPPLY" "HEISSWASSERLEITUNG" "AGUA_CALIENTE" "EAU_CHAUDE" 
                                    "ALIMENTAZIONE_ACQUA_CALDA" "LINHA_DE_ÁGUA_QUENTE")
                ("GAS_LINE" "GASLEITUNG" "GAS" "GAZ" "GASDOTTO" "LINHA_DE_GÁS")
                ("ZIGZAG" "ZICKZACK" "ZIGZAG" "ZIGZAG" "ZIGZAG" "ZIGUEZAGUE")))
  (cond 
    ((setq ltyp (assoc (strcase nombre) ltyps)) (nth lang ltyp))
    (t nombre)))
;;;Listado 10.39. Función para la traducción de nombres de Tipos de Línea.

(defun usar? (capa) 
  (zerop 
    (logand (cdr (assoc 70 (tblsearch "LAYER" capa))) (+ 1 4))))
;;;Listado 10.40. Comprobación de si una Capa no está Desactivada, Inutilizada o Bloqueada.

(defun ent-capa (nombre color tipolin) 
  (entmake 
    (list '(0 . "LAYER"
          '(100 . "AcDbSymbolTableRecord")
          '(100 . "AcDbLayerTableRecord")
          (cons 2 nombre)
          '(70 . 0)
          (cons 62 color)
          (cons 6 tipolin)
          '(290 . 1)
          '(370 . -3))))
;;;Listado 10.41. Creación de una Capa utilizando ENTMAKE.

(defun ent-tipolin (nombre descripcion lista-param) 
  (entmake 
    (append 
      (list '(0 . "LTYPE"
            '(100 . "AcDbSymbolTableRecord")
            '(100 . "AcDbLinetypeTableRecord")
            (cons 2 nombre)
            '(70 . 0)
            (cons 3 descripcion)
            (cons 72 (ascii (nth 0 lista-param)))
            (cons 73 (- (length lista-param) 1))
            (cons 40 (apply '+ (mapcar 'abs (cdr lista-param)))))
      (apply 'append 
             (mapcar '(lambda (x) (list (cons 49 x) '(74 . 0))) 
                     (cdr lista-param))))))
;;;Listado 10.42. Función que crea un Tipo de Línea utilizando ENTMAKE.

(defun ax-capa (col-capa nombre color tipolin / capa) 
  (setq capa (vla-add col-capa nombre))
  (vla-put-Color capa color)
  (vla-put-Linetype capa tipolin)
  capa)
;;;Listado 10.43. Creación de una Capa con ActiveX.

(defun ax-cargatipolin (nombre / tmp) 
  (setq nombre (locale-ltyp nombre))
  (if 
    (not 
      (ax-existe? 
        nombre
        (setq tmp (vla-get-Linetypes *aevl:dibujo*))))
    (progn 
      (vla-load tmp 
                nombre
                (if (= (getvar "measurement"1
                  (findfile "acadiso.lin")
                  (findfile "acad.lin")))
      (vla-put-ActiveLinetype *aevl:dibujo* (vla-item tmp nombre)))
    (vla-put-ActiveLinetype *aevl:dibujo* (vla-item tmp nombre))))
;;;Listado 10.44. Cargar un Tipo de Línea utilizando ActiveX.

(defun ax-define-carga-tipolin (nombre descripcion definicion / arch arch-id) 
  (setq arch    (vl-filename-mktemp nil nil ".lin")
        arch-id (open arch "w"))
  (write-line (strcat "*" nombre "," descripcion) arch-id)
  (write-line definicion arch-id)
  (close arch-id)
  (vla-load (vla-get-linetypes *aevl:dibujo*) nombre arch)
  (vl-file-delete arch))
;;;Listado 10.45. Definir y cargar un Tipo de Línea con ActiveX.

Comments