Si en la entrega anterior publicaba la utilidad de símbolos de cotas de nivel para alzados y secciones, le toca ahora al símbolo para las cotas de nivel en planta.
Esta utilidad, no tiene mucho de complicado, es básicamente para tener a mano siempre el símbolo de cota, pero es interesante a nivel de programación para ver cómo se crean las definiciones de bloque y las inserciones de bloque con distinto número de atributos, exclusivamente por código y sin usar (command).
En este caso concreto utilizaremos "entmake" para crear tanto la definición de bloque ("BLOCK", "AcDbBlockTableRecord") como la inserción del bloque ("INSERT", "AcDbBlockReference"), esta última con la peculiaridad de crear cada INSERT o con un solo atributo multi-línea o con múltiples atributos simples, esto es que podemos insertar el mismo bloque y que cada inserción puede tener un numero distinto de atributos.
Compativilidad
Probado en AutoCAD v.2015-2016 (x64) y BricsCAD v.15 (x64)
Nota: Si lo probáis en otras versiones y/o plataformas os agradecería que me informaseis de los resultados para poder contrastar y solucionar posibles problemas.
Funcionamiento
- Indicar punto(s) en pantalla para insertar símbolos de cota de nivel (esta es la opción por defecto).
- Indicar Opciones para modificar las preferencias del programa.
Opciones
|
Tip: Una forma rápida de editar atributos de bloque es pulsar con el ratón doble clic sobre el atributo que queremos editar mientras mantenemos pulsada la tecla CTRL, esto evitará pasar por el editor de atributos. Muy útil sobre todo con los atributos multi-línea. (Ver ejemplo 4)
Codigo y descarga.
Código
Select all
;;********************************* C:Nivel_P ******************************************;;
;;Revisiones: ;;
;; Versión 2.0.0 (LaMarmita) ;;
;; José Luis García Galán 06/12/15 ;;
;; Versión 1.0.0 ;;
;; José Luis García Galán 11/11/08 ;;
;; ;;
;;PROGRAMA DE INSERCION DE COTA DE ALTURAS PARA SECCIONES ;;
;;**************************************************************************************;;
(defun C:Niveles_P (/ ;|registro|; TIPOATT NOATT ESCHTXT EDITINS
;|locales|; ac:err p1 NewInsBlk isMText
;|funciones|; ins_Nivel_Pl Make_Nivel_Pl GetVal_Reg_Nivel_P Nivel_P_DLG
)
;;--------------------------------- GetVal_Reg_Nivel_P ---------------------------------------
;;Datos de usuario para el programa Nivel_P obtenidos y guardados en el registro de Windows
;; (mapcar (function (lambda (x) (set (read (car x)) (cadr x)))) (GetVal_Reg_Nivel_P))
;;--------------------------------------------------------------------------------------------
(defun GetVal_Reg_Nivel_P ( / LisVal RetVal lis_fle)
(setq LisVal (list ;;'("MinHoja" "0.35" t) ;;Force Write
'("TipoAtt" "Att_ML")
'("NoAtt" 1)
'("EscHTxt" "1.0000")
'("EditIns" "0")
))
;;(("TipoAtt" "Att_ML") ("NoAtt" 1) ("EscHTxt" "1.0000") ("EditIns" "0"))
(setq RetVal (jlgg-GetVal_Reg_Command LisVal "Niveles_P"))
);c.defun
;;-------------------------------------------------------------------------------------------
;; Cuadro de dialogo de opciones para cotas de altura en planta
;;-------------------------------------------------------------------------------------------
(defun Nivel_P_DLG (/ ;|Registro|; TIPOATT NOATT ESCHTXT EDITINS
;|Locales|; FichDlg idxDlg accion
;|Funciones|; WriteDialogNivel_P Nivel_P_Ok Do_Chg_Tipo do_testnum)
;;---------------------------------- WriteDialogNivel_P -----------------------------------
;; Definir archivo de cuadro de dialogo
;;-----------------------------------------------------------------------------------------
(DEFUN WriteDialogNivel_P ( / dir FichDlg openFile)
(setq dir (getvar "TEMPPREFIX"))
(setq FichDlg (strcat dir "$Nivel_P$.dcl"))
(cond
;;(T ;;Forzar reescribir el cuadro (programando)
((null (findfile FichDlg))
(setq openFile (open FichDlg "w"))
(write-line "// ---------------------------------------------------------------" openFile)
(write-line "// CUADRO DE DIALOGO DE COTAS PARA PLANTAS " openFile)
(write-line "// ---------------------------------------------------------------" openFile)
(write-line "Nivel_P : dialog {" openFile)
(write-line " fixed_width = true;" openFile)
(write-line " fixed_height = true;" openFile)
(write-line " label = \"Simbolo de cota en planta\";" openFile)
(write-line " : boxed_row {" openFile)
(write-line " fixed_height = false;" openFile)
(write-line " fixed_width=true;" openFile)
(write-line " label = \"Tipo de atributo\";" openFile)
(write-line " : column {" openFile)
(write-line "\t fixed_height = true;" openFile)
(write-line "\t fixed_width=true;" openFile)
(write-line " : image {" openFile)
(write-line "\t key = \"img_cota\";" openFile)
(write-line " width = 15;" openFile)
(write-line " fixed_width=true;" openFile)
(write-line " fixed_height = true;" openFile)
(write-line "\t //color = graphics_foreground;" openFile)
(write-line "\t color = dialog_background;" openFile)
(write-line "\t aspect_ratio = 0.5;" openFile)
(write-line "\t }" openFile)
(write-line "\t : spacer {height = 1;}" openFile)
(write-line "\t}" openFile)
(write-line "\t: spacer {width=1;}" openFile)
(write-line "\t: radio_column {" openFile)
(write-line "\t fixed_height = true;" openFile)
(write-line "\t fixed_width=true;" openFile)
(write-line "\t key = \"tipo_att\";" openFile)
(write-line "\t : radio_button {label = \"Texto MultiLínea\"; key = \"Att_ML\";}" openFile)
(write-line "\t : radio_button {label = \"Atributos simples:\"; key = \"Att_M\";}" openFile)
(write-line "\t : row { fixed_width=true;" openFile)
(write-line "\t : spacer {width=2;}" openFile)
(write-line "\t : text_part {label = \"Nº:\"; key=\"Nro\";}" openFile)
(write-line "\t : slider {" openFile)
(write-line " //layout = vertical;" openFile)
(write-line " min_value=1;" openFile)
(write-line " max_value=10;" openFile)
(write-line " small_increment=1;" openFile)
(write-line " width=15;" openFile)
(write-line " fixed_width=true;" openFile)
(write-line " alignment = bottom;" openFile)
(write-line " key=\"n_att\";" openFile)
(write-line " }" openFile)
(write-line " : text {width=3; key=\"natt_txt\";}" openFile)
(write-line "\t }" openFile)
(write-line " }//c.radio_column" openFile)
(write-line " }//c.boxed_column" openFile)
(write-line " : column {" openFile)
(write-line " fixed_width = true;" openFile)
(write-line " fixed_height = true;" openFile)
(write-line " : edit_box {" openFile)
(write-line " fixed_width = true;" openFile)
(write-line " label = \"&Altura Texto:\";" openFile)
(write-line " key = \"EscHtxt\";" openFile)
(write-line " edit_width = 10;" openFile)
(write-line " value = \"1.0\";" openFile)
(write-line " }" openFile)
(write-line " : toggle {label = \"&Editar al Insertar\"; key = \"edit\";}" openFile)
(write-line " }" openFile)
(write-line " spacer_1;" openFile)
(write-line " ok_cancel_err;" openFile)
(write-line "}" openFile)
(close openFile)
)
);c.cond
FichDlg
);c.defun
;;_______________________________________________________________________________
(defun Nivel_P_Ok()
(cond
((not (do_testnum "EscHtxt" "Altura de Texto " 6)))
(t (setq p_dia_Nivel_P (done_dialog 1)))
);c.cond
);c.defun
;;________________________________________________________________________________
;; accion de chequeo de numeros
(defun do_testnum ( ll mens cod / r)
(if (setq r (jlgg-test_numr (set (read ll) (get_tile ll)) mens cod)) ; si es valida
(progn
(set_tile "error" "")
(set_tile ll (jlgg-rtos r nil 4))
(set (read ll) r)
);c.prg
(progn
(mode_tile ll 2)(mode_tile ll 3)
nil
);c.prg
);c.if
);c.defun
;;____________________________________________________________________________
;;Cambio de imagen de tipo de atributo
(defun Do_Chg_Tipo (/ long alto modeT)
(setq modeT (cond
((= TipoAtt "Att_ML") 1)
((= TipoAtt "Att_M" ) 0)
)
)
(mapcar (function (lambda (key) (mode_tile key modeT)))(list "Nro" "natt_txt" "n_att"))
(start_image "img_cota")
(setq long (dimx_tile "img_cota")
alto (dimy_tile "img_cota")
)
(fill_image 0 0 long alto -2)
(if (boundp (read (strcat "vectors_" TipoAtt )))
(eval (read (strcat "(vectors_" TipoAtt ")")))
);c.if
(end_image)
);c.defun
;;______________________________________________________________________________________
;;Vectores de imagen creados con el programa GetVectors (directorio DCL de programación)
;;Rectangulo 90x45 (ver dibujo "Dibujo 25-11-07.dwg" en el mismo directorio)
;;Imagen del simbolo Att_M
(defun vectors_Att_M ()
(mapcar 'vector_image; Color 251
(list 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24)
(list 32 32 32 32 32 32 32 24 24 25 25 26 26 28 30)
(list 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24)
(list 34 36 37 38 38 39 39 32 32 32 32 32 32 32 32)
(list 251 251 251 251 251 251 251 251 251 251 251 251 251 251 251)
);mapcar
(mapcar 'vector_image; Color 7
(list 66 67 67 68 69 71 71 72 71 71 70 69 69 67 52 52 53 54 55 56 56 56 55 54 53 52 52 52 49 48 48 49 49 48 45 45 44 44 44 38 41 40 39 39 32 34 31 66 66 70 71 71 71 71 70 68 68 67 67 67 52 52 53 54 55 56 56 56 55 54 53 52 52 52 49 48 48 49 49 48 45 45 44 44 44 38 41 40 39 39 32 34 31 69 68 68 52 52 53 54 55 56 56 56 55 54 53 52 52 52 49 48 48 49 49 48 45 45 44 44 44 38 41 40 39 39 32 34 31 6 17 24 23 22 21 19 17 15 13 12 11 10 10 10 10 11 12 13 15 17 19 21 22 23 24)
(list 10 11 11 11 11 10 10 8 7 7 6 6 6 3 10 11 11 11 11 9 8 7 6 6 6 6 6 3 6 4 4 3 4 4 6 6 7 7 6 6 11 11 10 3 9 3 11 23 23 19 17 16 16 15 15 15 15 16 16 16 22 23 23 23 23 21 20 19 18 18 18 18 18 15 18 15 15 15 15 15 18 18 19 19 18 18 23 23 21 15 20 15 23 26 28 28 33 34 34 34 34 32 31 30 29 29 29 29 29 26 29 27 27 26 27 27 29 29 30 30 29 29 34 34 33 26 32 26 34 32 21 30 28 26 25 25 24 25 25 26 28 30 30 32 33 35 37 38 39 39 39 38 37 35 32)
(list 67 67 68 69 71 71 72 72 72 71 71 70 71 71 52 53 54 55 56 56 56 56 56 55 54 53 52 52 49 48 49 49 49 49 47 45 45 44 44 41 41 41 40 39 36 37 34 72 70 71 71 71 71 71 71 70 68 68 67 67 52 53 54 55 56 56 56 56 56 55 54 53 52 52 49 48 49 49 49 49 47 45 45 44 44 41 41 41 40 39 36 37 34 69 69 68 52 53 54 55 56 56 56 56 56 55 54 53 52 52 49 48 49 49 49 49 47 45 45 44 44 41 41 41 40 39 36 37 34 28 17 24 24 23 22 21 19 17 15 13 12 11 10 10 11 12 13 15 17 19 21 22 23 24 24)
(list 11 11 11 11 11 11 9 9 8 7 7 6 3 3 11 11 11 11 10 10 9 8 7 6 6 6 7 11 11 4 3 4 4 4 6 6 6 8 11 6 11 11 11 10 9 11 3 23 19 18 18 17 16 16 15 15 15 15 16 17 23 23 23 23 22 22 21 20 19 18 18 18 19 23 23 15 15 15 16 16 18 18 18 20 23 18 23 23 23 21 20 23 15 34 26 28 34 34 34 34 33 33 32 31 30 29 29 29 30 34 34 27 26 27 27 27 29 29 29 31 34 29 34 34 34 33 32 34 26 32 42 32 30 28 26 25 25 24 25 25 26 28 32 33 35 37 38 39 39 39 38 37 35 33 33)
(list 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250)
);mapcar
)
;;Imagen del simbolo Att_ML
(defun vectors_Att_ML ()
(mapcar 'vector_image; Color 251
(list 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24)
(list 29 29 29 29 29 29 29 22 22 22 22 23 24 25 28)
(list 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24)
(list 31 33 34 35 35 36 36 29 29 29 29 29 29 29 29)
(list 251 251 251 251 251 251 251 251 251 251 251 251 251 251 251)
);mapcar
(mapcar 'vector_image; Color 7
(list 58 58 59 60 61 61 61 60 59 58 57 56 56 56 56 56 57 51 53 53 52 52 45 45 42 41 40 39 39 38 38 38 39 39 40 41 42 42 43 38 31 34 73 72 71 70 70 69 69 69 70 70 71 72 73 74 74 69 67 59 60 61 62 63 64 64 64 63 62 61 60 59 59 56 56 56 51 53 53 52 52 49 46 45 44 43 42 42 42 39 35 32 32 6 17 24 23 22 21 19 17 15 13 12 11 10 10 10 10 11 12 13 15 17 19 21 22 23 24)
(list 10 10 10 10 11 12 13 15 15 15 15 14 13 12 11 11 10 10 15 15 14 7 15 10 15 15 15 15 14 13 12 12 10 10 10 10 10 11 11 12 7 7 26 27 27 26 25 24 24 24 22 22 21 21 22 22 23 24 19 25 26 27 27 26 24 24 22 22 21 21 22 22 21 22 19 19 21 27 26 25 19 19 21 26 27 27 26 25 21 19 27 19 19 29 18 27 25 24 23 22 22 22 23 24 25 27 27 29 31 32 34 35 36 36 36 35 34 32 29)
(list 58 59 60 61 61 61 61 61 60 59 58 57 56 56 56 57 58 54 54 53 53 52 49 49 43 42 41 40 39 39 38 39 39 40 41 42 42 43 43 43 37 34 74 73 72 71 70 70 69 70 70 71 72 73 74 74 74 74 67 60 61 62 63 64 64 64 64 64 63 62 61 60 59 56 57 56 54 54 53 53 52 49 46 46 45 44 43 42 42 39 39 35 32 28 17 24 24 23 22 21 19 17 15 13 12 11 10 10 11 12 13 15 17 19 21 22 23 24 24)
(list 10 10 10 11 12 13 14 14 15 15 15 15 14 13 12 10 10 10 15 15 15 14 10 15 14 15 15 15 15 14 13 11 11 10 10 10 11 11 12 12 7 15 25 26 27 27 26 25 24 22 22 21 21 22 22 23 24 24 27 26 27 27 26 25 25 24 24 22 22 21 21 22 29 27 19 19 21 27 27 26 25 27 27 25 26 27 27 26 25 27 19 27 27 29 40 29 27 25 24 23 22 22 22 23 24 25 29 31 32 34 35 36 36 36 35 34 32 31 31)
(list 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250 250)
);mapcar
)
;;----------------------------- MAIN ----------------------------------------------------------------
;;Valores guardados en registro:
;;(("TipoAtt" "Att_ML") ("NoAtt" 1) ("EscHTxt" "1.0000") ("EditIns" "0"))
(mapcar (function (lambda (x) (set (read (car x)) (cadr x)))) (GetVal_Reg_Nivel_P))
(setq NoAtt (itoa NoAtt))
(setq EscHTxt (jlgg-rtos (read EscHTxt) nil nil))
;;Carga el fichero de dialogo
(if (null p_dia_Nivel_P)(setq p_dia_Nivel_P '(-1 -1)))
(setq FichDlg (WriteDialogNivel_P))
(setq idxDlg (load_dialog FichDlg))
(setq accion T)
;;cargar el cuadro de dialogo en pantalla
(if (not (new_dialog "Nivel_P" idxDlg "" p_dia_Nivel_P)) (exit))
;;asignaciones de cuadro de dialogo
(set_tile "tipo_att" TipoAtt)
(set_tile "EscHtxt" EscHTxt)
(set_tile "n_att" NoAtt) ;slider
(set_tile "natt_txt" NoAtt)
(set_tile "edit" EditIns)
(Do_Chg_Tipo) ;visualiza el tipo de cota
;;
;;acciones de cuadro de dialogo
(action_tile "Att_M" "(setq TipoAtt $key)(Do_Chg_Tipo)")
(action_tile "Att_ML" "(setq TipoAtt $key)(Do_Chg_Tipo)")
(action_tile "EscHtxt" "(do_testnum $key \"Altura de Texto \" 6)")
(action_tile "n_att" "(setq NoAtt $value)(set_tile \"natt_txt\" NoAtt)")
(action_tile "edit" "(setq EditIns $value)")
(action_tile "cancel" "(setq p_dia_Nivel_P (done_dialog 0))")
(action_tile "accept" "(Nivel_P_Ok)")
;;--------------------------------------------------------
(setq accion (start_dialog)) ; activa el c. de dialogo
(cond ; Decide what to do next.
((= accion 0) ;si cancel es señalado
(unload_dialog idxDlg)
(setq retVal nil)
);c.cond de accion 0
((= accion 1)
(unload_dialog idxDlg)
;;(("TipoAtt" "Att_ML") ("NoAtt" 1) ("EscHTxt" "1.0000") ("EditIns" "0"))
(jlgg-Write-Registry-Command "Niveles_P" "TipoAtt" TipoAtt)
(jlgg-Write-Registry-Command "Niveles_P" "NoAtt" (atoi NoAtt))
(jlgg-Write-Registry-Command "Niveles_P" "EditIns" EditIns)
(jlgg-Write-Registry-Command "Niveles_P" "EscHTxt" (jlgg-rtos EscHTxt nil 32))
(setq retVal T)
)
);c.cond
retVal
);c.defun
;;-------------------------------------- ins_Nivel_Pl -----------------------------------
;; Diseñado para no usar la orden "INSERT" y las variables de insercion de atributos
;; ("ATTDIA" y ATTREQ")
;;---------------------------------------------------------------------------------------
(defun ins_Nivel_Pl (p_i esc n_attr isMultiline / n p_att NewBlCota Txt1 UCSAngX Inspt oAtt)
(defun UCSAngX ( / vec)
(setq vec (getvar "ucsxdir"))
(atan (cadr vec) (car vec))
);c.defun
;------------------------ MAIN ------------------------------------------
(if isMultiline
(setq n_attr 1
Txt1 "Multi Line \\PText ")
(setq Txt1 "Atrib ")
)
(setq p_att (polar p_i 0.0 (* esc 1.75)))
(setq p_i (trans p_i 1 0) n 1)
;creación del bloque
(ENTMAKE (list '(0 . "INSERT")'(2 . "Nivel_Pl")'(66 . 1)
(cons 8 "ARQ_Niveles")
(cons 41 esc)(cons 42 esc)(cons 43 esc)
(cons 50 (UCSAngX))
(cons 10 p_i)
)
);c.entmake
(repeat n_attr
(ENTMAKE
(list '(0 . "ATTRIB")'(62 . 0) ;atributo de Cota N
(cons 40 esc)
(cons 1 (if isMultiline Txt1 (strcat Txt1 (itoa n)))) ;cadena valor
(cons 8 "ARQ_Niveles")
(cons 50 (UCSAngX))
(cons 2 (strcat "COTALT_" (itoa n)))
(cons 7 (getvar "TEXTSTYLE"))
'(70 . 8)
'(72 . 0)
'(74 . 1)
'(10 0 0 0)
;;(cons 10 (trans p_att 1 0)) ;p_insert
(cons 11 (trans p_att 1 0)) ;p_insert 2
);c.ilst
);c.entmake
(setq p_att (polar p_att (/ pi 2) (* esc 1.5)) n (1+ n))
);c.repeat
(cond
((setq NewBlCota (ENTMAKEX '((0 . "SEQEND")(8 . "ARQ_Niveles"))))
(setq NewBlCota (cdr (assoc -2 (entget NewBlCota))))
(cond
(isMultiline
(setq oAtt (entnext NewBlCota))
(setq oAtt (GETVLA-OBJ oAtt))
(setq Inspt (vla-get-InsertionPoint oAtt))
(vla-put-MTextAttribute oAtt :vlax-true)
(vla-put-Alignment oAtt 12) ;;acAlignmentBottomLeft = 12
(vla-put-TextAlignmentPoint oAtt Inspt)
;;(vla-put-StyleName oAtt (getvar "TEXTSTYLE"))
)
);c.cond
)
);c.if
NewBlCota
);c.defun
;;----------------------------------- Make_Nivel_Pl ---------------------------------------
;; Definicion de bloque Nivel_Pl
;;-----------------------------------------------------------------------------------------
(defun Make_Nivel_Pl ()
(entmake '((0 . "BLOCK") (2 . "Nivel_Pl") (10 0.0 0.0 0.0) (70 . 2))) ;c.entmake
(entmake
(LIST
'(0 . "HATCH") '(100 . "AcDbEntity") '(67 . 0) '(8 . "0") '(62 . 251)
'(100 . "AcDbHatch") '(10 0.0 0.0 0.0) '(210 0.0 0.0 1.0) '(2 . "SOLID")
'(70 . 1) '(71 . 0) '(91 . 2) '(92 . 7) '(72 . 1) '(73 . 1) '(93 . 4)
'(10 -2.22045e-016 0.9 0.0) '(42 . 0.0) '(10 0.0 0.0 0.0)
'(42 . 0.0) '(10 0.9 -3.88578e-016 0.0) '(42 . 0.198912) '(10 0.636396 0.636396 0.0)
'(42 . 0.198912) '(97 . 0) '(92 . 7) '(72 . 1) '(73 . 1) '(93 . 4) '(10 0.0 0.0 0.0)
'(42 . 0.0) '(10 -0.9 3.88578e-016 0.0) '(42 . 0.198912) '(10 -0.636396 -0.636396 0.0)
'(42 . 0.198912) '(10 2.22045e-016 -0.9 0.0) '(42 . 0.0) '(97 . 0) '(75 . 0) '(76 . 1)
'(47 . 0.00731585) '(98 . 2) '(10 0.142244 0.417573 0.0) '(10 -0.266862 -0.281226 0.0)
'(450 . 0) '(451 . 0) '(460 . 0.0) '(461 . 0.0) '(452 . 0) '(462 . 0.0) '(453 . 2) '(463 . 0.0)
'(63 . 5) '(421 . 255) '(463 . 1.0) '(63 . 2) '(421 . 16776960) '(470 . "LINEAR")
) ;_ c. list
) ;c.entmake
(entmake
(list
'(0 . "CIRCLE") '(100 . "AcDbEntity") '(67 . 0) '(8 . "0") '(62 . 0)
'(100 . "AcDbCircle") '(10 0.0 0.0 0.0) '(40 . 0.9) '(210 0.0 0.0 1.0)
) ;_ c. list
) ;c.entmake
(entmake
(list
'(0 . "LINE") '(100 . "AcDbEntity") '(67 . 0) '(8 . "0") '(62 . 0)
'(100 . "AcDbLine") '(10 1.34401 -1.11022e-016 0.0) '(11 -1.34401 -5.55112e-016 0.0)
'(210 0.0 0.0 1.0)
) ;_ c. list
) ;c.entmake
(entmake
(list
'(0 . "LINE") '(100 . "AcDbEntity") '(67 . 0) '(8 . "0") '(62 . 0)
'(100 . "AcDbLine") '(10 -7.77156e-016 -1.34401 0.0) '(11 1.11022e-016 1.34401 0.0)
'(210 0.0 0.0 1.0)
) ;_ c. list
) ;c.entmake
(entmake '((0 . "ENDBLK"))) ;c.entmake
;------ FIN de Definicion de bloque Nivel_Pl -------;
);c.defun
;;------------------------- MAIN ------------------------
(vl-doc-set '*NameAppRun* "Niveles_P")
(setq ac:err *error* *error* LMT:error)
(jlgg-init_vars (list
'("attdia" 0)
'("attreq" 1)
'("cmdecho" 0)
'("snapmode" 0)
)
)
;;Valores guardados en registro:
;;(("TipoAtt" "Att_ML") ("NoAtt" 1) ("EscHTxt" "1.0000") ("EditIns" "0"))
(mapcar (function (lambda (x) (set (read (car x)) (cadr x)))) (GetVal_Reg_Nivel_P))
;----------------------------------------------
(setq p1 T)
(while p1
;Si no existe el bloque en el dibujo lo creamos
(if (null (tblsearch "BLOCK" "Nivel_Pl"))(Make_Nivel_Pl))
(initget "Opciones")
(setq p1 (getpoint "\nIndique punto de Cota de Altura o [Opciones]: "))
(cond
((= (type p1) 'LIST)
(setq isMText (if (= TipoAtt "Att_ML") T nil))
(jlgg-UndoStart (jlgg-ActDoc))
;Insertamos el bloque de altura
(cond
((not
(vl-catch-all-error-p
(setq NewInsBlk
(vl-catch-all-apply
(function ins_Nivel_Pl)
(list p1 (read EscHTxt) NoAtt isMText)))))
;;Editamos despues de insertar si procede
(cond
((= EditIns "1")
(redraw NewInsBlk)
;;(command "_.DDATTE" NewInsBlk)
(vl-cmdf "_.EATTEDIT" NewInsBlk)
)
)
)
);c.cond
(jlgg-UndoEnd (jlgg-ActDoc))
)
((= p1 "Opciones")
(Nivel_P_DLG)
(mapcar (function (lambda (x) (set (read (car x)) (cadr x)))) (GetVal_Reg_Nivel_P))
)
);c.cond
);c.while
(jlgg-res_vars) ;restablece variables
(setq *error* ac:err ac:err nil)
(princ)
);cierro defun principal
(princ)
El programa necesitará que estén cargadas y actualizadas las funciones comunes para los programas publicados en La Marmita.
Estas utilidades y han sido incorporadas al proyecto de “La Marmita”, integradas en el menú, en la ruta de archivos y en la carga automática de funciones y comandos.
Se pueden descargar el proyecto completo desde: Proyecto "La Marmita".
Como siempre, espero sea de utilidad.
Un saludo a tod@s desde España.
No hay comentarios:
Publicar un comentario