Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 05/13/2019 in all areas

  1. @Romero Consider the following example: (defun c:test ( / *error* dch dcl des hgt idx ins lst sty ) (defun *error* ( msg ) (if (< 0 dch) (unload_dialog dch)) (if (= 'file (type des)) (close des)) (if (and (= 'str (type dcl)) (setq dcl (findfile dcl))) (vl-file-delete dcl)) (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))) (princ (strcat "\nError: " msg)) ) (princ) ) (setq lst '( "TEXTO1" "TEXTO2" "TEXTO3" "TEXTO4" "TEXTO5" "TEXTO6" "TEXTO7" "TEXTO8" "TEXTO9" "TEXT10" ) ) (setq sty (getvar 'textstyle) hgt (cdr (assoc 40 (tblsearch "style" sty))) ) (if (zerop hgt) (progn (initget 6) (setq hgt (cond ((getdist (strcat "\nAltura de texto <" (rtos (getvar 'textsize)) ">: "))) ((getvar 'textsize)))) ) ) (if (and (setq dcl (vl-filename-mktemp nil nil ".dcl")) (setq des (open dcl "w")) (foreach str '( "txt : dialog" "{" " key = \"dcl\"; spacer;" " : list_box" " {" " key = \"lst\";" " width = 40;" " height = 20;" " fixed_width = true;" " fixed_height = true;" " allow_accept = true;" " }" " ok_cancel;" "}" ) (write-line str des) ) (not (setq des (close des))) (< 0 (setq dch (load_dialog dcl))) ) (while (not (cond ( (not (new_dialog "txt" dch)) (princ "\nDialog could not be loaded.") ) ( (progn (set_tile "dcl" "Select Text") (start_list "lst") (foreach itm lst (add_list itm)) (end_list) (set_tile "lst" (cond (idx) ((setq idx "0")))) (action_tile "lst" "(setq idx $value)") (zerop (start_dialog)) ) ) ( (while (setq ins (getpoint "\rSpecify text insertion point <back>: ")) (entmake (list '(000 . "MTEXT") '(100 . "AcDbEntity") '(100 . "AcDbMText") '(008 . "_TEXTOS") (cons 007 sty) (cons 040 hgt) (cons 010 (trans ins 1 0)) (cons 001 (nth (atoi idx) lst)) (cons 011 (getvar 'ucsxdir)) (cons 210 (trans '(0.0 0.0 1.0) 1 0 t)) ) ) ) (redraw) ) ) ) ) (princ "\nUnable to write & load DCL file.") ) (*error* nil) (princ) )
    1 point
  2. now you make me blush .. but the real champ is Lee Mac
    1 point
  3. That's correct and most time went into trying to make Lee Mac's block preview work . Lots of 'trans' & matrix stuff in there. And till this day still don't completely or really understand everything haha. Wrote this for a colleague and I don't think he has ever used it. And I admit , it really is a dragon of a program , lots of options but maybe too much... I wouldn't want to call it a complete waste of time but I also wouldn't want to call it one of my best of most useful programs either in terms of how often I or someone else has used it. Guess its like my toolbox in the garage , I use my cheap screwdrivers all the time but my expensive sawing table once or twice...
    1 point
  4. you use txthgt in cons group 40 but txthgt is never initialized. So ... ; Crea y/o establece el layer actual en "_TEXTOS" _____________________________________________________ ; create or make current layer "_TEXTOS" (defun nlay ( )(command "._layer" "_M" "_TEXTOS" "_C" "7" "" "")(setvar "clayer" "_TEXTOS")) ; Preguntar al usuario si el estio tiene Altura_________________________________________________________ ; ask user if style has height (defun qst () ;Estilo actual tiene H ;(initget "Si No")(setq eath (getkword "\nESTILO DE TEXTO ACTUAL TIENE ALTURA?? [Si/No] <Si>: ")) (initget "Yes No")(setq eath (getkword "\nDoes current textstyle have a fixed height? [Yes/No] <Yes>: ")) (if (= eath "No") (dnh)) ) ; establece altura de texto cuando el estilo no lo tiene______________________________________________ ; set text height when the style does not have it (defun dnh (/ ph) ;(setq dnht (getdist "\nAltura de Texto: <0.18>: "); Define Nueva H texto ; dnht (if (null ph) 0.18 ph)) (or txthgt (if (null (setq txthgt (getdist "\nText height : <0.18>: ")))(setq txthgt 0.18))) (setvar 'textsize txthgt) );end ;======================================================================================================= (defun c:txt3 ( / *error* lista nfile fdesc id salida pt tmp txthgt) ;Define comando y funciones ;; Error handler (defun *error* (msg) (mapcar 'setvar vars vals) (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))(princ (strcat "\nError: " msg))) (princ) ) ;; Guarda y establece variables ;; Save and set variables (setq vals (mapcar 'getvar (setq vars '(clayer orthomode luprec textsize tspacefac orthomode)))) (nlay)(qst)(dnh) (setq lista '("TEXTO1" "TEXTO2" "TEXTO3" "TEXTO4" "TEXTO5" "TEXTO6" "TEXTO7" "TEXTO8" "TEXTO7" "TEXTO8" "TEXTO9" "TEXT10")) (setq nfile (vl-filename-mktemp "Dlg.dcl") fdesc (open nfile "w")) (write-line "lista :dialog {:list_box{key=\"lst\";multiple_select=false;width=30;}:button{label=\"Salir\";key=\"cancel\";is_cancel=true;}}" fdesc) (close fdesc) (setq id (load_dialog nfile) salida 0) (while (>= salida 0) (new_dialog "lista" id) (start_list "lst" 3) (mapcar 'add_list lista) (end_list) (action_tile "lst" "(if (> (strlen $value) 0) (done_dialog (atoi $value)) )") (action_tile "cancel" "(done_dialog -1)") (if (>= (setq salida (start_dialog)) 0) (while (setq pt (getpoint)) (entmake (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(100 . "AcDbMText") (cons 10 pt)(cons 40 txthgt) '(41 . 0) '(71 . 1) (cons 1 (nth salida lista)) '(50 . 0)))))) (unload_dialog id)(vl-file-delete nfile) ) two things... use english in your code when posting here. Don't think people like to first have to translate. second thing (the right click thing)... can be done with using grread (homework) , but you would need extra code for catching cancel.
    1 point
  5. Since you are changing the value of the TEXTSIZE system variable to the appropriate height as part of your 'dnh' function, you can simply omit DXF group 40 from the MTEXT DXF data supplied to entmake and the resulting text height will be inherited from the TEXTSIZE system variable (note that this only applies to MTEXT, for which DXF group 40 is optional).
    1 point
  6. ronjonp, works perfectly. BIGAL, Emmanuel Delay and ronjonp ..... thanks for your time. Jaap
    1 point
  7. Here's another lightly tested with your sample drawing: (defun c:foo (/ a b d e s z nm) (cond ((and (setq a (car (entsel "\nPick block to copy: "))) (setq b (car (entsel "\nPick block to replace: "))) (= "INSERT" (cdr (assoc 0 (entget a))) (cdr (assoc 0 (entget b)))) (setq s (ssget "_X" (list '(0 . "insert") (assoc 2 (entget b))))) ) (setq nm (cdr (assoc 2 (entget a)))) (foreach c (mapcar 'vlax-ename->vla-object (mapcar 'cadr (ssnamex s))) (cond ((vlax-write-enabled-p c) (vla-getboundingbox c 'd 'z) (vla-put-name c nm) (vla-getboundingbox c 'e 'z) (or (equal (vlax-safearray->list d) (vlax-safearray->list e) 1e-4) (vla-put-rotation c (+ pi (vla-get-rotation c))) ) ) ) ) ) ) (princ) )
    1 point
  8. You're most welcome @Romero!
    1 point
  9. You're very welcome .
    1 point
  10. You can check if a member if found in a list with member function . e.g. (setq a (list "1" "2" "3")) (member "2" a)
    1 point
×
×
  • Create New...