El programa necesitará que estén cargadas las funciones Auxiliares comunes para los programas publicados en VisualLisp en La Marmita.
Archivos y descarga
El programa consta de dos Archivos:- InsertEscalasGRP.lsp: Funciones y comando del programa.
- EscalasGRP_dbx.dwg: Archivo que contiene los bloques de escalas gráficas.
Comandos en AutoCAD
Para Ejecutar la aplicación utilice InsEscGRP en la línea de comandos para ejecutar la aplicación en AutoCAD.
Caracteristicas
El programa usa el Objeto "ObjectDBX.AxDbDocument", primero, para obtener el listado de bloques de escalas gráficas contenidas en el archivo EscalasGRP_dbx.dwg y suministrar el listado al cuadro de dialogo del programa para la selección por el usuario. Y segundo, para una vez seleccionada la escala en el cuadro de dialogo, extraer el bloque del mismo archivo he incorporarlo a la base de datos de bloques del documento activo e insertarlo posteriormente.Llamada a la interfaz de ObjectDBX:
(setq ObjDbx (vlax-create-object
(if (< (setq release (atoi (getvar "ACADVER"))) 16)
"ObjectDBX.AxDbDocument"
(strcat "ObjectDBX.AxDbDocument." (itoa release))
)
)
)Configuración
Puede cambiarse la configuración del programa editando el mismo al principio de la sección MAIN:
;;--------------------------------- MAIN --------------------------------------
;;Variables Globales:
(setq $NameFileDat$ "EscalasGRP_dbx.dwg") ;;Nombre de la base de datos
(setq $LayerEscales$ "registro") ;;Nombre de capa para las escalas
(setq $SubPath$ "Simbolos\\")- $NameFileDat$: asigna el nombre del archivo que contiene los bloques de escalas.
- $LayerEscales$: asigna la capa donde se insertaran los bloques de escalas gráficas en AutoCAD.
- $SubPath$: asigna el sub-directorio donde buscar el archivo de bloques (EscalasGRP_dbx.dwg).
(setq $SubPath$ "")(setq $SubPath$ "MiRuta1\\MiRuta2\\..\\")Personalización
El Archivo de bloques de escalas es un archivo de Autocad (dwg) que contiene los bloques de escalas gráficas, este se puede abrir con Autocad y editarse para añadir mas escalas o modificar las existentes (bajo la responsabilidad del usuario), yo recomiendo hacer una copia de seguridad del archivo antes de modificarlo.
 |
