Leaderboard

After a few modifications, your code works on a French version (so on any language) I'll let you compare to see the errors I commented out non-functional parts for classic polylines and rewritten otherwise so that they work with optimized and/or classic polylines. (defun C:AREARON (/ allx ally areaobj counter pr entity-name entnamevla mysset pt vertex x y ) (vl-load-com) (COMMAND "_.UNDO" "_BE") (set_var) (if (tblsearch "Layer" "AREARON") (command "_.-layer" "_thaw" "AREARON" "_on" "AREARON" "_unlock" "AREARON" "_set" "AREARON" "" ) ;_ closes command (command "_.-layer" "_make" "AREARON" "_color" 1 "AREARON" "" ) ;_ closes command ) (if (null sch) (setq sch 1.0) ) (initget 6) (setq temp (getreal (strcat "\nENTER SCALE <" (rtos sch 2 2) ">: " ) ) ) (if temp (setq sch temp) (setq temp sch) ) (if (null precision) (setq precision 1) ) (initget 6) (setq prec_temp (getint (strcat "\nHOW MANY DECIMAL PLACES?: <" (rtos precision 2 2) ">: " ) ) ) (if prec_temp (setq precision prec_temp) (setq prec_temp precision) ) (prompt "\nSELECT CLOSED POLYLINES:> ") (setq ; mysset (ssget '((0 . "POLYLINE,LWPOLYLINE") (-4 . "&") (70 . 1))) mysset (ssget '((0 . "*POLYLINE") (-4 . "<AND") (-4 . "<NOT") (-4 . "&") (70 . 120) (-4 . "NOT>") (-4 . "&") (70 . 1) (-4 . "AND>"))) counter 0 ) (if mysset (progn (while (< counter (sslength mysset)) (setq allx 0 ally 0 entity-name (ssname mysset counter) entnamevla (vlax-ename->vla-object entity-name) areaobj (vla-get-area entnamevla) pr -1 ) ;| (while (assoc 10 el) (setq vertex (cdr (assoc 10 el)) ctr (+ ctr 1) x (car vertex) y (cadr vertex) allx (+ allx x) ally (+ ally y) EL (cdr (member (assoc 10 el) el)) ) ) (setq x (/ allx ctr) y (/ ally ctr) pt (list x y) ) |; (repeat (1+ (fix (vlax-curve-getEndParam entnamevla))) (setq pr (1+ pr) vertex (vlax-curve-GetPointAtParam entnamevla pr) x (car vertex) y (cadr vertex) allx (+ allx x) ally (+ ally y) ) ) (setq x (/ allx (1+ pr)) y (/ ally (1+ pr)) pt (list x y) ) (command "_.text" "_j" "_mc" pt (* sch 2.5) "0" (rtos areaobj 2 precision) ) (setq counter (+ counter 1)) ) ) (alert "\nNO CLOSED POLYLINES/LWPOLYLINES IN YOUR SELECTION" ) ) (reset_var) (princ) (COMMAND "_.UNDO" "_END") ) (princ) (defun set_var () (setq oldlayer (getvar "clayer")) (setq oldsnap (getvar "osmode")) (setq temperr *error*) (setq *error* traperror) (setvar "osmode" 0) (princ) ) (defun traperror (errmsg) (command nil nil nil) (if (not (member errmsg '("console break" "Function Cancelled")) ) (princ (strcat "\nError: " errmsg)) ) (setvar "clayer" oldlayer) (setvar "osmode" oldsnap) (princ "\nError Resetting Enviroment ") (setq *error* temperr) (princ) ) (defun reset_var () (setq *error* temperr) (setvar "clayer" oldlayer) (setvar "osmode" oldsnap) (princ) )

Please use Code Tags, not Quote Tags for code. AFAIK, WBLOCK uses whatever you have set in Options>Open and Save>Save as for the release it uses.

FYI. I updated the function in my original post to add undo marks. I noticed if you undo, it can eat the previous command as well. I also simplified the reconstitution of the text string a little bit.

