Las cotas de nivel (en 2D) están referenciadas a la coordenada “Y” del punto indicado por el usuario en el plano de trabajo actual, "SCP" (UCS) sistema de coordenadas personal o “SCU - SCP Universal” (WCS - UCS World) sistema de coordenadas universal.
Compativilidad
Probado con éxito en en AutoCAD v.2015-2016 (x64) y BricsCAD v.15 (x64)
Funcionamiento
- Indicar punto(s) en pantalla para insertar símbolos de cota de nivel (esta es la opción por defecto).
- Indicar "Actualizar" para actualizar símbolos ya insertados en el documento. (Valor de cota, color, escala, etc.)
- Indicar “Opciones” para modificar las opciones de símbolos y planos de trabajo
Opciones
Tipo de símbolo y opciones de texto.
Los planos de trabajo son la definición de nuestra coordenada de origen “0.0” en un sistema de coordenadas personal "SCP" (UCS), donde la coordenada “Y”(2D) será nuestra coordenada de cotas de nivel. El programa utilizará por defecto el sistema de coordenadas de AutoCAD activo al momento de ejecutarse, pero podemos definir un plano de trabajo temporal (durante la ejecución del programa) donde trabajar con las cotas de nivel y guardar planos de trabajo para cambiar entre ellos rápidamente. Nota: Los planos de trabajo del programa se guardan como datos de diccionario en el documento activo y son independientes de los planos de coordenadas (UCS) de Autocad.
|
Personalización
El archivo de simbolos (Simbolos_dbx.dwg) es un archivo de Autocad
(dwg) que contiene los bloques de simbolos,
este se puede abrir con Autocad y editarse para añadir mas símbolos o
modificar los existentes (bajo la responsabilidad del usuario), personalmente
recomiendo hacer una copia de seguridad del archivo antes de modificarlo.
Nota: En el archivo de símbolos existen otro tipo de bloques que utilizamos con otro programa: "Símbolos de Detalle, Sección". (¡No borrarlos!).El programa listará solo los bloques cuyo nombre coincida con el patrón: "Z2_#*", donde "#" es un caracter numerico y "*" es cualquier texto identificativo. (ejemplo: Z2_9, Z2_18 o Z2_1_bis). Hay que tener esto en cuenta a la hora de añadir un nuevo bloque de símbolo o modificar los existentes. Las imágenes que aparecen en el cuadro de dialogo están generadas por código, pero si creáis un nuevo bloque símbolo, podéis tomar una foto del mismo con el comando "SACAFOTO (_MSLIDE)" y guardarla en el mismo directorio que el archivo de símbolos y con nombre igual al del bloque creado con la extensión "sld". Esto hara que el programa localize la foto y la muestre en el cuadro de dialogo. |
Nombre de bloque Archivo de foto Z2_012 Z2_012.SLD
Nota:El programa usa el Objeto "ObjectDBX.AxDbDocument", para obtener e insertar los bloques de símbolos contenidos en el archivo Simbolos_dbx.dwg. Mientras este archivo este abierto en la misma sesión o en otra distinta (por el mismo u otro usuario), el programa no funcionará, devolverá un error, informando de que el archivo no se pudo abrir para su uso. |
Codigo y descarga.
Código
Select all
;;********************************* C:Niveles_Z ****************************************
;;Revisiones:
;; Versión 2.0.0
;; José Luis García Galán 12/09/15
;; Versión 1.2.0
;; José Luis García Galán 11/11/14
;; Versión 1.1.9
;; José Luis García Galán 27/05/11
;;
;;PROGRAMA DE INSERCION DE COTA DE ALTURAS PARA SECCIONES
;;**************************************************************************************
(defun C:Niveles_Z (/ ;|Registro|; BL_COT ESC_Z2 MULTI_L COL_BL COL_ATT
;|dict Doc|; U_DEC *PlsTrabajo* *PLACTIVO* *PLATINIC* *TextStyleAtt* *LayerSimb*
;|Locales |; $NameFileDat$ $PathFileDat$ $LstSimbsZ2$ $SubPath$ $UcsAutocad$ $UcsTempWithDCL$
p1 num p3 esc_dibu Z2Ins atribs
;|funciones|; CotaNivel_DLG *error* UpdatePropsAtt SignoZ ATT:GETS Actualiza_z2
SimbToActiveDoc OpenDrawingDBX GetSimbsZ2InDWGDat StyTxtAPPS
GetVal_Reg_Z2 GetVal_DCT_Z2 SetVal_DCT_Z2 FinalizaUCS_Z2
)
;;--------------------------------- GetVal_Reg_Z2 -------------------------------------------
;;Datos de usuario para el programa Z2 obtenidos y guardados en el registro de Windows
;; (mapcar (function (lambda (x) (set (read (car x)) (cadr x)))) (GetVal_Reg_Z2))
;;-------------------------------------------------------------------------------------------
(defun GetVal_Reg_Z2 ( / LisVal RetVal lis_fle)
(setq LisVal (list ;;'("MinHoja" "0.35" t) ;;example Force Write
'("col_bl" "((62 . 256))")
'("col_att" "((62 . 0))")
'("bl_cot" "z2_7")
'("multi_l" 0)
'("esc_z2" "1.000000")
))
;;(("col_bl" "((62 . 256))") ("col_att" "((62 . 0))") ("bl_cot" "z2_7") ("multi_l" 1) ("esc_z2" "0.66"))
(setq RetVal (jlgg-GetVal_Reg_Command LisVal "CotasAlzado"))
);c.defun
;;;================================ DICCIONARIO de Z2 =============================================
(defun GetVal_DCT_Z2 ( / LisVal)
(if (or (not (setq LisVal (vlax-ldata-get "DICT_LaMarmita" "CotasAlzado")))
(/= (length LisVal) 6))
(setq LisVal (list '("u_dec" . 2 )
'("*PlsTrabajo*" . nil )
'("*PlActivo*" . nil )
'("*PlAtInic*" . "0" )
'("*TextStyleAtt*" . "Arial" )
'("*LayerSimb*" . "ARQ_Niveles" )
)
LisVal (vlax-ldata-put "DICT_LaMarmita" "CotasAlzado" LisVal)
)
);c.if
LisVal
);c.defun
;;____________________________________________________________
(defun SetVal_DCT_Z2 (StrPKey PValue / LisVal)
(setq LisVal (GetVal_DCT_Z2)
LisVal (subst (cons StrPKey PValue)(assoc StrPKey LisVal) LisVal))
(vlax-ldata-put "DICT_LaMarmita" "CotasAlzado" LisVal)
);c.defun
;;----------------------------- GetSimbsZ2InDWGDat --------------------------------------
;;
;; (GetSimbsZ2InDWGDat "T:\\ACAD2005\\AppsAc2005\\Registro\\Final\\ESCALAS.dwg")
;;---------------------------------------------------------------------------------------
(defun GetSimbsZ2InDWGDat ( / ObjDbx ObjBlocks Each ListResult BlkName Description strEscala n)
(cond
((not (setq ObjDbx (OpenDrawingDBX $PathFileDat$)))
(setq ListResult (list "%ERROR%"))
)
(T
(setq ObjBlocks (vla-get-Blocks ObjDbx))
;- - - - - - - - - - - - - - - - - - - - - - - - - - -
(vlax-for Each ObjBlocks
;(vlax-dump-Object Each)
(cond
((and
(not (vl-catch-all-error-p
(setq BlkName (vl-catch-all-apply (function vla-get-Name) (list Each)))))
(wcmatch (strcase BlkName) "Z2_#*")
);c.and
;; (print "Bloque: ") (princ BlkName)
;; (print "Descripción: ")(princ BlkDescription)
;; (print "Escala: ") (princ strEscala)
(setq ListResult (cons BlkName ListResult))
)
)
);c.vlax-for
(jlgg-release-object (list ObjDbx ObjBlocks))
;- - - - - - - - - - - - - - - - - - - - - - - - - - -
)
);c.cond
(setq ListResult (vl-sort ListResult (function (lambda (e1 e2) (< e1 e2)))))
);c.defun
;;------------------------ OpenDrawingDBX ------------------------------------------
;; Abrir un archivo de Autocad sín necesidad de abrirlo en Autocad
;; Carga de la intrfaz y comprobaciones de apertura
;; Ejemplo: (setq a (OpenDrawingDBX "E:\\PROGRAMACION\\UTAS\\Ejemplo_UTA1.dbx"))
;; devuelve: #
;;----------------------------------------------------------------------------------
(defun OpenDrawingDBX (filename / FullPathFile checkFile ObjDbx release)
(cond
((or (not filename)
(/= (type filename) 'STR))
(alert "ERROR:\nArgumento para la ruta de archivo No Valido.")
)
((not (setq FullPathFile (findfile filename)))
(alert
(strcat "El Archivo de Datos: \n[ " filename " ]"
"\n\n No se encontro."
" Compruebe la ruta del archivo."))
)
;;Comprobamos la carga de la interfaz
((not
(vl-catch-all-apply (function (lambda ()
;;Obtención de la Interfaz del Objeto: ObjectDBX
(setq ObjDbx (vlax-create-object
(if (< (setq release (atoi (getvar "ACADVER"))) 16)
"ObjectDBX.AxDbDocument"
(strcat "ObjectDBX.AxDbDocument." (itoa release)))))))))
(alert
(strcat "No se pudo obtener la interfaz de [ObjectDBX]"
"\nConsulte al programador."))
(jlgg-release-object (list ObjDbx))
(setq ObjDbx nil)
)
;; el archivo esta abierto por otro usuario (solo lectura) o esta dañado
((vl-catch-all-error-p
(vl-catch-all-apply 'vla-open (list ObjDbx FullPathFile)))
(alert
(strcat "El Archivo de Datos: "
(vl-filename-base FullPathFile) (vl-filename-extension FullPathFile) "\n"
"\n No se pudo abrir para su uso."
"\n Compruebe si el archivo esta en uso o dañado."
"\n Despues, Pruebe a ejecutar el comando de nuevo."))
(jlgg-release-object (list ObjDbx))
(setq ObjDbx nil)
)
)
ObjDbx
);c.defun
;;------------------------------- SimbToActiveDoc ---------------------------------------------
;; Carga el bloque de Escala al dibujo actual
;; strNameBlk: Nombre del bloque a pasar al documento actual
;;---------------------------------------------------------------------------------------------
(defun SimbToActiveDoc (strNameBlk / RetVal ObjDbx ActiveDoc ActdBlksCol DBXModelSP Obj n
;|Funciones|; MakeCopyObj)
;;------------------------------- MakeCopyObj ----------------------------------------
;;Función que copia un objeto del documento en archivo al documento activo de Autocad
;;------------------------------------------------------------------------------------
(defun MakeCopyObj (Obj / NewObj)
(cond
((and
(not (vl-catch-all-error-p
(setq NewObj (vl-catch-all-apply
(function vla-CopyObjects)
(list ObjDbx
(vlax-safearray-fill
(vlax-make-safearray vlax-vbObject '(0 . 0))
(list Obj)
)
ActdBlksCol)))
))
NewObj
)
(setq RetVal T)
;;(setq NewObj (car (vlax-safearray->list (vlax-variant-value NewObj))))
)
);c.cond
RetVal
);c.defun
;;------------------------- MAIN -------------------------------------------
(setq ActiveDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq ActdBlksCol (vla-get-Blocks ActiveDoc))
(cond
((not (setq ObjDbx (OpenDrawingDBX $PathFileDat$)))
(setq RetVal nil)
)
(T
(setq DBXBlocks (vla-get-Blocks ObjDbx)) ;blocks Colection en Dibujo de datos de bloques
(setq Obj (vla-item DBXBlocks strNameBlk))
(setq RetVal (MakeCopyObj Obj))
)
);c.cond
;- - - - - - - - - - - - - - - - - - - - - - - - - - -
(jlgg-release-object (list ActiveDoc ActdBlksCol ObjDbx DBXBlocks))
RetVal
);c.defun
;;------------------------------------ CotaNivel_DLG ---------------------------------------------
;; funcion de opciones del programa en cuadro de dialogo
;;
;;------------------------------------------------------------------------------------------------
(defun CotaNivel_DLG (/ ;|Registro |; BL_COT ESC_Z2 MULTI_L COL_BL COL_ATT
;|dict Doc |; U_DEC *PLSTRABAJO* *PLACTIVO* *PLATINIC* *TextStyleAtt* *LayerSimb*
;|Locales |; FichDlg idxDlg accion retVal dist_orig_Tmp pOrg pX oUcs LstTmp
&TmpLayers& &TmpStyles&
;|Funciones|; WriteDialogZ2 do_lst_simb do_img_z2 img_z2 z2_ok do_num
do_ddcol im_col Do_Dec Cfg_PlanosTrabajo
Do_SelStyle Do_SelLay do_Chk_NameValid
;|Funciones Imagen|; vectors_z2_1 vectors_z2_2 vectors_z2_3 vectors_z2_4 vectors_z2_5
vectors_z2_6 vectors_z2_7 vectors_z2_8)
;;---------------------------------- WriteDialogZ2P ---------------------------------------
;; Definir archivo de cuadro de dialogo
;;-----------------------------------------------------------------------------------------
(DEFUN WriteDialogZ2 ( / dir FichDlg openFile)
(setq dir (getvar "TEMPPREFIX"))
(setq FichDlg (strcat dir "$CotaNivel_Z$.dcl"))
(cond
;;(T ;;Forzar reescribir el cuadro (programando)
((not (findfile FichDlg))
(setq openFile (open FichDlg "w"))
(write-line "// ---------------------------------------------------------------" openFile)
(write-line "// CUADRO DE DIALOGO DE COTAS PARA SECCIONES" openFile)
(write-line "// ---------------------------------------------------------------" openFile)
(write-line "Nivel_Z : dialog {" openFile)
(write-line " label = \"Cotas de nivel para secciones\";" openFile)
(write-line " : boxed_column {" openFile)
(write-line " fixed_width = true;" openFile)
(write-line " fixed_height = true;" openFile)
(write-line " label = \"Tipo de cota y opciones de texto:\";" openFile)
(write-line " : row {" openFile)
(write-line " fixed_width = true;" openFile)
(write-line " fixed_height = true;" openFile)
(write-line " children_alignment = top;" openFile)
(write-line " : image_button {" openFile)
(write-line " key = \"img_z2\";" openFile)
(write-line " width = 18.0;" openFile)
(write-line " fixed_width = true;" openFile)
(write-line " height = 6.0;" openFile)
(write-line " fixed_height = true;" openFile)
(write-line " color = graphics_background;" openFile)
(write-line " //color = dialog_background;" openFile)
(write-line " }" openFile)
(write-line " : list_box {" openFile)
(write-line " horizontal_margin = none;" openFile)
(write-line " fixed_width = true;" openFile)
(write-line " width = 20.8;" openFile)
(write-line " height = 6.5;" openFile)
(write-line " fixed_height = true;" openFile)
(write-line " key = \"lst_simb\";" openFile)
(write-line " }//c.list_box" openFile)
(write-line " }" openFile)
(write-line " : toggle {label = \"Atributo Multi-línea (MText)\";" openFile)
(write-line " key = \"multi_l\";" openFile)
(write-line " horizontal_margin = none;" openFile)
(write-line " }" openFile)
(write-line " : row {" openFile)
(write-line " fixed_width = true;" openFile)
(write-line " : text_part {" openFile)
(write-line " key = \"lbl#03\"; //label = \"Altura:\";" openFile)
(write-line " fixed_width = true;" openFile)
(write-line " width = 12;" openFile)
(write-line " }" openFile)
(write-line " : edit_box {" openFile)
(write-line " horizontal_margin = none;" openFile)
(write-line " key = \"esc_z2\";" openFile)
(write-line " value = \"1.0\";" openFile)
(write-line " fixed_width = true;" openFile)
(write-line " width = 12;" openFile)
(write-line " }" openFile)
(write-line " : spacer { width = 0.1; }" openFile)
(write-line " : popup_list {" openFile)
(write-line " horizontal_margin = none;" openFile)
(write-line " key = \"u_dec\";" openFile)
(write-line " list = \"0 \\n0.0 \\n0.00 \\n0.000 \\n0.0000 \\n0.00000 \\n0.000000 \\n0.0000000 \\n0.00000000\";" openFile)
(write-line " fixed_width = true;" openFile)
(write-line " width = 14;" openFile)
(write-line " }" openFile)
(write-line " }//c.row" openFile)
(write-line " : row {" openFile)
(write-line " fixed_width = true;" openFile)
(write-line " : text_part {" openFile)
(write-line " vertical_margin = none;" openFile)
(write-line " key = \"lbl#01\"; //label = \"Color:\";" openFile)
(write-line " fixed_width = true;" openFile)
(write-line " width = 12;" openFile)
(write-line " }" openFile)
(write-line " : image_button {" openFile)
(write-line " horizontal_margin = none;" openFile)
(write-line " key = \"col_bl\";" openFile)
(write-line " width = 3;" openFile)
(write-line " aspect_ratio = 1.0;" openFile)
(write-line " }" openFile)
(write-line " : text {" openFile)
(write-line " key = \"col_bl_t\";" openFile)
(write-line " fixed_width = true;" openFile)
(write-line " width = 23; " openFile)
(write-line " }" openFile)
(write-line " }//c.row" openFile)
(write-line " : row {" openFile)
(write-line " fixed_width = true;" openFile)
(write-line " : text_part {" openFile)
(write-line " key = \"lbl#05\"; //label = \"Color:\";" openFile)
(write-line " fixed_width = true;" openFile)
(write-line " width = 12;" openFile)
(write-line " }" openFile)
(write-line " : image_button {" openFile)
(write-line " horizontal_margin = none;" openFile)
(write-line " key = \"col_att\";" openFile)
(write-line " width = 3;" openFile)
(write-line " aspect_ratio = 1.0;" openFile)
(write-line " }" openFile)
(write-line " : text {" openFile)
(write-line " key = \"col_att_t\";" openFile)
(write-line " //label = \"\";" openFile)
(write-line " fixed_width = true;" openFile)
(write-line " width = 23; " openFile)
(write-line " }" openFile)
(write-line " }//c.row" openFile)
(write-line " : row {" openFile)
(write-line " vertical_margin = none;" openFile)
(write-line " fixed_height = true;" openFile)
(write-line " fixed_width = true;" openFile)
(write-line " : column {" openFile)
(write-line " fixed_height = true;" openFile)
(write-line " vertical_margin = none;" openFile)
(write-line " : text {" openFile)
(write-line " horizontal_margin = none;" openFile)
(write-line " label = \"Capa del símbolo:\";" openFile)
(write-line " }" openFile)
(write-line " : edit_box {" openFile)
(write-line " vertical_margin = none;" openFile)
(write-line " horizontal_margin = none;" openFile)
(write-line " key = \"*LayerSimb*\";" openFile)
(write-line " fixed_width = true;" openFile)
(write-line " width = 19.5;" openFile)
(write-line " }" openFile)
(write-line " : popup_list {" openFile)
(write-line " horizontal_margin = none;" openFile)
(write-line " vertical_margin = none;" openFile)
(write-line " key = \"lis_lay\";" openFile)
(write-line " fixed_width = true;" openFile)
(write-line " width = 19.5;" openFile)
(write-line " }" openFile)
(write-line " }" openFile)
(write-line " : spacer { width = 0.1; }" openFile)
(write-line " : column {" openFile)
(write-line " fixed_height = true;" openFile)
(write-line " vertical_margin = none;" openFile)
(write-line " : text {" openFile)
(write-line " horizontal_margin = none;" openFile)
(write-line " label = \"Estilo de texto:\";" openFile)
(write-line " }" openFile)
(write-line " : edit_box {" openFile)
(write-line " horizontal_margin = none;" openFile)
(write-line " vertical_margin = none;" openFile)
(write-line " key = \"*TextStyleAtt*\";" openFile)
(write-line " fixed_width = true;" openFile)
(write-line " width = 19.5;" openFile)
(write-line " }" openFile)
(write-line " : popup_list {" openFile)
(write-line " horizontal_margin = none;" openFile)
(write-line " vertical_margin = none;" openFile)
(write-line " key = \"lis_stxt\";" openFile)
(write-line " fixed_width = true;" openFile)
(write-line " width = 19.5;" openFile)
(write-line " }" openFile)
(write-line " }" openFile)
(write-line " }//c.row" openFile)
(write-line " : spacer { height = 0.0; }" openFile)
(write-line " }//c.boxed_column" openFile)
(write-line " : boxed_column {" openFile)
(write-line " fixed_width = true;" openFile)
(write-line " fixed_height = true;" openFile)
(write-line " children_fixed_height = true;" openFile)
(write-line " " openFile)
(write-line " label = \"Plano de trabajo \";" openFile)
(write-line " : button {" openFile)
(write-line " vertical_margin = none;" openFile)
(write-line " label = \"Definir nuevo plano de trabajo >\";" openFile)
(write-line " key = \"OXY_New\"; " openFile)
(write-line " fixed_width = true;" openFile)
(write-line " width = 38.75;" openFile)
(write-line " }" openFile)
(write-line " : spacer {height = 0.1;}" openFile)
(write-line " : text {" openFile)
(write-line " vertical_margin = none;" openFile)
(write-line " width = 2; key = \"lbl#04\"; //label = \"Planos Guardados:\";" openFile)
(write-line " }" openFile)
(write-line " : popup_list {" openFile)
(write-line " key = \"*PlsTrabajo*\";" openFile)
(write-line " fixed_width = true;" openFile)
(write-line " width = 38.75;" openFile)
(write-line " }" openFile)
(write-line " : row {" openFile)
(write-line " fixed_height = true;" openFile)
(write-line " fixed_width = true;" openFile)
(write-line " : button {" openFile)
(write-line " alignment = left;" openFile)
(write-line " label = \"Guardar\";" openFile)
(write-line " key = \"OXY_Save\"; " openFile)
(write-line " }" openFile)
(write-line " : button {" openFile)
(write-line " horizontal_margin = none;" openFile)
(write-line " alignment = left;" openFile)
(write-line " label = \"Eliminar\";" openFile)
(write-line " key = \"OXY_Del\"; " openFile)
(write-line " }" openFile)
(write-line " }" openFile)
(write-line " : toggle {" openFile)
(write-line " key = \"*PlAtInic*\";" openFile)
(write-line " alignment=bottom;" openFile)
(write-line " value = 1;" openFile)
(write-line " fixed_width = true;" openFile)
(write-line " width = 39;" openFile)
(write-line " label = \"Activar al inicio último utilizado.\";" openFile)
(write-line " }" openFile)
(write-line "" openFile)
(write-line " }//c.boxed_column" openFile)
(write-line " : spacer {height = 0.1;}" openFile)
(write-line " ok_cancel_err;" openFile)
(write-line "}" openFile)
(write-line "" openFile)
(write-line "" openFile)
(write-line "newnamepl : dialog { initial_focus=\"input\";" openFile)
(write-line " alignment = centered; " openFile)
(write-line " label = \"Guardar plano de trabajo.\";" openFile)
(write-line " : paragraph {" openFile)
(write-line " : text_part {" openFile)
(write-line " label = \"Indique Nombre del plano de trabajo:\";" openFile)
(write-line " width = 40;" openFile)
(write-line " fixed_width = true;" openFile)
(write-line " }" openFile)
(write-line " }" openFile)
(write-line " //spacer;" openFile)
(write-line " : edit_box {" openFile)
(write-line " key = \"input\";" openFile)
(write-line " allow_accept = true;" openFile)
(write-line " }" openFile)
(write-line " spacer;" openFile)
(write-line " : row {" openFile)
(write-line " fixed_width = true;" openFile)
(write-line " alignment = right;" openFile)
(write-line " : button { label = \"&Aceptar\"; is_default = true; key = \"accept\"; width = 10; fixed_width = true;}" openFile)
(write-line " : button { label = \"&Cancelar\"; is_cancel = true; key = \"cancel\"; width = 10; fixed_width = true;}" openFile)
(write-line " }" openFile)
(write-line "}" openFile)
(close openFile)
)
);c.cond
FichDlg
);c.defun
;;____________________________________________________________
;; accion de chequeo de color
(defun im_col (key c / long alto)
(setq long (dimx_tile key)
alto (dimy_tile key)
);c.s.
(start_image key)
(fill_image 0 0 long alto c)
(end_image)
)
;;____________________________________________________________
(DEFUN do_ddcol (key / c atomTmp coltmp ) col_att col_bl
(setq atomTmp (read key))
(setq coltmp (eval atomTmp))
(if (setq c (acad_truecolordlg (nth (1- (length coltmp)) coltmp) t))
(progn
(set atomTmp c)
(im_col key (cdr (assoc 62 c)))
(setq key (strcat key "_t"))
(set_tile key (jlgg-NameCol c))
);c.prg
);c.if
)
;;____________________________________________________________
;; accion de chequeo de decimales
(defun Do_Dec (val / )
(setq u_dec (atoi val))
;;(setvar "LUPREC" u_dec)
(set_tile "esc_z2" (rtos esc_z2 2 u_dec))
)
;;_____________________________________________________________
;; accion de chequeo de numeros
;;(ACTION_TILE "esc_z2" "(do_num $key \"Altura de Texto \" 6)")
(defun do_num ( ll mens cod / r)
(if (setq r (jlgg-test_numr (get_tile ll) mens cod)) ; si es valida
(progn
(set_tile "error" "")
(set (read ll) r)
(set_tile ll (rtos r 2 u_dec))
);c.prg
(progn
(mode_tile ll 2)(mode_tile ll 3)
)
);c.if
)
;;____________________________________________________________
;;testeo de aceptar
(defun z2_ok()
(cond
((not (jlgg-test_numr (get_tile "esc_z2") "Altura de Texto " 6)))
(t
(setq pos_Dlg_Z2 (done_dialog 1))
;(Print "mal diseñado")
)
);c.cond
);c.defun
;;____________________________________________________________
;;define el tipo de cota
(defun do_lst_simb (Val)
(setq bl_cot (nth Val $LstSimbsZ2$))
(img_z2)
)
;;____________________________________________________________
(defun do_img_z2 (/ i )
(setq i (vl-position bl_cot $LstSimbsZ2$))
(if (not (setq bl_cot (nth (1+ i) $LstSimbsZ2$)))
(setq bl_cot (car $LstSimbsZ2$))
)
(set_tile "lst_simb" (itoa (vl-position bl_cot $LstSimbsZ2$)))
(img_z2)
)
;;____________________________________________________________
(defun img_z2 (/ long alto f)
(start_image "img_z2")
(setq long (dimx_tile "img_z2")
alto (dimy_tile "img_z2")
);c.s.
(fill_image 0 0 long alto -2)
(if (boundp (read (strcat "vectors_" bl_cot )))
(eval (read (strcat "(vectors_" bl_cot ")")))
;;Else:
(if (setq f (findfile (strcat $SubPath$ bl_cot ".sld")))
(slide_image 0 0 long alto f)
;(slide_image 0 0 long alto (strcat $SubPath$ "simbolos(" bl_cot ")")) ;para biblioteca "slb"
)
);c.if
(end_image)
);c.defun
;;______________________________________________________________________________________
;;Vectores de imagen creados con el programa GetVectors (directorio DCL de programación)
;;Rectangulo 90x65 (ver dibujo "Dibujo 25-11-07.dwg" en el mismo directorio)
;;Imagen del simbolo z2_1
(defun vectors_z2_1 ()
(mapcar 'vector_image; Color 7
(list 16 16 17 17 18 18 19 19 19 20 20 21 21 21 21 22 22 22 22 23 23 23 23 23 24 24 24 24 24 24 24 24 24 24 24 24 24 23 23 23 23 23 23 22 22 22 22 21 21 21 21 20 20 19 19 19 18 18 17 17 16 16 15 15 14 14 13 13 12 12 12 12 11 11 10 10 9 9 9 8 8 8 8 8 8 8 7 7 7 7 7 7 7 8 8 8 8 8 8 8 9 9 9 9 10 10 11 11 12 12 12 12 13 13 14 14 15 15 4 4)
(list 26 26 26 26 26 26 26 26 27 27 27 27 27 28 28 28 28 29 29 29 30 30 31 31 31 31 32 32 33 33 34 34 35 35 36 36 37 37 37 37 38 38 39 39 39 39 40 40 40 40 41 41 41 41 41 42 42 42 42 42 42 42 42 42 42 42 42 42 42 42 41 41 41 41 40 40 39 39 38 38 38 37 37 36 36 35 35 35 34 34 33 33 33 32 32 31 31 30 30 30 30 29 29 29 28 28 27 27 27 26 26 26 26 26 26 26 26 26 46 22)
(list 16 17 17 18 18 19 19 19 20 20 21 21 21 21 22 22 22 22 23 23 23 23 23 24 24 24 24 24 24 24 24 24 24 24 24 24 24 24 23 23 23 23 23 23 22 22 22 22 21 21 21 21 20 20 19 19 19 18 18 17 17 16 16 15 15 14 14 13 13 12 12 12 12 11 11 10 10 9 9 9 8 8 8 8 8 8 8 7 7 7 7 7 8 8 8 8 8 8 8 9 9 9 9 10 10 11 11 12 12 12 12 13 13 14 14 15 15 16 28 28)
(list 26 26 26 26 26 26 26 27 27 27 27 27 28 28 28 28 29 29 29 30 30 31 31 31 31 32 32 33 33 34 34 35 35 36 36 37 37 37 37 38 38 39 39 39 39 40 40 40 40 41 41 41 41 41 42 42 42 42 42 42 42 42 42 42 42 42 42 42 42 42 42 41 41 41 41 40 40 39 39 38 38 38 37 37 36 36 35 35 35 34 34 33 33 33 32 32 31 31 30 30 30 30 29 28 28 27 27 27 27 27 26 26 26 26 26 26 26 26 22 46)
(list 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7)
);mapcar
(mapcar 'vector_image; Color 3
(list 79 79 81 82 83 84 83 82 81 79 78 76 76 76 76 76 78 67 67 69 70 72 72 72 70 69 67 66 64 64 64 64 64 66 59 59 59 58 58 50 50 51 53 54 54 54 53 51 50 48 47 46 46 46 47 48 31 31 36)
(list 12 12 12 13 15 18 22 24 25 25 24 22 19 18 15 15 13 12 12 12 13 15 18 19 24 25 25 24 22 19 18 15 15 13 24 24 25 24 24 12 12 12 13 15 18 19 24 25 25 24 22 19 18 18 15 13 24 18 12)
(list 79 81 82 83 84 84 84 83 82 81 79 78 76 76 76 78 79 67 69 70 72 72 72 72 72 70 69 67 66 64 64 64 66 67 59 60 60 59 59 50 51 53 54 54 54 54 54 53 51 50 48 47 46 47 48 50 42 42 36)
(list 12 12 13 15 18 19 19 22 24 25 25 24 22 19 18 13 12 12 12 13 15 18 19 22 22 24 25 25 24 22 19 18 13 12 24 24 24 25 24 12 12 13 15 18 19 22 22 24 25 25 24 22 19 15 13 12 24 18 23)
(list 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3)
);mapcar
)
;;Imagen del simbolo z2_2
(defun vectors_z2_2 ()
(mapcar 'vector_image; Color 7
(list 5 5 18 30)
(list 26 26 48 26)
(list 30 18 30 85)
(list 26 48 26 26)
(list 7 7 7 7)
);mapcar
(mapcar 'vector_image; Color 30
(list 64 59 59 67 67 64)
(list 59 47 47 44 44 59)
(list 67 67 71 71 76 76)
(list 48 48 33 33 45 45)
(list 30 30 30 30 30 30)
);mapcar
(mapcar 'vector_image; Color 3
(list 81 81 82 84 85 86 85 84 82 81 79 78 78 78 78 78 79 69 69 71 72 73 74 73 72 71 69 68 66 66 66 66 66 68 61 61 61 60 60 51 51 53 54 56 56 56 54 53 51 50 49 48 48 48 49 50 33 33 38)
(list 10 10 10 10 12 15 20 22 22 22 22 20 17 15 12 12 10 10 10 10 10 12 15 20 22 22 22 22 20 17 15 12 12 10 21 21 22 22 22 10 10 10 10 12 15 17 22 22 22 22 20 17 15 15 12 10 22 15 10)
(list 81 82 84 85 86 86 86 85 84 82 81 79 78 78 78 79 81 69 71 72 73 74 74 74 73 72 71 69 68 66 66 66 68 69 61 62 62 61 61 51 53 54 56 56 56 56 56 54 53 51 50 49 48 49 50 51 44 44 38)
(list 10 10 10 12 15 17 17 20 22 22 22 22 20 17 15 10 10 10 10 10 12 15 17 17 20 22 22 22 22 20 17 15 10 10 21 22 22 22 21 10 10 10 12 15 17 20 20 22 22 22 22 20 17 12 10 10 22 15 21)
(list 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3)
);mapcar
)
;;Imagen del simbolo z2_3
(defun vectors_z2_3 ()
(mapcar 'vector_image; Color 7
(list 7 13 26)
(list 39 50 29)
(list 13 26 85)
(list 50 29 29)
(list 7 7 7)
);mapcar
(mapcar 'vector_image; Color 30
(list 64 59 59 67 67 64)
(list 59 47 47 44 44 59)
(list 67 67 71 71 76 76)
(list 48 48 33 33 45 45)
(list 30 30 30 30 30 30)
);mapcar
(mapcar 'vector_image; Color 3
(list 79 79 80 82 83 84 83 82 80 79 77 76 76 76 76 76 77 67 67 69 70 72 72 72 70 69 67 66 64 64 64 64 64 66 59 59 59 58 58 50 50 51 52 54 54 54 52 51 50 48 47 46 46 46 47 48 31 31 36)
(list 12 12 12 13 14 17 22 24 25 25 24 22 19 17 14 14 13 12 12 12 13 14 17 19 24 25 25 24 22 19 17 14 14 13 23 23 25 24 24 12 12 12 13 14 17 19 24 25 25 24 22 19 17 17 14 13 24 17 12)
(list 79 80 82 83 84 84 84 83 82 80 79 77 76 76 76 77 79 67 69 70 72 72 72 72 72 70 69 67 66 64 64 64 66 67 59 60 60 59 59 50 51 52 54 54 54 54 54 52 51 50 48 47 46 47 48 50 42 42 36)
(list 12 12 13 14 17 19 19 22 24 25 25 24 22 19 17 13 12 12 12 13 14 17 19 22 22 24 25 25 24 22 19 17 13 12 23 24 24 25 23 12 12 13 14 17 19 22 22 24 25 25 24 22 19 14 13 12 24 17 23)
(list 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3)
);mapcar
)
;;Imagen del simbolo z2_4
(defun vectors_z2_4 ()
(mapcar 'vector_image; Color 251
(list 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24)
(list 35 33 33 34 35 36 37 38 38 37 36 35 34 33 34 35)
(list 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24)
(list 43 44 44 43 42 41 40 39 39 40 41 42 43 44 44 42)
(list 251 251 251 251 251 251 251 251 251 251 251 251 251 251 251 251)
);mapcar
(mapcar 'vector_image; Color 7
(list 17 17 17 18 18 19 19 20 20 21 21 21 22 22 22 22 23 23 23 23 24 24 24 24 24 24 25 25 25 25 25 25 25 25 25 25 25 24 24 24 24 23 23 23 22 22 21 21 20 20 20 19 19 18 18 17 17 16 16 15 15 14 14 13 13 12 12 12 11 11 10 10 10 10 9 9 9 9 9 9 8 8 8 8 8 8 8 8 8 9 9 9 9 9 9 10 10 10 10 11 11 11 12 12 13 13 14 14 15 15 16 16 16 16 5 5 29)
(list 30 30 31 31 31 31 31 31 31 31 32 32 32 32 33 33 33 33 34 34 34 34 35 35 36 36 36 36 37 37 38 38 39 39 40 40 41 42 42 42 43 44 44 44 45 45 46 46 46 46 46 47 47 47 47 47 47 47 47 47 47 47 47 46 46 46 46 45 45 45 44 44 43 43 43 43 42 42 41 41 40 40 39 39 38 38 37 37 37 37 36 36 35 35 35 34 33 33 33 33 32 32 32 32 31 31 31 31 31 31 31 30 30 30 51 27 27)
(list 17 17 18 18 19 19 20 20 21 21 21 22 22 22 22 23 23 23 23 24 24 24 24 24 24 25 25 25 25 25 25 25 25 25 25 25 25 25 24 24 24 24 23 23 23 22 22 21 21 20 20 20 19 19 18 18 17 17 16 16 15 15 14 14 13 13 12 12 12 11 11 10 10 10 10 9 9 9 9 9 9 8 8 8 8 8 8 8 9 9 9 9 9 9 10 10 10 10 11 11 11 12 12 13 13 14 14 15 15 16 16 16 16 17 29 29 83)
(list 30 31 31 31 31 31 31 31 31 32 32 32 32 33 33 33 33 34 34 34 34 35 35 36 36 36 36 37 37 38 38 39 39 40 40 41 41 41 42 43 43 43 44 45 45 45 45 46 46 46 47 47 47 47 47 47 47 47 47 47 47 47 47 47 46 46 46 46 45 45 45 44 44 43 43 43 43 42 42 41 41 40 40 39 39 38 38 37 37 37 37 36 36 35 34 34 34 33 33 33 33 32 32 31 31 31 31 31 31 31 31 31 30 30 27 51 27)
(list 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7)
);mapcar
(mapcar 'vector_image; Color 30
(list 64 59 59 67 67 64)
(list 59 47 47 44 44 59)
(list 67 67 71 71 76 76)
(list 48 48 33 33 45 45)
(list 30 30 30 30 30 30)
);mapcar
(mapcar 'vector_image; Color 3
(list 79 79 80 82 83 84 83 82 80 79 77 76 76 76 76 76 77 67 67 69 70 72 72 72 70 69 67 66 64 64 64 64 64 66 59 59 59 58 58 50 50 51 52 54 54 54 52 51 50 48 47 46 46 46 47 48 31 31 36)
(list 11 11 11 11 13 16 21 23 23 23 23 21 18 16 13 13 11 11 11 11 11 13 16 18 23 23 23 23 21 18 16 13 13 11 22 22 23 23 23 11 11 11 11 13 16 18 23 23 23 23 21 18 16 16 13 11 23 16 11)
(list 79 80 82 83 84 84 84 83 82 80 79 77 76 76 76 77 79 67 69 70 72 72 72 72 72 70 69 67 66 64 64 64 66 67 59 60 60 59 59 50 51 52 54 54 54 54 54 52 51 50 48 47 46 47 48 50 42 42 36)
(list 11 11 11 13 16 18 18 21 23 23 23 23 21 18 16 11 11 11 11 11 13 16 18 21 21 23 23 23 23 21 18 16 11 11 22 23 23 23 22 11 11 11 13 16 18 21 21 23 23 23 23 21 18 13 11 11 23 16 21)
(list 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3)
);mapcar
)
;;Imagen del simbolo z2_5
(defun vectors_z2_5 ()
(mapcar 'vector_image; Color 251
(list 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26)
(list 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26)
(list 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26)
(list 27 28 30 32 33 35 37 39 40 42 44 46 47 47 45 43 42 40 38 37 35 33 31 30 28)
(list 251 251 251 251 251 251 251 251 251 251 251 251 251 251 251 251 251 251 251 251 251 251 251 251 251)
);mapcar
(mapcar 'vector_image; Color 7
(list 27 2 2 15)
(list 26 26 26 48)
(list 87 27 15 27)
(list 26 26 48 26)
(list 7 7 7 7)
);mapcar
(mapcar 'vector_image; Color 30
(list 64 59 59 67 67 64)
(list 59 47 47 44 44 59)
(list 67 67 71 71 76 76)
(list 48 48 33 33 45 45)
(list 30 30 30 30 30 30)
);mapcar
(mapcar 'vector_image; Color 3
(list 78 78 79 81 82 83 82 81 79 78 76 75 75 75 75 75 76 66 66 67 69 70 71 70 69 67 66 64 63 63 63 63 63 64 58 58 58 57 57 48 48 50 51 53 53 53 51 50 48 47 45 45 45 45 45 47 30 30 35)
(list 10 10 10 10 12 15 20 22 22 22 22 20 17 15 12 12 10 10 10 10 10 12 15 20 22 22 22 22 20 17 15 12 12 10 21 21 22 22 22 10 10 10 10 12 15 17 22 22 22 22 20 17 15 12 12 10 22 15 10)
(list 78 79 81 82 83 83 83 82 81 79 78 76 75 75 75 76 78 66 67 69 70 71 71 71 70 69 67 66 64 63 63 63 64 66 58 59 59 58 58 48 50 51 53 53 53 53 53 51 50 48 47 45 45 45 47 48 41 41 35)
(list 10 10 10 12 15 17 17 20 22 22 22 22 20 17 15 10 10 10 10 10 12 15 17 17 20 22 22 22 22 20 17 15 10 10 21 22 22 22 21 10 10 10 12 15 17 20 20 22 22 22 22 20 17 15 10 10 22 15 21)
(list 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3)
);mapcar
)
;;Imagen del simbolo z2_6
(defun vectors_z2_6 ()
(mapcar 'vector_image; Color 30
(list 64 59 59 67 67 64)
(list 59 47 47 44 44 59)
(list 67 67 71 71 76 76)
(list 48 48 33 33 45 45)
(list 30 30 30 30 30 30)
);mapcar
(mapcar 'vector_image; Color 7
(list 20 2 22 2 22)
(list 28 39 49 38 26)
(list 86 43 43 22 22)
(list 28 39 38 49 49)
(list 7 7 7 7 7)
);mapcar
(mapcar 'vector_image; Color 3
(list 81 81 82 84 85 86 85 84 82 81 80 78 78 78 78 78 80 69 69 71 72 74 74 74 72 71 69 68 66 66 66 66 66 68 61 61 61 60 60 52 52 53 55 56 56 56 55 53 52 50 49 48 48 48 49 50 33 33 38)
(list 11 11 11 11 13 16 21 23 23 23 23 21 18 16 13 13 11 11 11 11 11 13 16 18 23 23 23 23 21 18 16 13 13 11 22 22 23 23 23 11 11 11 11 13 16 18 23 23 23 23 21 18 16 16 13 11 23 16 11)
(list 81 82 84 85 86 86 86 85 84 82 81 80 78 78 78 80 81 69 71 72 74 74 74 74 74 72 71 69 68 66 66 66 68 69 61 62 62 61 61 52 53 55 56 56 56 56 56 55 53 52 50 49 48 49 50 52 44 44 38)
(list 11 11 11 13 16 18 18 21 23 23 23 23 21 18 16 11 11 11 11 11 13 16 18 21 21 23 23 23 23 21 18 16 11 11 22 23 23 23 22 11 11 11 13 16 18 21 21 23 23 23 23 21 18 13 11 11 23 16 21)
(list 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3)
);mapcar
)
;;Imagen del simbolo z2_7
(defun vectors_z2_7 ()
(mapcar 'vector_image; Color 251
(list 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22)
(list 39 39 39 39 39 39 39 39 39 39 39 39 39 39 39 39 39 39 39)
(list 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22)
(list 39 39 40 41 41 42 42 43 43 44 45 45 46 46 47 47 48 49 49)
(list 251 251 251 251 251 251 251 251 251 251 251 251 251 251 251 251 251 251 251)
);mapcar
(mapcar 'vector_image; Color 30
(list 64 59 59 67 67 64)
(list 59 47 47 44 44 59)
(list 67 67 71 71 76 76)
(list 48 48 33 33 45 45)
(list 30 30 30 30 30 30)
);mapcar
(mapcar 'vector_image; Color 7
(list 20 2 22 2 22)
(list 28 39 49 38 26)
(list 86 43 43 22 22)
(list 28 39 38 49 49)
(list 7 7 7 7 7)
);mapcar
(mapcar 'vector_image; Color 3
(list 81 81 82 84 85 86 85 84 82 81 80 78 78 78 78 78 80 69 69 71 72 74 74 74 72 71 69 68 66 66 66 66 66 68 61 61 61 60 60 52 52 53 55 56 56 56 55 53 52 50 49 48 48 48 49 50 33 33 38)
(list 11 11 11 11 13 16 21 23 23 23 23 21 18 16 13 13 11 11 11 11 11 13 16 18 23 23 23 23 21 18 16 13 13 11 22 22 23 23 23 11 11 11 11 13 16 18 23 23 23 23 21 18 16 16 13 11 23 16 11)
(list 81 82 84 85 86 86 86 85 84 82 81 80 78 78 78 80 81 69 71 72 74 74 74 74 74 72 71 69 68 66 66 66 68 69 61 62 62 61 61 52 53 55 56 56 56 56 56 55 53 52 50 49 48 49 50 52 44 44 38)
(list 11 11 11 13 16 18 18 21 23 23 23 23 21 18 16 11 11 11 11 11 13 16 18 21 21 23 23 23 23 21 18 16 11 11 22 23 23 23 22 11 11 11 13 16 18 21 21 23 23 23 23 21 18 13 11 11 23 16 21)
(list 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3)
);mapcar
)
;;Imagen del simbolo z2_8
(defun vectors_z2_8 ()
(mapcar 'vector_image; Color 251
(list 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28)
(list 41 41 41 41 41 41 41 41 33 33 33 34 34 35 36 37 39)
(list 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28)
(list 44 46 47 48 49 49 50 50 41 41 41 41 41 41 41 41 41)
(list 251 251 251 251 251 251 251 251 251 251 251 251 251 251 251 251 251)
);mapcar
(mapcar 'vector_image; Color 30
(list 64 59 59 67 67 64)
(list 59 47 47 44 44 59)
(list 67 67 71 71 76 76)
(list 48 48 33 33 45 45)
(list 30 30 30 30 30 30)
);mapcar
(mapcar 'vector_image; Color 7
(list 20 20 21 21 22 22 22 22 23 23 24 24 24 24 25 25 25 26 26 26 27 27 27 27 27 27 28 28 28 28 28 28 28 28 28 27 27 27 27 27 27 26 26 26 26 25 25 25 24 24 24 24 23 23 22 22 22 21 21 20 20 19 19 18 18 17 17 17 16 16 15 15 15 15 14 14 14 13 13 13 13 12 12 12 12 12 12 11 11 11 11 11 11 11 11 11 11 11 12 12 12 12 12 12 13 13 13 13 14 14 14 15 15 15 15 16 16 17 17 17 17 18 18 19 19 20 3 20)
(list 33 33 33 33 33 33 34 34 34 34 34 34 35 35 35 35 36 36 36 37 37 37 38 38 39 39 39 40 40 41 41 42 42 43 43 44 44 44 45 45 46 46 46 46 47 47 47 48 48 48 48 49 49 49 49 49 49 50 50 50 50 50 50 50 50 50 49 49 49 49 49 49 48 48 48 48 47 47 47 46 46 46 46 45 45 44 44 44 43 43 42 42 41 41 40 40 39 39 39 38 38 37 37 37 37 36 36 36 35 35 35 35 34 34 34 34 34 34 33 33 33 33 33 33 33 25 41 25)
(list 20 21 21 22 22 22 22 23 23 24 24 24 24 25 25 25 26 26 26 27 27 27 27 27 27 28 28 28 28 28 28 28 28 28 28 28 27 27 27 27 27 27 26 26 26 26 25 25 25 24 24 24 24 23 23 22 22 22 21 21 20 20 19 19 18 18 17 17 17 16 16 15 15 15 15 14 14 14 13 13 13 13 12 12 12 12 12 12 11 11 11 11 11 11 11 11 11 12 12 12 12 12 12 13 13 13 13 14 14 14 15 15 15 15 16 16 17 17 17 17 18 18 19 19 20 20 36 73)
(list 33 33 33 33 33 34 34 34 34 34 34 35 35 35 35 36 36 36 37 37 37 38 38 39 39 39 40 40 41 41 42 42 43 43 44 44 44 45 45 46 46 46 46 47 47 47 48 48 48 48 49 49 49 49 49 49 50 50 50 50 50 50 50 50 50 50 50 49 49 49 49 49 49 48 48 48 48 47 47 47 46 46 46 46 45 45 44 44 44 43 43 42 42 41 41 40 40 39 39 39 38 38 37 37 37 37 36 36 36 35 35 35 35 34 34 34 34 34 34 33 33 33 33 33 33 58 41 25)
(list 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7)
);mapcar
(mapcar 'vector_image; Color 3
(list 74 74 76 77 78 79 78 77 76 74 73 71 71 71 71 71 73 62 62 64 65 67 67 67 65 64 62 61 59 59 59 59 59 61 54 54 54 54 54 45 45 46 48 49 49 49 48 46 45 43 42 41 41 41 42 43 26 26 31)
(list 7 7 7 8 10 12 17 19 20 20 19 17 14 12 10 10 8 7 7 7 8 10 12 14 19 20 20 19 17 14 12 10 10 8 18 18 20 19 18 7 7 7 8 10 12 14 19 20 20 19 17 14 12 12 10 8 19 12 7)
(list 74 76 77 78 79 79 79 78 77 76 74 73 71 71 71 73 74 62 64 65 67 67 67 67 67 65 64 62 61 59 59 59 61 62 54 55 55 54 54 45 46 48 49 49 49 49 49 48 46 45 43 42 41 42 43 45 37 37 31)
(list 7 7 8 10 12 14 14 17 19 20 20 19 17 14 12 8 7 7 7 8 10 12 14 17 17 19 20 20 19 17 14 12 8 7 18 19 19 20 19 7 7 8 10 12 14 17 17 19 20 20 19 17 14 10 8 7 19 12 18)
(list 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3)
);mapcar
);defun
;;------------------------ Cfg_PlanosTrabajo -----------------------
;;Configurar Planos de trabajo y plano activo del programa
;;------------------------------------------------------------------
(defun Cfg_PlanosTrabajo ( / NamePlAct PlAct-Saved)
(setq *PlsTrabajo* (vl-sort *PlsTrabajo* (function (lambda (a b)(< (car a)(car b))))))
(if (not (vl-some (function (lambda (x)(if (equal (car x) "*UNNAMED*") x))) *PlsTrabajo*))
(setq *PlsTrabajo* (cons (cons "*UNNAMED*" (cdr (GetActiveUCS))) *PlsTrabajo*))
)
(cond
((not *PlActivo*)(setq *PlActivo* (car *PlsTrabajo*)))
((= (car *PlActivo*) "*UNNAMED*")
(setq *PlActivo* (car *PlsTrabajo*))
)
((setq PlAct-Saved (vl-some (function (lambda (x)(if (equal (strcase (car x)) (strcase (car *PlActivo*))) x))) *PlsTrabajo*))
(setq *PlActivo* PlAct-Saved)
)
(T (setq *PlActivo* (car *PlsTrabajo*)))
)
)
;;----------------------- do_Save_pl_trabajo -----------------------
;;Guardar Plano de trabajo
;;------------------------------------------------------------------
(defun do_Save_pl_trabajo ( / do_OK s_n namepl LstTmp)
(defun do_OK ( / tmp)
(cond
((= namepl "")
(Alert "Nombre de plano de trabajo:\n!No VALIDO.!")
(mode_tile "input" 2)
)
((wcmatch namepl "*UNNAMED*")
(Alert "Nombre de plano de trabajo:\n!No VALIDO.!")
(mode_tile "input" 2)
)
((not (snvalid namepl))
(Alert (strcat "Caracteres no válidos en nombre de \nplano de trabajo '" namepl "'!"))
(mode_tile "input" 2)
)
((vl-some (function (lambda (x)(if (equal (strcase (car x)) (strcase namepl)) x))) *PlsTrabajo*)
(Alert (strcat "Ya existe un plano de trabajo \ncon nombre: '" namepl "'!"))
(mode_tile "input" 2)
)
(T (done_dialog 1))
)
);;c.defun
;;---------------- MAIN ------------------
(new_dialog "newnamepl" idxDlg "" )
(set_tile "input" "*UNNAMED*")
(action_tile "input" "(setq namepl (vl-string-trim \" \" $value))")
(action_tile "accept" "(do_OK)")
(setq s_n (start_dialog))
(cond
((= s_n 0) nil)
((= s_n 1)
(setq *PlActivo* (cons namepl (cdr *PlActivo*)))
(setq *PlsTrabajo* (cons *PlActivo* *PlsTrabajo*))
(Cfg_PlanosTrabajo)
(setq LstTmp (mapcar (function car) *PlsTrabajo*))
(jlgg-initlstDlg "*PlsTrabajo*" (mapcar (function car) *PlsTrabajo*))
(set_tile "*PlsTrabajo*" (itoa (vl-position (car *PlActivo*) LstTmp)))
(do_Trb_Botones (car *PlActivo*))
)
)
);c.defun
;;---------------------- Activate_pl_trabajo -----------------------
;;Activar plano de trabajo cuando se selecciona en la lista
;;------------------------------------------------------------------
(defun Activate_pl_trabajo (Idx / plTmp)
(setq *PlActivo* (nth Idx *PlsTrabajo*))
(setq pos_Dlg_Z2 (done_dialog 4))
;(do_Trb_Botones (car (nth (read $value) *PlsTrabajo*)))
)
;;---------------------- do_Del_pl_trabajo -------------------------
;;Borrar plano de trabajo seleccionado en la lista
;;------------------------------------------------------------------
(defun do_Del_pl_trabajo ( / Idx plTmp)
(setq Idx (read (get_tile "*PlsTrabajo*")))
(setq plTmp (nth Idx *PlsTrabajo*))
(setq *PlsTrabajo* (vl-remove plTmp *PlsTrabajo*))
(setq plTmp (cons "*UNNAMED*" (cdr plTmp)))
(setq *PlsTrabajo* (cons plTmp (cdr *PlsTrabajo*)))
(jlgg-initlstDlg "*PlsTrabajo*" (mapcar (function car) *PlsTrabajo*))
(set_tile "*PlsTrabajo*" "0")
(do_Trb_Botones "*UNNAMED*")
)
;;--------------------------- do_Trb_Botones --------------------------
;;Modificación de botones (act/des) dependiendo del tipo plano activo.
;;---------------------------------------------------------------------
(defun do_Trb_Botones (PlAct)
(cond
((= PlAct "*UNNAMED*")
(mapcar (function (lambda (key) (mode_tile key 1))) '( "OXY_Del"));desactivar
(mode_tile "OXY_Save" 0)
)
(t
(mapcar (function (lambda (key) (mode_tile key 0))) '( "OXY_Del"));Activar
(mode_tile "OXY_Save" 1)
)
)
)
;;____________________________________________________________
;; accion de chequeo de nombres para capas y estilos
(defun do_Chk_NameValid ( ll mens / r)
(setq r (vl-string-trim " " (get_tile ll)))
(if (snvalid r) ; si es valida
(progn
(set_tile "error" "")
(set (read ll) r)
(set_tile ll r)
)
(progn
(set_tile "error" (strcat mens "NO VALIDO."))
(mode_tile ll 2)(mode_tile ll 3)
)
);c.if
)
;;____________________________________________________________________
;;Seleccion de una de las capas del dibujo
;; "*LayerSimb*" "lis_lay" &TmpLayers&
(defun Do_SelLay (val / slay)
(cond
((> (setq val (read val)) 0)
(setq slay (nth val &TmpLayers&))
(set_tile "*LayerSimb*" slay)
(set_tile "lis_lay" "0")
(mode_tile "*LayerSimb*" 2)
;;(mode_tile "fltlay" 3)
)
)
);c.defun
;;____________________________________________________________________
;;Seleccion de un de los estilos de texto del dibujo
;; ;; "*TextStyleAtt*" "lis_stxt" &TmpStyles&
(defun Do_SelStyle (val / ssty)
(cond
((> (setq val (read val)) 0)
(setq ssty (nth val &TmpStyles&))
(set_tile "*TextStyleAtt*" ssty)
(set_tile "lis_stxt" "0")
(mode_tile "*TextStyleAtt*" 2)
;;(mode_tile "fltlay" 3)
)
)
);c.defun
;;------------------------ MAIN CotaNivel_DLG --------------------------------
;;recoge valores guardados en registro:
;;(("col_bl" "((62 . 256))") ("col_att" "((62 . 0))") ("bl_cot" "z2_7") ("multi_l" 1) ("esc_z2" "0.66"))
(mapcar (function (lambda (x) (set (read (car x)) (cadr x)))) (GetVal_Reg_Z2))
(setq esc_z2 (read esc_z2))
(setq col_bl (read col_bl))
(setq col_att (read col_att))
;;recoge valores guardados en diccionario DOC:
;;(("u_dec" . 2))
(mapcar (function (lambda (x) (set (read (car x)) (cdr x)))) (GetVal_DCT_Z2))
;;lista de capas del dibujo:
(setq &TmpLayers& (jlgg-aux_tabla "layer" 5)
&TmpLayers& (vl-sort &TmpLayers& '<)
&TmpLayers& (cons "Seleccionar capa" &TmpLayers&))
;;lista de estilos de texto del dibujo:
(setq &TmpStyles& (jlgg-aux_tabla "style" 5)
&TmpStyles& (vl-sort &TmpStyles& '<)
&TmpStyles& (cons "Seleccionar estilo" &TmpStyles&))
;;inicializa UCSs
(setvar "UCSICON" 3)
;;Carga cuadro de dialogo
(if (null pos_Dlg_Z2)(setq pos_Dlg_Z2 '(-1 -1)))
(setq FichDlg (WriteDialogZ2))
(setq idxDlg (load_dialog FichDlg))
(setq accion T)
(while accion
(if (not (new_dialog "Nivel_Z" idxDlg "" pos_Dlg_Z2)) (exit))
;;_____________________________________________
;;asignaciones de cuadro de dialogo
(jlgg-initlstDlg "lst_simb" $LstSimbsZ2$)
(set_tile "lst_simb" (itoa (vl-position bl_cot $LstSimbsZ2$)))
(img_z2) ;visualiza el tipo de cota
(set_tile "u_dec" (itoa u_dec))
(set_tile "esc_z2" (rtos esc_z2 2 u_dec))
(set_tile "multi_l" (itoa multi_l))
(set_tile "lbl#01" "Color símbolo:")
(set_tile "lbl#02" "Prec.:")
(set_tile "lbl#03" "Escala:")
(set_tile "lbl#04" "Guardados:")
(set_tile "lbl#05" "Color atributo:")
(im_col "col_bl" (cdr (assoc 62 col_bl)))
(im_col "col_att" (cdr (assoc 62 col_att)))
(set_tile "col_bl_t" (jlgg-NameCol col_bl))
(set_tile "col_att_t" (jlgg-NameCol col_att))
(set_tile "*LayerSimb*" *LayerSimb*)
(jlgg-initlstDlg "lis_lay" &TmpLayers&)
(set_tile "*TextStyleAtt*" *TextStyleAtt*)
(jlgg-initlstDlg "lis_stxt" &TmpStyles&)
;;.......................
(Cfg_PlanosTrabajo)
(setq LstTmp (mapcar (function car) *PlsTrabajo*))
(jlgg-initlstDlg "*PlsTrabajo*" LstTmp)
(set_tile "*PlsTrabajo*" (itoa (vl-position (car *PlActivo*) LstTmp)))
(do_Trb_Botones (car *PlActivo*))
(set_tile "*PlAtInic*" *PlAtInic*)
;;_____________________________________________
;;acciones de cuadro de dialogo
(action_tile "u_dec" "(do_dec $value)")
(action_tile "esc_z2" "(do_num $key \"Altura de Texto \" 6)")
(action_tile "img_z2" "(do_img_z2)")
(action_tile "lst_simb" "(do_lst_simb (read $value))")
(action_tile "col_bl" "(do_ddcol $key)")
(action_tile "col_att" "(do_ddcol $key)")
(action_tile "multi_l" "(setq multi_l (atoi $value))")
(action_tile "lis_lay" "(Do_SelLay $value)")
(action_tile "*LayerSimb*" "(do_Chk_NameValid $key \"Nombre de Capa \")")
(action_tile "lis_stxt" "(Do_SelStyle $value)")
(action_tile "*TextStyleAtt*" "(do_Chk_NameValid $key \"Nombre Estilo \")")
(action_tile "*PlsTrabajo*" "(Activate_pl_trabajo (read $value))")
(action_tile "OXY_New" "(setq pos_Dlg_Z2 (done_dialog 3))")
(action_tile "OXY_Save" "(do_Save_pl_trabajo)")
(action_tile "OXY_Del" "(do_Del_pl_trabajo)")
(action_tile "*PlAtInic*" "(setq *PlAtInic* $value)")
(action_tile "p_z2" "(setq pos_Dlg_Z2 (done_dialog 2))")
(action_tile "cancel" "(setq pos_Dlg_Z2 (done_dialog 0))")
(action_tile "accept" "(z2_ok)")
(setq accion (start_dialog)) ; activa el c. de dialogo
;;_____________________________________________
(cond
((= accion 2)
; Si punto de cota se ha señalado...
;;(command "_.UCS" "_R" "$temp$")
(setq dist_orig_Tmp (vl-catch-all-apply
(function getpoint)(list "\nPunto de base para Cota de inicio: ")))
(if (or (not dist_orig_Tmp)
(vl-catch-all-error-p dist_orig_Tmp))
;;(command "_.UCS" "_R" "$Z2$")
(princ)
)
)
;;Nuevo plano de trabajo:
((= accion 3)
(cond
((not (setq pOrg (aux:Getpoint nil nil "\nPunto de Origen: "))))
(T
(setq oUcs nil pX nil)
(initget 32)
(if (not (vl-catch-all-error-p
(setq pX (vl-catch-all-apply
(function getpoint)
(list pOrg "\nDirección X; : ")))))
(progn
(if (not (vl-catch-all-error-p
(setq dist_orig_Tmp (vl-catch-all-apply
(function getdist)
(list "\nNivel para el punto de origen;<0.00>: ")))))
(progn
(if (not dist_orig_Tmp)(setq dist_orig_Tmp 0.0))
(cond
(pX
(setq angTmp (- (angle pOrg pX) (/ pi 2.0))
pOrg (trans (polar pOrg angTmp dist_orig_Tmp) 1 0)
pX (trans (polar pX angTmp dist_orig_Tmp) 1 0))
(setq oUcs (Ucs2P nil pOrg pX t))
)
(T
(setq pX (polar pOrg 0 1.0)
pOrg (trans (polar pOrg (* pi 1.5) dist_orig_Tmp) 1 0)
pX (trans (polar pX (* pi 1.5) dist_orig_Tmp) 1 0))
(setq oUcs (Ucs2P nil pOrg pX t))
;;(setq pOrg (polar pOrg (* pi 1.5) dist_orig_Tmp))
;;(setq oUcs (UcsChgOrg (trans pOrg 1 0)))
)
);c.cond
(cond
(oUcs
(setq *PlActivo* (GetActiveUCS)
*PlActivo* (cons "*UNNAMED*" (cdr *PlActivo*))
*PlsTrabajo* (cons *PlActivo* (cdr *PlsTrabajo*)))
(prompt "\n>>Cambiando a plano de trabajo: *UNNAMED*")
(princ)
)
);c.cond
);c.prg
);c.if
);c.prg
);c.if
);T
);c.cond
)
;; Cambiando plano de trabajo:
((= accion 4)
(UscGetOrSet nil (cadr *PlActivo*) (caddr *PlActivo*) (cadddr *PlActivo*) T)
(prompt (strcat "\n>>Cambiando a plano de trabajo: " (car *PlActivo*)))
(princ)
)
((= accion 0);si cancel es señalado
(setq accion nil)
(unload_dialog idxDlg)
;(command "_.UCS" "_R" "$Z2$")
(setq retVal nil)
)
((= accion 1)
(setq accion nil)
(unload_dialog idxDlg)
;;(("col_bl" "((62 . 256))") ("col_att" "((62 . 0))") ("bl_cot" "z2_7") ("multi_l" 1) ("esc_z2" "0.66"))
(jlgg-Write-Registry-Command "CotasAlzado" "bl_cot" bl_cot)
(jlgg-Write-Registry-Command "CotasAlzado" "multi_l" multi_l)
(jlgg-Write-Registry-Command "CotasAlzado" "esc_z2" (rtos esc_z2 2 32))
(jlgg-Write-Registry-Command "CotasAlzado" "col_bl" (vl-prin1-to-string col_bl))
(jlgg-Write-Registry-Command "CotasAlzado" "col_att" (vl-prin1-to-string col_att))
;;guarda valores en diccionario DOC:
;;( ("u_dec" . 2))
(vlax-ldata-put "DICT_LaMarmita" "CotasAlzado"
(list
(cons "u_dec" u_dec )
(cons "*PlsTrabajo*" *PlsTrabajo*)
(cons "*PlActivo*" *PlActivo*)
(cons "*PlAtInic*" *PlAtInic*)
(cons "*LayerSimb*" *LayerSimb*)
(cons "*TextStyleAtt*" *TextStyleAtt*)
)
)
(setq retVal t)
)
);c.cond
);c.while
retVal
);c.defun CotaNivel_DLG
;;---------------------------- Z2error ----------------------------------
;; chequeo de *error*
;;-----------------------------------------------------------------------
(defun *error* (msg / funC)
(setq funC (if (>= (read (substr (getvar "ACADVER") 1 4)) 20) command-s vl-cmdf))
(while (/= (getvar "CMDNAMES") "") (funC))
(if (= 8 (logand 8 (getvar "UNDOCTL")))
(progn
(funC "_.undo" "_e")
(funC "_u")
)
)
(UscGetOrSet nil (cadr $UcsAutocad$) (caddr $UcsAutocad$) (cadddr $UcsAutocad$) T)
(if msg
(if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*,interrup*")))
(princ (strcat "\nZ2 Error: " msg))
)
)
(FinalizaUCS_Z2)
(jlgg-Res_Vars)
(princ)
);cierro defun Z2error
;;___________________________________________________________
;Funcion que añade el signo +-, +, - al texto de cota de altura en alzado
(defun SignoZ (p1 / signo)
(cond
((equal (cadr p1) 0.0 0.000001)(setq signo "%%p"))
((> (cadr p1) 0.0)(setq signo "+"))
(t (setq signo ""))
);c.cond
signo
);c.defun
;;---------------------------- UpdatePropsAtt -------------------------------------
;; Actualiza propiedades de un atributo Atributos del bloque de cota de Nivel
;;---------------------------------------------------------------------------------
(defun UpdatePropsAtt (oAtt UpdtMiltiLine / Inspt)
(jlgg-Ch_Col oAtt col_att)
(jlgg-Chg_Cap oAtt *LayerSimb*)
(vla-put-StyleName oAtt *TextStyleAtt*)
(cond
((= UpdtMiltiLine 0)
(vla-put-ScaleFactor oAtt (cdr (assoc 41 (tblsearch "STYLE" (getvar "TEXTSTYLE")))))
(vla-put-MTextAttribute oAtt :vlax-false)
;;(vla-update oAtt)
)
((and (= UpdtMiltiLine 1)(= (vla-get-MTextAttribute oAtt) :vlax-false))
(setq Inspt (vla-get-InsertionPoint oAtt))
(vla-put-MTextAttribute oAtt :vlax-true)
(vla-put-Alignment oAtt 12) ;;acAlignmentBottomLeft = 12
(vla-put-TextAlignmentPoint oAtt Inspt)
)
);c.cond
);c.defun
;;---------------------------- Actualiza_z2 ---------------------------------------
;; Actualiza Atributos del bloque de cota de Nivel
;;---------------------------------------------------------------------------------
(defun Actualiza_z2 ( / ssZ ssl )
(cond
((setq ssZ (ssget (list '(0 . "INSERT");|'(2 . "z2_*")|;'(66 . 1))))
(setq ssl (jlgg-SSToList ssZ))
(mapcar (function (lambda (x / Atts P1 TxtNew oBlk Escala)
(cond
((wcmatch (strcase (jlgg-GetBlockName x)) "Z2_#*")
(setq P1 (trans (jlgg-dxf 10 (entget x)) 0 1)
TxtNew (strcat (SignoZ P1) (rtos (* esc_dibu (cadr P1)) 2 u_dec))
Atts (ATT:GETS x))
(setq Escala (/ esc_z2 (abs (jlgg-dxf 41 (entget x)))))
(setq oBlk (jlgg-GetVLA-Obj x))
(vla-ScaleEntity oBlk (vla-get-InsertionPoint oBlk) Escala)
(jlgg-Ch_Col oBlk col_bl)
(mapcar
(function
(lambda (datAtt / Att txt oAtt)
(setq oAtt (last datAtt))
(UpdatePropsAtt oAtt nil)
(cond
((= (car datAtt) "Z")
(vla-put-TextString oAtt TxtNew)
)
);c.cond
)
)
Atts
);c.mapcar
(vla-update oBlk)
);;"Z2_#*"
);c.cond
)) ssl);c.mapcar
)
(T (prompt "\nNo se seleccionarón Simbolos de Cota de Nivel para actualizar"))
);c.cond
);c.defun
;;--------------------------- ATT:GETS --------------------------------------------
;; Obtiene los atributos de un bloque
;;---------------------------------------------------------------------------------
;;----------------------- get-atts ----------------------
;; obtener los atributos de un bloque...
;;-------------------------------------------------------
(defun ATT:GETS (blk / lst)
(setq blk (jlgg-GetVLA-Obj blk))
(if (and (= (vla-get-hasAttributes blk) :vlax-true)
(not (vl-catch-all-error-p
(setq lst (vl-catch-all-apply
'vlax-safeArray->list
(list (vlax-variant-value (vla-getAttributes blk))))))))
(setq lst (mapcar (function (lambda (Att)
(list (vla-get-tagstring Att)(vla-get-textstring Att) Att)
)) lst))
nil
);c.if
);c.defun
;;;;;Función antigua..que recuerdos..
;;;(defun ATT:GETS (EN / EL RES)
;;; (if (setq EN (entnext EN))
;;; (progn
;;; (setq EL (entget EN))
;;; (while (= "ATTRIB" (cdr (assoc 0 EL)))
;;; (setq RES (cons
;;; (list EN
;;; (cdr (assoc 2 EL))
;;; (cdr (assoc 1 EL))) RES)
;;; EN (entnext EN)
;;; EL (entget EN))
;;; );c.while
;;; );c.prg
;;; );c.if
;;; (reverse RES)
;;;);c.defun
;;--------------------------------------------------------------
;;Crea o modifica el estilo de texto *TextStyleAtt*
;;--------------------------------------------------------------
(defun StyTxtAPPS ( / txt_s LstTxt_Sty)
;;estilo de texto
(cond
((tblsearch "STYLE" *TextStyleAtt*)
(setq txt_s (tblobjname "STYLE" *TextStyleAtt*))
)
(t
(setq txt_s (jlgg-SetStyTxt
*TextStyleAtt*
(if (= (strcase *TextStyleAtt*) "ARIAL") "ARIAL.TTF" "romans.shx")
0.0 1.0 nil))
)
);c.cond
txt_s
);c.defun
;;-----------------------------------------------------------------------
(defun FinalizaUCS_Z2 (/ funC)
(if (tblsearch "UCS" "_UCSTemp")
(command-s "_.UCS" "_D" "_UCSTemp")
)
);;c.defun
;;----------------------------- MAIN Z2 ----------------------------------------
;;Variables Globales:
(setq $NameFileDat$ "Simbolos_dbx.dwg") ;;Nombre de la base de datos
(setq $SubPath$ "Simbolos\\")
(cond
(*Auxiliares_jlgg*)
((not (findfile "jlgg_Auxiliares.lsp"))
(alert
(strcat "No se encontro el archivo de soporte: [ jlgg_Auxiliares.lsp ]"
"\nCompruebe las rutas de soporte de los Archivos."))
(exit)
)
(T (load "jlgg_Auxiliares.lsp"))
)
(jlgg-Init_Vars (list '("DIMZIN" 0)
;(list "osmode" (osmodeOFF))
'("attdia" 0)
'("attreq" 1)
'("cmdecho" 0)
'("snapmode" 0)
'("ucsfollow" 0)
'("osnapcoord" 1)
'("UCSICON" 3) ;;ucsicon visible
)
)
;;No ponemos Findfile aqui, pues ya lo comprueba en OpenDrawingDBX
(setq $PathFileDat$ (strcat $SubPath$ $NameFileDat$)) ;;Jose
(setq $LstSimbsZ2$ (GetSimbsZ2InDWGDat))
(cond
((= (car $LstSimbsZ2$) "%ERROR%"))
((not $LstSimbsZ2$)
(alert
(strcat "El Archivo de Datos: \n[ " $PathFileDat$ " ]"
"\n\n No contiene bloques de simbolos de Cotas de Nivel."
"\nCompruebe el archivo."))
)
(T
;;_____________________________________________________________
;; Inicializa UCSs
(setq $UcsAutocad$ (GetActiveUCS))
;;_____________________________________________________________
;;recoge valores guardados en registro:
;;(("col_bl" "((62 . 256))") ("col_att" "((62 . 0))") ("bl_cot" "z2_7") ("multi_l" 1) ("esc_z2" "0.66"))
(mapcar (function (lambda (x) (set (read (car x)) (cadr x)))) (GetVal_Reg_Z2))
(setq esc_z2 (read esc_z2))
(setq col_bl (read col_bl))
(setq col_att (read col_att))
;;recoge valores guardados en diccionario DOC:
;;( ("u_dec" . 2))
(mapcar (function (lambda (x) (set (read (car x)) (cdr x)))) (GetVal_DCT_Z2))
(StyTxtAPPS)
;;Ptrabajo:
(cond
((= *PlAtInic* "1")
;;(if (and *PlActivo* (/= (car *PlActivo*) "*UNNAMED*"))
(if *PlActivo*
(UscGetOrSet nil (cadr *PlActivo*) (caddr *PlActivo*) (cadddr *PlActivo*) T)
)
)
((= *PlAtInic* "0")
(setq *PlActivo* $UcsAutocad$
*PlActivo* (cons "*UNNAMED*" (cdr *PlActivo*)))
(SetVal_DCT_Z2 "*PlActivo*" *PlActivo*)
)
)
;;Otros valores
(setq esc_dibu (getvar "DIMLFAC"))
;;_____________________________________________________________
(setq p1 T)
(while p1
(if (not (vl-position bl_cot $LstSimbsZ2$))
(setq bl_cot (car $LstSimbsZ2$))
)
(cond
((not (tblsearch "BLOCK" bl_cot))
(SimbToActiveDoc bl_cot)
;(eval (read (strcat "(MakeBlk_" bl_cot ")")))
)
);c.cond
(initget "Actualizar Opciones")
(setq p1 (getpoint "\nIndique punto de cota de Nivel o [Actualizar/Opciones]: "))
(cond
;;Se indica punto y se inserta bloque:
((= (type p1) 'LIST)
(setq LastEnt (entlast))
(command-s "_.insert" bl_cot "_S" esc_z2 p1 ""
(strcat (SignoZ p1) (rtos (* esc_dibu (cadr p1)) 2 u_dec))
);c command
;;se inserto bien:
(cond
((not (eq LastEnt (entlast)))
(command "_UNDO" "_BE")
(setq Z2Ins (entlast))
(jlgg-Chg_Cap Z2Ins *LayerSimb*)
(jlgg-Ch_Col Z2Ins col_bl)
(setq atribs (ATT:GETS Z2Ins))
;;Cambio de propiedades
(mapcar
(function
(lambda (x / oAtt)
(setq oAtt (last x))
(UpdatePropsAtt oAtt multi_l)
)
)
atribs
);c.mapcar
(command "_UNDO" "_E")
)
);c.cond
)
;;Se llama al cuadro para opciones:
((= p1 "Opciones")
(setq $UcsTempWithDCL$ (GetActiveUCS))
(cond
((not (setq a (CotaNivel_DLG)))
(UscGetOrSet nil (cadr $UcsTempWithDCL$) (caddr $UcsTempWithDCL$) (cadddr $UcsTempWithDCL$) T)
(princ)
)
(T
;;se recogen valores guardados en registro:
;;(("col_bl" "((62 . 256))") ("col_att" "((62 . 0))") ("bl_cot" "z2_7") ("multi_l" 1) ("esc_z2" "0.66"))
(mapcar (function (lambda (x) (set (read (car x)) (cadr x)))) (GetVal_Reg_Z2))
(setq esc_z2 (read esc_z2))
(setq col_bl (read col_bl))
(setq col_att (read col_att))
;;recoge valores guardados en diccionario DOC:
;;( ("u_dec" . 2))
(mapcar (function (lambda (x) (set (read (car x)) (cdr x)))) (GetVal_DCT_Z2))
(StyTxtAPPS)
)
)
)
;;Se Indica actualizar cotas
((= p1 "Actualizar")
(Actualiza_z2)
)
);c.cond
);c.while
)
);c.cond
(*error* nil)
(princ)
);cierro defun principal
(princ)
Como siempre, espero sea de utilidad.
Un saludo a tod@s desde España.
No hay comentarios:
Publicar un comentario