| Vista previa del archivo de escalas |
El programa listará solos los bloques cuyo nombre sea: "ESC_GRF_EP_1-XXXX", donde "XXXX" es la escala (ejemplo: 300, 1250, 450, etc). Tener esto en cuenta a la hora de añadir un nuevo bloque de escala o modificar los existente.
Nota: Mientras el archivo de escalas este abierto, el programa no funcionará, devolverá un error:
Código del programa
Select all
Un saludo a tod@s desde España.
;;*************************** C:InsEscGRP **********************************************
;;
;;Revisiones:
;; Versión LaMarmita
;; José Luis García Galán 19/03/14
;; Versión 1.2.0
;; José Luis García Galán 26/08/14
;; Versión 1.0.0
;; José Luis García Galán 27/09/10
;;Rutina para insertar Escalas Graficas en Espacio Papel
;;**************************************************************************************
(defun C:InsEscGRP ( / $PathFileDat$ $LayerEscales$ $NameFileDat$ $SubPath$
DatoEsc NameBlEscala esc_Blk oLast oBlk ac:err
;|Funciones|; InsertEscalasGrp_DLG EscalaBlkToActiveDoc GetEscalasInDWGDat
)
;;;============================================= InsertEscalasGrp_DLG ============================================
;;; Función del Cuadro de dialogo de Insertar escala gráfica en Espacio papel
;;;===============================================================================================================
(defun InsertEscalasGrp_DLG ( / FichDlg idxDlg LstDatEsc lstEscDlg LstNames SelectEsc AccionDlg RetVal
;|Funciones|; DoPickList WriteDialogInsertEscalas
)
;;_______________________________________________________
;; Accion de clickar en la lista
(defun DoPickList (value reason / val)
(setq SelectEsc (nth (read value) LstNames))
(cond
((= reason 4) ;Intro o doble click en tipo
(setq p_dia_InsEscalasPS (done_dialog 1))
)
((= reason 1)) ;;pick only
)
);c.defun
;;------------------------------ WriteDialogInsertEscalas ----------------------------------------------
;; Definir archivo de cuadro de dialogo
;;--------------------------------------------------------------------------------------------------------
(DEFUN WriteDialogInsertEscalas ( / dir FichDlg openFile)
(setq dir (getvar "TEMPPREFIX"))
(setq FichDlg (strcat dir "$InsertEscalas$.dcl"))
(cond
(T ;;Forzar reescribir el cuadro (programando)
;;((null (findfile FichDlg))
(setq openFile (open FichDlg "w"))
(write-line "//---------------------------------------------------------------------------" openFile)
(write-line "//Cuadro de dialogo para seleccionar Escalas de espacio Papel " openFile)
(write-line "//---------------------------------------------------------------------------" openFile)
(write-line "InsertEscalas : dialog {" openFile)
(write-line " label = \"Inserción de Escalas Gráficas\";" openFile)
(write-line " : boxed_column {" openFile)
(write-line " label = \"Lista de Escalas Gráficas: \";" openFile)
(write-line " : list_box {" openFile)
(write-line " label = \"Escala Bloque\";" openFile)
(write-line " height = 20;" openFile)
(write-line " width = 40; //32" openFile)
(write-line " fixed_height = true;" openFile)
(write-line " key = \"l_escalas\";" openFile)
(write-line " multiple_select = false;" openFile)
(write-line " tabs = \"16\";" openFile)
(write-line " }" openFile)
(write-line " }//c.boxed_column" openFile)
(write-line " ok_cancel;" openFile)
(write-line "}//c.DCL" openFile)
(write-line "" openFile)
(close openFile)
)
);c.cond
FichDlg
);c.defun
;;-------------------------------- MAIN ------------------------------------------
;;Abre el cuadro de dialogo de opcines
(if (null p_dia_InsEscalasPS) (setq p_dia_InsEscalasPS '(-1 -1)))
(setq FichDlg (WriteDialogInsertEscalas))
(setq idxDlg (load_dialog FichDlg))
;;________________________________________________________________________________
;;Obtención del listado de escalas
(if (not (setq LstDatEsc (GetEscalasInDWGDat)))(exit))
(mapcar (function (lambda (LstEscala / NameBlk strEscala)
(setq strEscala (car LstEscala)
NameBlk (cadr LstEscala))
(setq lstEscDlg (cons (strcat strEscala "\t" NameBlk) lstEscDlg))
(setq LstNames (cons strEscala LstNames))
)) LstDatEsc);c.mapcar
(setq lstEscDlg (reverse lstEscDlg)
LstNames (reverse LstNames))
;; Escala Seleccionada
(cond
((not
(and (setq SelectEsc (jlgg-Read-Registry-Command "InsertEscalasPS" "Select"))
(vl-position SelectEsc LstNames))
)
(setq SelectEsc (car LstNames))
(jlgg-Write-Registry-Command "InsertEscalasPS" "Select" SelectEsc)
)
);c.cond
;;cuadro de dialogo en pantalla
(if (not (new_dialog "InsertEscalas" idxDlg "" p_dia_InsEscalasPS)) (exit))
;;=================================
;;asignaciones de cuadro de dialogo
;;=================================
(jlgg-initlstDlg "l_escalas" lstEscDlg)
(set_tile "l_escalas" (itoa (vl-position SelectEsc LstNames)))
;;=================================
;;Acciones de cuadro de dialogo
;;=================================
(ACTION_TILE "l_escalas" "(DoPickList $value $reason)")
(ACTION_TILE "accept" "(setq p_dia_InsEscalasPS (done_dialog 1))")
(action_tile "cancel" "(setq p_dia_InsEscalasPS (done_dialog 0))")
(setq AccionDlg (start_dialog))
(cond
((= AccionDlg 0)
(unload_dialog idxDlg)
)
((= AccionDlg 1)
(unload_dialog idxDlg)
(jlgg-Write-Registry-Command "InsertEscalasPS" "Select" SelectEsc)
(setq RetVal (assoc SelectEsc LstDatEsc))
)
);c.cond
RetVal
);c.defun
;;----------------------------- GetEscalasInDWGDat --------------------------------------
;;
;; (GetEscalasInDWG "T:\\ACAD2005\\AppsAc2005\\Registro\\Final\\ESCALAS.dwg")
;;---------------------------------------------------------------------------------------
(defun GetEscalasInDWGDat ( / ObjDbx ObjBlocks Each ListResult BlkName Description strEscala n)
(cond
((not (setq ObjDbx (OpenDrawingDBX $PathFileDat$)))
(setq ListResult nil)
)
(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)))))
(vl-string-search "ESC_GRF_EP_" BlkName)
(setq n (vl-string-search "1-" BlkName))
(setq strEscala (strcat "1:" (substr BlkName (+ n 3))))
;;(not (vl-catch-all-error-p
;; (setq BlkDescription (vl-catch-all-apply (function vla-get-Comments) (list Each)))))
;;(vl-string-search "Bloque de escala en Espacio Papel" BlkDescription)
;;(setq n (vl-string-search "1:" BlkDescription))
;;(setq strEscala (substr BlkDescription (1+ n)))
);c.and
;; (print "Bloque: ") (princ BlkName)
;; (print "Descripción: ")(princ BlkDescription)
;; (print "Escala: ") (princ strEscala)
(setq ListResult (cons (list strEscala ;|BlkDescription|; BlkName) ListResult))
)
)
);c.vlax-for
(jlgg-release-object (list ObjDbx ObjBlocks))
;- - - - - - - - - - - - - - - - - - - - - - - - - - -
)
);c.cond
(setq ListResult (vl-sort ListResult (function (lambda (e1 e2) (< (car e1) (car e2))))))
);c.defun
;;------------------------------- EscalaBlkToActiveDoc ----------------------------------------
;; Carga el bloque de Escala al dibujo actual
;; Dato = ("1:2000" "Bloque de escala en Espacio Papel 1:2000" "ESC_GRF_EP_1-2000")
;;---------------------------------------------------------------------------------------------
(defun EscalaBlkToActiveDoc (DatoEscala / 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 (jlgg-ActDoc))
(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 strNameEsc (cadr DatoEscala)) ;;Nombre del bloque
(setq Obj (vla-item DBXBlocks strNameEsc))
(setq RetVal (MakeCopyObj Obj))
)
);c.cond
;- - - - - - - - - - - - - - - - - - - - - - - - - - -
(jlgg-release-object (list ActiveDoc ActdBlksCol ObjDbx DBXBlocks))
RetVal
);c.defun
;;--------------------------------- MAIN --------------------------------------
;;Variables Globales:
(setq $NameFileDat$ "EscalasGRP_dbx.dwg") ;;Nombre de la base de datos
(setq $LayerEscales$ "registro") ;;Nombre de capa para las escalas
(setq $SubPath$ "Simbolos\\")
(vl-doc-set '*NameAppRun* "InsEscGRP")
(setq ac:err *error* *error* LMT:error)
;;Variables Autocad:
(jlgg-Init_Vars (list ;(list "osmode" (osmodeOFF))
'("attdia" 0)
'("attreq" 1)
'("cmdecho" 0)
'("snapmode" 0)))
;;No ponemos Findfile aqui, pues ya lo comprueba en OpenDrawingDBX
(setq $PathFileDat$ (strcat $SubPath$ $NameFileDat$))
(cond
((and (setq DatoEsc (InsertEscalasGrp_DLG))
(EscalaBlkToActiveDoc DatoEsc))
(setq NameBlEscala (cadr DatoEsc)
esc_Blk 1.0)
;;Inserción del bloque de escala
(command "_.UNDO" "_BE")
(setq oLast (entlast))
(prompt "Punto de inserción: ")
;(command "_insert" NameBlEscala "_scale" esc_Blk pause pause)
(vl-cmdf "_insert" NameBlEscala "_scale" esc_Blk pause 0.0)
(setq oBlk (entlast))
;;Comprobación de inserción del bloque y cambio de capa:
(if (not (eq oLast oBlk)) ;;OK
(jlgg-Chg_Cap oBlk $LayerEscales$)
)
(command "_.UNDO" "_E")
)
);c.cond
(jlgg-res_vars) ;restablece variables
(setq *error* ac:err ac:err nil)
(PRINC)
);c.defun Principal
(princ)
Un saludo a tod@s desde España.
ESTO ESTA REALMENTE EXELENTE...GRACIAS POR EL APORTE.... Y QUE BUENO SERIA SI TUBIERAN UN VIDEO TUTORIAL DE InsertEscalasGRP.lsp
ResponderEliminarVIDEP TUTORIAL , SE VE MUY PRACTICO PERO ES ALGO COMPLEJO PARA MI, SOY NUEVO EN EL AUTOCAD.
ResponderEliminar