That did the trick. Thanks!! Just in case I need it again, is it the 1 & 2 in the following line that control the source and destination lines? (setq tls (_listswap 1 2 tls)

@jim78b Try this: (defun c:AllToByBlock (/ doc) (vl-load-com) (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-for b (vla-get-Blocks doc) (if (= :vlax-false (vla-get-IsLayout b) (vla-get-IsXref b)) (vlax-for o b (if (not (wcmatch (vla-get-objectname o) "*Dimension")) (vla-put-Color o 0) ) ) ) ) (vla-regen doc acAllViewports) (princ) )

if it is only you that uses the xref, or if everyone has the same version of CAD, I'd be tempted to open and save as a new revision

@trb426 Try this - It's pretty rudimentary, working by parsing the string and swapping lines 2 and 3. Won't handle anything that is not EXACTLY the string pattern you mention: (defun c:SWAPMT (/ d _listswap obj ss _StrParse tls txt) (vl-load-com) (vla-StartUndoMark (setq d (vla-get-activedocument (vlax-get-acad-object)))) (defun _StrParse (str del / pos) (if (and str del) (if (setq pos (vl-string-search del str)) (cons (substr str 1 pos) (_StrParse (substr str (+ pos 1 (strlen del))) del)) (list str) ) ) ) (defun _listswap (nth1 nth2 lst / cnt) (if (and (/= nth1 nth2)(>= nth1 0)(>= nth2 0)(< nth1 (length lst))(< nth2 (length lst))) (mapcar (function (lambda (x) (setq cnt (if cnt (1+ cnt) 0)) (cond ((= cnt nth1) (nth nth2 lst)) ((= cnt nth2) (nth nth1 lst)) (T x) ) ) ) lst ) ) ) (princ "\nSelect MTEXT Objects: ") (if (setq ss (ssget '((0 . "MTEXT")))) (repeat (setq n (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss (setq n (1- n)))) txt (vla-get-textstring obj) tls (_strparse txt "\\P") ) (if (> (length tls) 2) (setq tls (_listswap 1 2 tls) txt (apply 'strcat (cons (car tls) (mapcar '(lambda (x)(strcat"\\P" x)) (cdr tls)))) obj (vla-put-textstring obj txt) ) ) ) ) (redraw) (vla-endundomark d) (princ) )

I looked through my archive and I just so happen to have a copy of that! DimFillResize.zip

There once was a LISP called DimFillResize.lsp HERE But I get Page Not Found on cadalyst trying to download LISP lately. Maybe someone has it or can recreate it. As mentioned by CyberAngel, you can manually adjust in the editor, but that seems tedious if you have a lot of them.

Composez en langage international (par défaut en Anglais) Tous les appels à commande (ainsi que les options) devront se faire avec un souligné. Ex: (command "Calque" "Etablir" ...) devrait devenir (command "_.-layer" "_set" ...) Le tiret sert à éviter (généralement)l'appel de la commande en boite de dialogue, bien que dans un code en lisp l'appel de la boite de dialogue est généralement ignoré. Le point sert à appeler la commande native au cas ou la commande aurait été redéfinie: commande "Nondef" (_UNDEFINE) Le souligné sert pour appeler la commande internationale. Si employé la commande sera reconnue sur n'importe quelle version linguistique : Espagnole, Française, Allemande, Italienne , etc ... Une astuce pour connaître la commande anglaise: (getcname "Calque") -> "_Layer" Pour les options c'est plus subtil: lancer la commande en Français puis l'option choisie, faite alors Echapp (Esc). Rappelez la commande par entrée ET AVEC la flèche haute rappelez la dernière option, elle vous sera proposée alors en Anglais. Pour le lisp il y a moins de pièges: les options de la fonction (ssget): "F" Fenêtre -> "_W" window "D" Dernier -> "_L" Last "I" Implicite -> "_I" "P" Précédent -> "_P" Previous" "C" Capture -> "_C" Crossing" "SP" Fenêtre polygonale -> "_WP" Window Polygon "CP" Capture polygonale -> "_CP" Crossing Polygon "T" Trajet -> "_F" Fence "X" Tout -> "_X" All les option de (osnap): "mil" milieu -> "_mid" middle "ext" extrémité - > "_end" "int"intersection -> "_int" "cen" centre -> "_cen" center "pro" proche -> "_near" etc.. Si tu respecte ces syntaxes, ton code devrait fonctionner sous n'importe quelle version linguistique sans problème. Translate Compose in international language (by default in English) All command calls (as well as options) must be made with an underline. Ex: (command "Calque" "Etablir" ...) should become (command "_.-layer" "_set" ...) The hyphen is used to (generally) avoid calling the command in a dialog box, although in Lisp code calling the dialog box is generally ignored. The point is used to call the native command in case the command has been redefined: "Nondef" command (_.UNDEFINE) The underline is used to call the international command. If used, the command will be recognized on any language version: Spanish, French, German, Italian, etc. A tip to know the English command: (getcname "Calque") -> "_Layer" For the options it's more subtle: launch the command in French then the chosen option, then do Escape (Esc). Recall the command by enter AND WITH the up arrow recall the last option, it will then be offered to you in English. For lisp there are fewer pitfalls: function options (ssget): "F" Fenêtre -> "_W" window "D" Dernier -> "_L" Last "I" Implicite -> "_I" "P" Précédent -> "_P" Previous" "C" Capture -> "_C" Crossing" "SP" Fenêtre polygonale -> "_WP" Window Polygon "CP" Capture polygonale -> "_CP" Crossing Polygon "T" Trajet -> "_F" Fence "X" Tout -> "_X" All the options of (osnap): "mil" milieu -> "_mid" middle "ext" extrémité - > "_end" "int"intersection -> "_int" "cen" centre -> "_cen" center "pro" proche -> "_near" etc.. If you follow these syntaxes, your code should work under any language version without problem.

this is the code thanks for the help i want o used it in the frensh version of autocad ----------------------------------------------------------------------------- (defun C:AREARON (/ allx ally areaobj counter ctr el entity-name entnamevla mysset pt tst vertex x y ) (vl-load-com) (COMMAND "_.UNDO" "BE") (set_var) (if (tblsearch "Layer" "AREARON") (command "._layer" "_thaw" "AREARON" "_on" "AREARON" "_unlock" "AREARON" "_set" "AREARON" "" ) ;_ closes command (command "._layer" "_make" "AREARON" "_color" 1 "AREARON" "" ) ;_ closes command ) (if (null sch) (setq sch 1.0) ) (initget 6) (setq temp (getreal (strcat "\nENTER SCALE <" (rtos sch 2 2) ">: " ) ) ) (if temp (setq sch temp) (setq temp sch) ) (if (null precision) (setq precision 1) ) (initget 6) (setq prec_temp (getint (strcat "\nHOW MANY DECIMAL PLACES?: <" (rtos precision 2 2) ">: " ) ) ) (if prec_temp (setq precision prec_temp) (setq prec_temp precision) ) (prompt "\nSELECT CLOSED POLYLINES:> ") (setq mysset (ssget '((0 . "POLYLINE,LWPOLYLINE") (-4 . "&") (70 . 1))) counter 0 ) (if mysset (progn (while (< counter (sslength mysset)) (setq allx 0 ally 0 ctr 0 tst 1 entity-name (ssname mysset counter) EL (entget entity-name) entnamevla (vlax-ename->vla-object entity-name) areaobj (vla-get-area entnamevla) ) (while (assoc 10 el) (setq vertex (cdr (assoc 10 el)) ctr (+ ctr 1) x (car vertex) y (cadr vertex) allx (+ allx x) ally (+ ally y) EL (cdr (member (assoc 10 el) el)) ) ) (setq x (/ allx ctr) y (/ ally ctr) pt (list x y) ) (command "text" "j" "mc" pt (* sch 2.5) "0" (rtos areaobj 2 precision) ) (setq counter (+ counter 1)) ) ) (alert "\nNO CLOSED POLYLINES/LWPOLYLINES IN YOUR SELECTION" ) ) (reset_var) (princ) (COMMAND "_.UNDO" "END") ) (princ) (defun set_var () (setq oldlayer (getvar "clayer")) (setq oldsnap (getvar "osmode")) (setq temperr *error*) (setq *error* traperror) (setvar "osmode" 0) (princ) ) (defun traperror (errmsg) (command nil nil nil) (if (not (member errmsg '("console break" "Function Cancelled")) ) (princ (strcat "\nError: " errmsg)) ) (setvar "clayer" oldlayer) (setvar "osmode" oldsnap) (princ "\nError Resetting Enviroment ") (setq *error* temperr) (princ) ) (defun reset_var () (setq *error* temperr) (setvar "clayer" oldlayer) (setvar "osmode" oldsnap) (princ) )

Try double-clicking on the text. You can edit it the way you would multiline text, including dragging the borders horizontally and vertically.

Here you go. (defun c:Test (/ hgt int sel ent get ins) ;;----------------------------------------------------;; ;; Author : Tharwat Al Choufi ;; ;; website: https://autolispprograms.wordpress.com ;; ;;----------------------------------------------------;; (and (setq hgt (getdist "\nSpecify text height : ")) (princ "\nSelect points to replace with texts : ") (setq int -1 sel (ssget "_:L" '((0 . "POINT"))) ) (while (setq int (1+ int) ent (ssname sel int) ) (and (setq get (entget ent) ins (assoc 10 get) ) (entmake (list '(0 . "TEXT") ins (cons 40 hgt) (cons 1 (rtos (caddr (cdr ins)) 2 2)) (cons 7 (getvar 'TEXTSTYLE)) '(71 . 0) '(72 . 1) (cons 11 (cdr ins)) '(73 . 0) ) ) (entdel ent) ) ) ) (princ) )

Found some time and found a few more things to fix. Need sort on length, need to check for 7.5 & 7.50, fix ID number. So will be back. Please let me know if that is what your looking for that is important. Also fixed number of decimals to 2 for all lengths 8m becomes 8.00m 8.5 now 8.50. In both beams and table.

Am I in some sort of parallel universe were questions from 16 years ago are answered with 1 liners?

Kenny Ramage here. (AfraLisp) Semi retired now but would like to help out especially with the basics.

Still have your Lisp Tutorial and compiled HTML Help files from 1999, but no longer working like they used to! I'll be semi-retired this time next year and surfing forums when I start missing this career I dedicated most of my life to.

I knew I recognized that name somewhere! Afralisp has been a life saver. Genuine legend for setting that up initially.

So it was hiding behind the AutoCAD window.