leonucadomi Posted March 7 Posted March 7 hello all: I need a routine that first asks me to enter "a word" and this word is added to the value of the dimension below the line example The modified dimension shows this Does anyone know of any code that can help me? thanks Quote
Lee Mac Posted March 7 Posted March 7 Here's a quick one - (defun c:dimsub ( / enx grp idx new pos sel str ) (cond ( (= "" (setq str (getstring t "\nSpecify string: ")))) ( (setq sel (ssget "_:L" '((0 . "*DIMENSION")))) (repeat (setq idx (sslength sel)) (setq idx (1- idx) enx (entget (ssname sel idx)) grp (assoc 1 enx) ) (if (setq pos (vl-string-search "\\X" (cdr grp))) (setq new (cons 1 (strcat (substr (cdr grp) 1 pos) "\\X" str))) (setq new (cons 1 (strcat "<>\\X" str))) ) (entmod (subst new grp enx)) ) ) ) (princ) ) 1 Quote
leonucadomi Posted March 7 Author Posted March 7 7 minutes ago, Lee Mac said: Here's a quick one - (defun c:dimsub ( / enx grp idx new pos sel str ) (cond ( (= "" (setq str (getstring t "\nSpecify string: ")))) ( (setq sel (ssget "_:L" '((0 . "*DIMENSION")))) (repeat (setq idx (sslength sel)) (setq idx (1- idx) enx (entget (ssname sel idx)) grp (assoc 1 enx) ) (if (setq pos (vl-string-search "\\X" (cdr grp))) (setq new (cons 1 (strcat (substr (cdr grp) 1 pos) "\\X" str))) (setq new (cons 1 (strcat "<>\\X" str))) ) (entmod (subst new grp enx)) ) ) ) (princ) ) i will try master thanks Quote
leonucadomi Posted March 7 Author Posted March 7 EXCELLENT... You can make it so that by default it suggests the word "typ" so that with just one enter I can continue the routine and if in the future I need to add another word I can change it. Quote
Lee Mac Posted March 7 Posted March 7 36 minutes ago, leonucadomi said: You can make it so that by default it suggests the word "typ" so that with just one enter I can continue the routine and if in the future I need to add another word I can change it. For a "fixed" default, you can use something like the following: (defun c:dimsub ( / enx grp idx new pos sel str ) (if (= "" (setq str (getstring t "\nSpecify string <TYP>: "))) (setq str "TYP") ) (if (setq sel (ssget "_:L" '((0 . "*DIMENSION")))) (repeat (setq idx (sslength sel)) (setq idx (1- idx) enx (entget (ssname sel idx)) grp (assoc 1 enx) ) (if (setq pos (vl-string-search "\\X" (cdr grp))) (setq new (cons 1 (strcat (substr (cdr grp) 1 pos) "\\X" str))) (setq new (cons 1 (strcat "<>\\X" str))) ) (entmod (subst new grp enx)) ) ) (princ) ) For a "dynamic" default, you can use one of the methods I describe here. 1 Quote
BIGAL Posted March 8 Posted March 8 Interesting ""Windows Speech Recognition," and then use the shortcut Windows logo key + Ctrl + S to activate it. Typed dimsub then spoke T Y P a box appeared then did accept. !typ = "TYP " very close. It did 1st go put EYP in command line. So I think I need to train it more. Can turn on and off microphone by voice. If I have time may play more. 1 Quote
leonucadomi Posted October 15 Author Posted October 15 On 3/7/2025 at 5:58 PM, Lee Mac said: For a "fixed" default, you can use something like the following: (defun c:dimsub ( / enx grp idx new pos sel str ) (if (= "" (setq str (getstring t "\nSpecify string <TYP>: "))) (setq str "TYP") ) (if (setq sel (ssget "_:L" '((0 . "*DIMENSION")))) (repeat (setq idx (sslength sel)) (setq idx (1- idx) enx (entget (ssname sel idx)) grp (assoc 1 enx) ) (if (setq pos (vl-string-search "\\X" (cdr grp))) (setq new (cons 1 (strcat (substr (cdr grp) 1 pos) "\\X" str))) (setq new (cons 1 (strcat "<>\\X" str))) ) (entmod (subst new grp enx)) ) ) (princ) ) For a "dynamic" default, you can use one of the methods I describe here. master , I am trying to do the following (defun c:dimsub ( / enx grp idx new pos sel str ) (princ "\nColoca subfijo a dimension por debajo de linea con opcion de cambio") ; (if (= "" (setq str (getstring t "\nSpecify string <TYP>: "))) ;(setq str "TYP") ; ) (if (setq sel (ssget "_:L" '((0 . "*DIMENSION")))) (repeat (setq idx (sslength sel)) (setq idx (1- idx) enx (entget (ssname sel idx)) grp (assoc 1 enx) ) (if (setq pos (vl-string-search "\\X" (cdr grp))) (setq new (cons 1 (strcat (substr (cdr grp) 1 pos) "\\X" str))) (setq new (cons 1 (strcat "+" "<>\\X" "TEXT 1"))) ) (entmod (subst new grp enx)) ) ) (princ) ) Quote
leonucadomi Posted October 15 Author Posted October 15 I NEED TO ADD A SECOND TEXT BELOW THE FIRST Quote
GLAVCVS Posted October 15 Posted October 15 (edited) Another option (defun c:subTexta (/ e le txa tx cj para) (if (/= (setq tx (getstring "\nType TEXT to add?: ")) "") (while (setq n (not (setvar "NOMUTT" 1)) x (princ (strcat "\rAdd \'" tx "\' to DIMENSIONs...")) cj (ssget "_:L" '((0 . "*DIMENSION")))) (while (setq e (ssname cj (setq n (if n (1+ n) 0)))) (entmod (subst (cons 1 (cond ((or (wcmatch (setq txa (cdr (assoc 1 (setq le (entget e))))) "*<>\n*") (wcmatch txa "*<>\\X*")) (strcat txa "\n" tx)) (T (strcat txa "<>\\X" tx)))) (assoc 1 le) le ) ) ) ) ) (setvar "NOMUTT" 0) (princ) ) Edited October 15 by GLAVCVS 1 Quote
GLAVCVS Posted October 15 Posted October 15 (edited) 2 minutes ago, GLAVCVS said: Another option (defun c:subTexta (/ e le txa tx cj para) (if (/= (setq tx (getstring "\nType TEXT to add?: ")) "") (while (setq n (not (setvar "NOMUTT" 1)) x (princ (strcat "\rAdd \'" tx "\' to DIMENSIONs...")) cj (ssget "_:L" '((0 . "*DIMENSION")))) (while (setq e (ssname cj (setq n (if n (1+ n) (setvar "NOMUTT" 0))))) (entmod (subst (cons 1 (cond ((or (wcmatch (setq txa (cdr (assoc 1 (setq le (entget e))))) "*<>\n*") (wcmatch txa "*<>\\X*")) (strcat txa "\n" tx)) (T (strcat txa "<>\\X" tx)))) (assoc 1 le) le ) ) ) ) ) (princ) ) To add all the text lines you need Edited October 15 by GLAVCVS 1 Quote
GLAVCVS Posted October 15 Posted October 15 @leonucadomi You should copy the code again. I changed a small thing to prevent NOMUTT from staying at 1. 1 Quote
leonucadomi Posted October 15 Author Posted October 15 @GLAVCVS IT'S OKAY, I JUST NEED IT WITHOUT HAVING TO ADD THE TEXT TO THE BEGINNING, SO TEXTS 1 AND 2 WILL ALREADY BE DEFINED WITHIN THE ROUTINE I mean I just select a dimension and the result is... true dimension accompanied by the "+" sign and below the line "text 1" and below this "text 2" (defun c:dimsub ( / enx grp idx new pos sel str ) (princ "\nColoca subfijo a dimension por debajo de linea con opcion de cambio") (if (setq sel (ssget "_:L" '((0 . "*DIMENSION")))) (repeat (setq idx (sslength sel)) (setq idx (1- idx) enx (entget (ssname sel idx)) grp (assoc 1 enx) ) (if (setq pos (vl-string-search "\\X" (cdr grp))) (setq new (cons 1 (strcat (substr (cdr grp) 1 pos) "\\X" str))) (setq new (cons 1 (strcat "+" "<>\\X" "TEXT 1))) ) (entmod (subst new grp enx)) ) ) (princ) ) this routine is from the master @Lee Mac I mean I'm looking to add a second line Quote
GLAVCVS Posted October 15 Posted October 15 (edited) I think the best way to explain it is to include a picture of the DIMENSION before and after it was modified. Although perhaps other, more awake minds than mine have already understood it. Edited October 16 by GLAVCVS Quote
BIGAL Posted October 16 Posted October 16 (edited) Something I have done for attributes in a block is pop up a dcl with the current attribute values so there is no reason why could not do the same just set a maximum number of lines 1 2 3 4 etc. If you leave a line blank that would be considered end of multi line input. It uses my library Multi getvals.lsp to make the dcl. Some example code can be changed to work with a Dimension. Have a go. ; Change an attribute value in blocks ; Using creation order rather than by tag name ; BY Alan H Sept 2025 (defun AH:blchange( / ss1 blname x inc atts) (if (not AH:getvalsm)(load "Multi Getvals.lsp")) (setq obj (vlax-ename->vla-object (car (entsel "\nPick block object ")))) (setq atts (vlax-invoke obj 'Getattributes)) (setq lst '()) (setq lst '("Enter new values ")) (foreach att atts (setq lst (cons (vlax-get att 'tagstring) lst)) (setq lst (cons 19 lst)) (setq lst (cons 20 lst)) (setq lst (cons (vlax-get att 'Textstring) lst)) ) (setq lst (reverse lst)) (setq ans (AH:getvalsm lst)) (setq x -1) (foreach att atts (vlax-put att 'Textstring (nth (setq x (1+ x)) ans)) ) (princ) ) (aH:blchange) Multi GETVALS.lsp Edited October 17 by BIGAL Quote
Nikon Posted October 16 Posted October 16 (edited) Here are two good options from Lee Mac Edited October 16 by Nikon 1 1 Quote
BIGAL Posted October 17 Posted October 17 (edited) Give this a try, allows up to 4 values. Probably needs a bit of fine tuning. Only use it with a single line dim. Can add more lines and can change width of boxes look at 20 19. ; Add more lines to a normal Dimension ; By AlanH Oct 2025 (defun c:incdim ( / obj prec ans howmany x newstr ) (setq obj (vlax-ename->vla-object (car (entsel "\nPick Dimension object ")))) (setq prec (vlax-get obj 'PrimaryUnitsPrecision)) (setq tp (vlax-get obj 'TextPosition)) (if (= (setq len (vlax-get obj 'textoverride)) "") (setq newstr (rtos (vlax-get obj 'measurement) 2 prec)) ) (if (not AH:getvalsm)(load "Multi Getvals.lsp")) (setq ans (AH:getvalsm (list "Enter values " "line 1 " 20 19 newstr "line 2 " 20 19 "" "Line 3" 20 19 "" "Line 4" 20 19 ""))) (setq howmany "Yes") (setq x 0) (while (= howmany "Yes") (setq str (nth (setq x (1+ x)) ans)) (setq newstr (strcat newstr "\n" str )) (if (or (= x 3)(= str ""))(setq howmany "No")) ) (vlax-put obj 'textoverride newstr) (vlax-put obj 'TextPosition tp) (princ) ) (c:incdim) Edited October 17 by BIGAL Quote
GLAVCVS Posted October 17 Posted October 17 (edited) On 10/15/2025 at 11:49 PM, leonucadomi said: @GLAVCVS IT'S OKAY, I JUST NEED IT WITHOUT HAVING TO ADD THE TEXT TO THE BEGINNING, SO TEXTS 1 AND 2 WILL ALREADY BE DEFINED WITHIN THE ROUTINE I mean I just select a dimension and the result is... true dimension accompanied by the "+" sign and below the line "text 1" and below this "text 2" (defun c:dimsub ( / enx grp idx new pos sel str ) (princ "\nColoca subfijo a dimension por debajo de linea con opcion de cambio") (if (setq sel (ssget "_:L" '((0 . "*DIMENSION")))) (repeat (setq idx (sslength sel)) (setq idx (1- idx) enx (entget (ssname sel idx)) grp (assoc 1 enx) ) (if (setq pos (vl-string-search "\\X" (cdr grp))) (setq new (cons 1 (strcat (substr (cdr grp) 1 pos) "\\X" str))) (setq new (cons 1 (strcat "+" "<>\\X" "TEXT 1))) ) (entmod (subst new grp enx)) ) ) (princ) ) this routine is from the master @Lee Mac I mean I'm looking to add a second line I think this code should meet what you need. ;************************ G L A V C V S ************************* ;************************** F E C I T *************************** (defun c:subTexta (/ e n le vlae txu tx cj g? tg) (vl-catch-all-apply '(lambda () (while (or (/= (setq tx (getstring (strcat "\nType TEXT to add to DIMENSION (escape to EXIT) " (if tx (strcat "<" tx ">") "") ": "))) "") txu) (set (if (= tx "") 'tx 'txu) (if (= tx "") txu tx)) (setq n nil cj (ssget "_:L" '((0 . "*DIMENSION")))) (while (setq e (ssname cj (setq n (if n (1+ n) 0)))) (setq g? (/= (setq tg (vla-get-Textoverride (setq vlae (vlax-ename->vla-object e)))) "")) ;(vla-put-Textoverride vlae (if g? (strcat tg (if (wcmatch tg "*\\X*") "\n" "\\X") tx) (strcat tg "<>\\X" tx)));ACTIVA ESTA LÍNEA SI QUIERES EVITAR QUE PONGA EL SIGNO + DELANTE DEL PRIMER TEXTO Y DESACTIVA LA SIGUIENTE LÍNEA DE CODIGO (vla-put-Textoverride vlae (if g? (strcat (if (wcmatch tg "+*") "" "+") tg (if (wcmatch tg "*\\X*") "\n" "\\X") tx) (strcat "+" (rtos (vla-get-Measurement vlae) 2 (vla-get-PrimaryUnitsPrecision vlae)) "\\X" tx))) ) ) ) ) (princ) ) Edited October 17 by GLAVCVS 1 1 Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.