« previous next »
Pages: [1] |   Go Down

Author Topic: select and run dcl  (Read 1212 times)

0 Members and 1 Guest are viewing this topic.

amc.dicsac

  • Newt
  • Posts: 109
  • Autocad 2008
select and run dcl
« on: September 26, 2016, 12:47:07 PM »
Hi I need help,

This program allow you select texts to resize according to the scale you chosen in poppup_list.

I want know how do to first select the text and then run the dcl.  :cry: :cry:

Thanks..

Code - Auto/Visual Lisp: [Select]
  1. ;; DCL Temporal ---> Lee Mac
  2. (setq EscalaTextVersion "1.1")
  3.  
  4. (defun TextoEscala:GetSavePath ( / tmp )
  5.     (cond      
  6.         (   (setq tmp (getvar 'ROAMABLEROOTPREFIX))
  7.             (strcat (vl-string-right-trim "\" (vl-string-translate "/" "\" tmp)) "\\Support")
  8.        )
  9.        (   (setq tmp (findfile "ACAD.pat"))
  10.            (vl-string-right-trim "\" (vl-string-translate "/" "\" (vl-filename-directory tmp)))
  11.        )
  12.        (   (vl-string-right-trim "\" (vl-filename-directory (vl-filename-mktemp))))
  13.    )
  14. )
  15.  
  16. ;; Agregar Listado ---> Lee Mac
  17. (defun _ax:start ( key lst )
  18.   (start_list key)
  19.   (mapcar 'add_list lst)
  20.   (end_list)
  21.   lst
  22. )
  23.  
  24. ;; ssget  -  Lee Mac
  25. ;; A wrapper for the ssget function to permit the use of a custom selection prompt
  26. ;; msg - [str] selection prompt
  27. ;; arg - [lst] list of ssget arguments
  28.    
  29. (defun LM:ssget ( msg arg / sel )
  30.  (princ msg)
  31.  (setvar 'nomutt 1)
  32.  (setq sel (vl-catch-all-apply 'ssget arg))
  33.  (setvar 'nomutt 0)
  34.  (if (not (vl-catch-all-error-p sel)) sel)
  35. )
  36.  
  37. ;; Start Undo  -  Lee Mac
  38. ;; Opens an Undo Group.
  39.  
  40. (defun LM:startundo ( doc )
  41.    (LM:endundo doc)
  42.    (vla-startundomark doc)
  43. )
  44.  
  45. ;; End Undo  -  Lee Mac
  46. ;; Closes an Undo Group.
  47.  
  48. (defun LM:endundo ( doc )
  49.    (while (= 8 (logand 8 (getvar 'undoctl)))
  50.        (vla-endundomark doc)
  51.    )
  52. )
  53.  
  54. ;; Active Document  -  Lee Mac
  55. ;; Returns the VLA Active Document Object
  56.  
  57. (defun LM:acdoc nil
  58.    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
  59.    (LM:acdoc)
  60. )
  61.  
  62.  
  63. ;;; ----------------------- Función Principal ----------------------
  64. (defun c:MESCTEXT (/ *error* texto_escala)
  65. (vl-load-com)
  66. ;;; Control de errores
  67. (defun *error* ( msg )
  68.        (LM:endundo (LM:acdoc))
  69.        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
  70.            (princ (strcat "\nError: " msg))
  71.        )
  72.        (princ)
  73.    )
  74.  
  75. (setq texto_escala '("*Selecciona Escala*" "1:20" "1:25" "1:50" "1:75" "1:100" "1:125" "1:200" "1:250" "1:500" "MS:PS"))
  76.  
  77.  
  78. ;;----------Ruta temporal y configuración DCL ---------------------------------
  79. ;;Guardamos la ruta con la funcíon (NumInc:GetSavePath)
  80. ;;-----------------------------------------------------------------------------
  81. (setq savepath (TextoEscala:GetSavePath))
  82. (setq dcl (strcat savepath "\\Biblioteca_Block" (vl-string-translate "." "-" EscalaTextVersion) ".dcl"))
  83. (setq des (open dcl "w"))
  84. (foreach line
  85. '(
  86. "spc1 : spacer"
  87. "{"
  88. "    height = 0.1;"
  89. "    fixed_height = true;"
  90. "    width = 0.1;"
  91. "    fixed_width = true;"
  92. "}"
  93. "EscalaText : dialog { label = "Escala textos:"; width=30;"
  94. "spc1;"  
  95. " : row { alignment = left; "
  96. " : paragraph {"
  97. " : text_part {key = "LtSample8"; label = "";}"
  98. "             }"
  99. "       }"  
  100. "spc1;"  
  101. ":popup_list { key = "key_text_escala"; width=20; value = "1";}"
  102. "spc1;"
  103. " : row {"
  104. " : button { label = " &Cancelar "; mnemonic = "C"; key = "cancel"; fixed_width = true; is_cancel = true;}"
  105. " : button { label = " &Aplicar "; key = "key_in"; fixed_width = true;}"
  106. "       }"
  107. "spc1;"
  108. " : row { alignment = left; "
  109. " : text  {label = "Copyright (c) Ax:Program Lisp"; } "
  110. "       }"
  111. "}"
  112.  )
  113. (write-line line des))
  114. (progn (close des) (< 0 (setq dch (load_dialog dcl))))
  115. (if (not (new_dialog "EscalaText" dch "" (cond (*screenpointEscalaText*) ('(-1 -1)))))
  117. (alert (strcat "\n                   **ERROR**       "
  118.                "\n--------------------------------------------------------------------------------"
  119.                "\nlamentamos este inconveniente porfavor comunicate via"
  120.                "\nemail  [ amc.dicsac@gmail.com ]"
  121.                "\n"))
  122. (exit)))
  123.  
  124. ;;Carpetas por defecto
  125. (if (null key_text_escala) (setq key_text_escala "0"))
  126.  
  127. ;;--------------------------- _addlist -----------------------------------------
  128. ;;Agregamos la lista con su propio "key"
  129. ;;------------------------------------------------------------------------------
  130. (_ax:start "key_text_escala" texto_escala)
  131.  
  132.  
  133. ;;--------------------------- set_tile / action_tile "key_text_escala"-----------------------------------------
  134. ;;Definimos la lista de escalas para luego usarlas
  135. ;;y la guardarmos en la varibale key_text_escala
  136. ;;------------------------------------------------------------------------------------------------------
  137. (set_tile "key_text_escala" key_text_escala)
  138. (set_tile "LtSample8" (strcat "Seleccion la escala..."))
  139. (action_tile "key_text_escala" "(setq var_text_escala (nth (atoi (setq key_text_escala $value)) texto_escala))")
  140.  
  141. (action_tile "cancel" "(setq *screenpointEscalaText* (done_dialog 1))")
  142. (action_tile "key_in" "(setq *screenpointEscalaText* (done_dialog 2))")
  143. (setq ddiag (start_dialog))
  145. (if (= ddiag 1) (prompt "\n*Programa Cancelado...*"))
  146. (if (= ddiag 2) (2ap_Program_Escalatext))
  147. (setq dch (unload_dialog dch))
  148. (if (and dcl (findfile dcl))
  150. (if (< 0 dch) (unload_dialog dch))
  151. (setvar "cmdecho" 1)
  153.  
  154.  
  155. ;;----------- Programa para modificar las escalar ----------------
  156. (defun 2ap_Program_Escalatext ( )
  157. (cond ((= var_text_escala "1:20") (setq opt_escala 0.035))
  158.       ((= var_text_escala "1:25") (setq opt_escala 0.040))
  159.       ((= var_text_escala "1:50") (setq opt_escala 0.10))
  160.       ((= var_text_escala "1:75") (setq opt_escala 0.13))
  161.       ((= var_text_escala "1:100") (setq opt_escala 0.18))
  162.       ((= var_text_escala "1:125") (setq opt_escala 0.23))
  163.       ((= var_text_escala "1:200") (setq opt_escala 0.36))
  164.       ((= var_text_escala "1:250") (setq opt_escala 0.40))
  165.       ((= var_text_escala "1:500") (setq opt_escala 0.90))
  166.       ((= var_text_escala "MS:PS") (setq opt_escala 2.0)))
  167. (LM:startundo (LM:acdoc))
  168. (prompt "\n- Cambiar texto(s) de altura: ")
  169. (if (setq i -1 ObjSelect (LM:ssget "\nSelecciona el texto, mtext o attdef <exit>: " '(((0 . "text,mtext,attdef")))))
  170. (while (setq nt (ssname ObjSelect (setq i (1+ i))))
  172. (subst (cons 40 opt_escala)(assoc 40 (entget nt))(entget nt)))))
  173. (prompt (strcat "\n- Modificado [ " (itoa (sslength ObjSelect)) " ] textos con altura [ " (rtos opt_escala 2 3) " ] "))
  174. (LM:endundo (LM:acdoc))
  176.  
Logged
<a href="http:/http://axprogramlisp.blogspot.pe" class="bbc_link" target="_blank">By Alexander Castro</a>
Pages: [1] |   Go Up
« previous next »