Nikon Posted 9 hours ago Author Posted 9 hours ago 11 hours ago, Steven P said: Edited: See if this works. I have put the other routines as sub routines (LM:Unformat and DoUnformatTable). Changed the text modifying about so it uses entmod instead of vla (personal preference) Try it and see if it works - if it does then the unformat part (Lee Macs) is working as expected (it usually does) and there is something you'll be wanting to look at in the code you added. @Steven P thanks. I ran your code, but unfortunately the mtexts were deleted again. Quote
GLAVCVS Posted 7 hours ago Posted 7 hours ago This is an interesting topic. I edited my code to recursively search any file loaded with 'load' at all nesting levels. Try it. On 8/16/2025 at 8:16 PM, GLAVCVS said: I've modified the code so that it also analyzes the files loaded from the profile. ;******************* p o r d e s í a r g o ******************** ;************************ G L A V C V S ************************* ;************************** F E C I T *************************** (defun c:buscaDefunsRepets (/ lstLsps arch nmarch linea lst as nbref separa<->palabras lstDefuns lstRepets tit i dale path escrutArch) (defun separa<->palabras (tx lstCtrs / c p l) (foreach c (vl-string->list tx) (if (member (setq c (chr c)) lstCtrs) (if p (setq l (cons (strcase p T) l) p nil)) (setq p (if p (strcat p c) c)) ) ) (reverse (if p (cons (strcase p T) l) l)) ) (defun escrutArch (nmarch / arch linea lst as nbref dale mirExtens) (defun mirExtens (nmarch) (if (not (wcmatch nmarch "*[.]@@@")) (strcat nmarch ".lsp") nmarch ) ) (if (and (setq nmarch (findfile (mirExtens nmarch))) (setq arch (open nmarch "r"))) (while (setq linea (read-line arch)) (cond ((and (wcmatch linea "*(defun *") (not (wcmatch linea "*\"(defun *,*\"*(defun [*] *,*\"*(defun [*]\"*"))) (setq lst (separa<->palabras linea '(" " "(" "\"")) pos (vl-position "defun" lst) nbref (nth (1+ pos) lst) ) (if lstDefuns (if (not (vl-some ; comprobamos cada defun acumulada '(lambda (v) (if (and (= (car v) nbref) (/= nbref "defun")); si la defun recien leída coincide con alguna de las encontradas anteriormente (if (setq lr (assoc nbref lstRepets)) (setq lstRepets (subst (append lr (list nmarch)) lr lstRepets)) (setq lstRepets (append lstRepets (list (append v (list nmarch))))) ) ) ) lstDefuns ) ) (setq lstDefuns (append lstDefuns (list (list nbref nmarch)))) ) (setq lstDefuns (append lstDefuns (list (list nbref nmarch)))) ) ) ((wcmatch linea "*(load *\")*") (setq lst (separa<->palabras linea '(" " "(" "\""))) (foreach v lst (if dale (setq dale (if (and (not (member (strcase v T) (list "acad2021.lsp" "acad2021doc.lsp"))) (or (= (length (setq lst1 (separa<->palabras v '(".")))) 1) (member (strcase (cadr lst1) T) extens) ) ) (escrutArch v) ) dale nil ) (if (= (strcase v T) "load") (setq dale T) ) ) ) ) ) ) ) (if arch (close arch)) ) (setq lstLsps (list "acad2021.lsp" "acad2021doc.lsp" "acadddd.lsp") extens '("lsp")) (foreach lsp lstLsps (if (and (findfile lsp) (setq arch (open (setq nmarch (findfile lsp)) "r"))) (escrutArch nmarch) ) ) (if arch (close arch)) (setq i 0) (while (setq nmarch (vl-registry-read (strcat "HKEY_CURRENT_USER\\" (vlax-product-key) "\\Profiles\\" (getvar "CPROFILE") "\\Dialogs\\Appload\\Startup") (strcat (itoa (setq i (1+ i))) "StartUp"))) (escrutArch nmarch) ) (if lstRepets (if (setq arch (open (setq nmarch (strcat (VL-REGISTRY-READ "HKEY_CURRENT_USER\\Software\\Microsoft\\Windows\\CurrentVersion\\Explorer\\Shell Folders" "Personal") "\\informe.txt")) "w")) (foreach lr lstRepets (princ (strcat (if (not tit) (setq tit "FUNCTIONS DEFINED MULTIPLE TIMES:\n") "") "\n Function NAME \'" (car lr) "\' in:\n") arch) (foreach path (cdr lr) (princ (strcat "\t" path "\n") arch) ) ) ) ) (if arch (progn (close arch) (startapp "notepad" nmarch))) (princ) ) If after trying this nothing different comes out, then the problem isn't due to overlapping code. In that case, I would look at the system variables and any reactors your LISPs generate when loading. However, reviewing your explanation of the problem, I checked the MTEXT entity lists and saw that it forces the font to change to ISOCTEUR or SIMPLEX. I don't think these fonts support Cyrillic. Perhaps for this reason, when trying to replace the codes, it returns an empty string, which AutoCAD interprets as deleting the MTEXT. 1 Quote
Nikon Posted 7 hours ago Author Posted 7 hours ago 22 minutes ago, GLAVCVS said: However, reviewing your explanation of the problem, I checked the MTEXT entity lists and saw that it forces the font to change to ISOCTEUR or SIMPLEX. I don't think these fonts support Cyrillic. Perhaps for this reason, when trying to replace the codes, it returns an empty string, which AutoCAD interprets as deleting the MTEXT. There is no problem with fonts. I can't understand why this UNFORMAT.lsp works for me in Autocad 2019, but not in Autocad 2021. I have another code that works in Autocad 2021, but it has slightly fewer functions. ;; UNFORMAT.LSP (c)2003, John F. Uhden, Cadlantic/CADvantage ;; v1.0 (04-01-03) ;; Removes MTEXT formatting with option to retain the "\\P" LineFeeds ;; ;; Rev. (05-09-05) (defun C:UNFORMAT_W ( / vars vals ss i e ans KeepLF) ;; v2.0 (3-15-2023) added MLeaders to qualified objects (gc) (vl-load-com) (prompt "\nUNFORMAT.LSP v2.0 (c)2005-23, John F. Uhden") (or *acad* (setq *acad* (vlax-get-acad-object))) (or *doc* (setq *doc* (vla-get-ActiveDocument *acad*))) (defun *error* (error) (mapcar 'setvar vals vars) (vla-endundomark *doc*) (cond ((not error)) ((wcmatch (strcase error) "*QUIT*,*CANCEL*")) (1 (princ (strcat "\nERROR: " error)) ) ) (princ) ) ;;-------------------------------------------- ;; Intitialize drawing and program variables: ;; (setq vars '("cmdecho")) (setq vals (mapcar 'getvar vars)) (mapcar 'setvar vars '(0)) (vla-startundomark *doc*) (command ".expert" (getvar "expert")) ;; dummy command (defun @UnFormat (Mtext KeepLF / -Old -New -Tmp -Str) (cond ((= (type Mtext) 'VLA-Object)) ((= (type Mtext) 'Ename) (setq Mtext (vlax-ename->vla-object Mtext)) ) (1 (setq Mtext nil)) ) (if (= KeepLF 0)(setq KeepLF nil)) (and Mtext (or (= (vlax-get Mtext 'ObjectName) "AcDbMText") (= (vlax-get Mtext 'ObjectName) "AcDbMLeader") ) (setq Old (vlax-get Mtext 'TextString)) (setq Tmp Old) (setq New "") (while (/= Tmp "") (cond ((wcmatch (strcase (setq Str (substr Tmp 1 2))) "\\[\\{}`~]") (setq Tmp (substr Tmp 3) New (strcat New Str) ) ) ((wcmatch (substr Tmp 1 1) "[{}]") (setq Tmp (substr Tmp 2)) ) ((and KeepLF (wcmatch (strcase (substr Tmp 1 2)) "\\P")) (setq New (strcat New (substr Tmp 1 2)) Tmp (substr Tmp 3) ) ) ;; added "\n" (03-03-08) ((and KeepLF (wcmatch (strcase (substr Tmp 1 1)) "\N")) (setq New (strcat New (substr Tmp 1 1)) Tmp (substr Tmp 2) ) ) ((wcmatch (strcase (substr Tmp 1 2)) "\\[LOP]") (setq Tmp (substr Tmp 3)) ) ((wcmatch (strcase (substr Tmp 1 2)) "\\[ACFHQSTW]") (setq Tmp (substr Tmp (+ 2 (vl-string-search ";" Tmp)))) ) (1 (setq New (strcat New (substr Tmp 1 1)) Tmp (substr Tmp 2) ) ) ) ) (/= Old New) (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-put (list Mtext 'TextString New) ) ) ) ) ) ;; Begin the action: (and (setq ss (ssget '((0 . "MTEXT,MULTILEADER")))) (or (initget "Yes No") 1) (or (setq ans (getkword "\nRetain line feeds? <Yes>/No: ")) (setq ans "Yes") ) (setq KeepLF (if (/= ans "Yes") 0 1)) (repeat (setq i (sslength ss)) (setq e (ssname ss (setq i (1- i)))) (@unformat e KeepLF) ) ) (*error* nil) ) (defun C:UF_W ()(C:UNFORMAT_W)) Quote
Steven P Posted 7 hours ago Posted 7 hours ago Try this, taking away the text modification part: It should put the original text + format codes one one command line, and the next unformatted, see if it gets that far. It won't change any of the drawing. (defun c:UNFORMAT ( / ss ssl cnt en xxobj otyp txr ntx MyText) ;;;;;;;;;;;;; mAssoc;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun mAssoc ( key lst / result ) ;; Lee Mac (foreach x lst (if (= key (car x)) (setq result (cons (cdr x) result)) ) ) (reverse result) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; UnFormat MText, MLeader, Table - strip formatting contol codes from texts ; ; based on Lee Mac's UnFormat string - www.lee-mac.com/unformatstring.html ; CAD Studio, 2018, www.cadstudio.cz www.cadforum.cz ; ; (vl-load-com) ;;-------------------=={ UnFormat String }==------------------;; ;; ;; ;; Returns a string with all MText formatting codes removed. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; str - String to Process ;; ;; mtx - MText Flag (T if string is for use in MText) ;; ;;------------------------------------------------------------;; ;; Returns: String with formatting codes removed ;; ;;------------------------------------------------------------;; ;;SP ASSUMING LEE MAC PART WORKS. IT USUALLY DOES. (defun LM:UnFormat ( str mtx / _replace rx ) (defun _replace ( new old str ) (vlax-put-property rx 'pattern old) (vlax-invoke rx 'replace str new) ) (if (setq rx (vlax-get-or-create-object "VBScript.RegExp")) (progn (setq str (vl-catch-all-apply (function (lambda ( ) (vlax-put-property rx 'global actrue) (vlax-put-property rx 'multiline actrue) (vlax-put-property rx 'ignorecase acfalse) (foreach pair '( ("\032" . "\\\\\\\\") (" " . "\\\\P|\\n|\\t") ("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]") ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);") ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}") ("$1" . "[\\\\]({)|{") ) (setq str (_replace (car pair) (cdr pair) str)) ) (if mtx (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str)) (_replace "\\" "\032" str) ) ) ) ) ) (vlax-release-object rx) (if (null (vl-catch-all-error-p str)) str ) ) ) ) ;; End LM:Unformat ;----------------- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun doUnformatTable (table / rowCounter colCounter) (setq rowCounter (vla-Get-Rows table)) (repeat rowCounter (setq rowCounter (1- rowCounter)) (setq colCounter (vla-Get-Columns table)) (repeat colCounter (setq colCounter (1- colCounter)) (setq cellType (vla-GetCellType table rowCounter colCounter)) (if (= cellType acTextCell)(progn (setq cellText (vla-GetText table rowCounter colCounter)) (if (/= cellText "") (vla-SetText table rowCounter colCounter (LM:UnFormat cellText T))) )) ; end if, end if ) ; rep ) ; rep ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; End Sub routines (princ "\nSelect MTEXTs/DIMENSIONs/MLEADERs/TABLEs: ") (setq ss (ssget '((0 . "MTEXT,DIMENSION,MULTILEADER,ACAD_TABLE")))) (if ss (progn (setq acount 0) (while (< acount (sslength ss)) (setq ed (ssname ss acount)) (if (or (equal (assoc 0 (entget ed)) '(0 . "MTEXT")) (equal (assoc 0 (entget ed)) '(0 . "DIMENSION")) (equal (assoc 0 (entget ed)) '(0 . "MULTILEADER")) ) ; endor (progn (setq Mytexts (mAssoc 1 (entget ed))) (foreach n Mytexts ;; (entmod (subst (cons 1 (lm:Unformat n T)) (cons 1 n) (entget ed)) ) (princ "\n")(princ "\n")(princ n)(princ "\n")(princ (lm:Unformat n T)) ) ;; (setq Mytexts (mAssoc 3 (entget ed))) ;; extend mtexts ;; (foreach n Mytexts ;; (entmod (subst (cons 3 (lm:Unformat n T)) (cons 3 n) (entget ed)) ) ;; ) ) ; end progn mtext (progn ; tables ((= otyp "ACAD_TABLE")(doUnformatTable (vlax-ename->vla-object ed))) ; AcDbTable ) ) (setq acount (+ acount 1)) ) ; end while ) ; end progn, ss ) ; end if ss ) 1 Quote
Nikon Posted 7 hours ago Author Posted 7 hours ago 9 minutes ago, Steven P said: Try this, taking away the text modification part: It should put the original text + format codes one one command line, and the next unformatted, see if it gets that far. It won't change any of the drawing. The following text is output to the command line: {\fISOCPEUR|b0|i0|c204|p34;This code does not work in Autocad 2021 (localized version), the selected MText is being deleted.} {\Fsimplex|c204;This code does not work in Autocad 2021 (localized version), the selected MText is being deleted.} 2 Quote
Nikon Posted 6 hours ago Author Posted 6 hours ago 56 minutes ago, GLAVCVS said: However, reviewing your explanation of the problem, I checked the MTEXT entity lists and saw that it forces the font to change to ISOCTEUR or SIMPLEX. I don't think these fonts support Cyrillic. Perhaps for this reason, when trying to replace the codes, it returns an empty string, which AutoCAD interprets as deleting the MTEXT. @GLAVCVS Maybe you're right about the fonts. If you replace the font in the text editor with Standard or Arial, the text will remain without control codes. Quote
Steven P Posted 6 hours ago Posted 6 hours ago Just a thought then, has the text gone really really small so you cannot see it at that zoom level? Some fonts when you change them do that. "select" "all" should find them if they are like that Quote
Nikon Posted 5 hours ago Author Posted 5 hours ago (edited) 1 hour ago, Steven P said: Just a thought then, has the text gone really really small so you cannot see it at that zoom level? Some fonts when you change them do that. "select" "all" should find them if they are like that @Steven PYour assumption is correct.However, it is not possible to highlight the text using a frame. You can only use the keyboard shortcut ctrl A. But the content of the texts is not displayed in the properties... This means that the texts are not deleted, but are transformed into empty text objects. If you call the Purge command, the "Delete empty texts" function becomes active. Edited 4 hours ago by Nikon Quote
SLW210 Posted 5 hours ago Posted 5 hours ago Did you reset AutoCAD to defaults as I suggested a long time ago? 1 Quote
Steven P Posted 4 hours ago Posted 4 hours ago So we can force the height to be something like this - just as an example for your sample drawings above, see if it makes your text visible again (defun c:UNFORMAT ( / ss ssl cnt en xxobj otyp txr ntx MyText) ;;;;;;;;;;;;; mAssoc;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun mAssoc ( key lst / result ) ;; Lee Mac (foreach x lst (if (= key (car x)) (setq result (cons (cdr x) result)) ) ) (reverse result) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; UnFormat MText, MLeader, Table - strip formatting contol codes from texts ; ; based on Lee Mac's UnFormat string - www.lee-mac.com/unformatstring.html ; CAD Studio, 2018, www.cadstudio.cz www.cadforum.cz ; ; (vl-load-com) ;;-------------------=={ UnFormat String }==------------------;; ;; ;; ;; Returns a string with all MText formatting codes removed. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; str - String to Process ;; ;; mtx - MText Flag (T if string is for use in MText) ;; ;;------------------------------------------------------------;; ;; Returns: String with formatting codes removed ;; ;;------------------------------------------------------------;; ;;SP ASSUMING LEE MAC PART WORKS. IT USUALLY DOES. (defun LM:UnFormat ( str mtx / _replace rx ) (defun _replace ( new old str ) (vlax-put-property rx 'pattern old) (vlax-invoke rx 'replace str new) ) (if (setq rx (vlax-get-or-create-object "VBScript.RegExp")) (progn (setq str (vl-catch-all-apply (function (lambda ( ) (vlax-put-property rx 'global actrue) (vlax-put-property rx 'multiline actrue) (vlax-put-property rx 'ignorecase acfalse) (foreach pair '( ("\032" . "\\\\\\\\") (" " . "\\\\P|\\n|\\t") ("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]") ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);") ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}") ("$1" . "[\\\\]({)|{") ) (setq str (_replace (car pair) (cdr pair) str)) ) (if mtx (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str)) (_replace "\\" "\032" str) ) ) ) ) ) (vlax-release-object rx) (if (null (vl-catch-all-error-p str)) str ) ) ) ) ;; End LM:Unformat ;----------------- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun doUnformatTable (table / rowCounter colCounter) (setq rowCounter (vla-Get-Rows table)) (repeat rowCounter (setq rowCounter (1- rowCounter)) (setq colCounter (vla-Get-Columns table)) (repeat colCounter (setq colCounter (1- colCounter)) (setq cellType (vla-GetCellType table rowCounter colCounter)) (if (= cellType acTextCell)(progn (setq cellText (vla-GetText table rowCounter colCounter)) (if (/= cellText "") (vla-SetText table rowCounter colCounter (LM:UnFormat cellText T))) )) ; end if, end if ) ; rep ) ; rep ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; End Sub routines (princ "\nSelect MTEXTs/DIMENSIONs/MLEADERs/TABLEs: ") (setq ss (ssget '((0 . "MTEXT,DIMENSION,MULTILEADER,ACAD_TABLE")))) (if ss (progn (setq acount 0) (while (< acount (sslength ss)) (setq ed (ssname ss acount)) (if (or (equal (assoc 0 (entget ed)) '(0 . "MTEXT")) (equal (assoc 0 (entget ed)) '(0 . "DIMENSION")) (equal (assoc 0 (entget ed)) '(0 . "MULTILEADER")) ) ; endor (progn (setq Mytexts (mAssoc 1 (entget ed))) (foreach n Mytexts (entmod (subst (cons 1 (lm:Unformat n T)) (cons 1 n) (entget ed)) ) ) (setq Mytexts (mAssoc 3 (entget ed))) ;; extend mtexts (foreach n Mytexts (entmod (subst (cons 3 (lm:Unformat n T)) (cons 3 n) (entget ed)) ) ) (setq Mytexts (mAssoc 40 (entget ed))) ;; extend mtexts (foreach n Mytexts (entmod (subst (cons 40 25) (cons 40 n) (entget ed)) ) ) ) ; end progn mtext (progn ; tables ((= otyp "ACAD_TABLE")(doUnformatTable (vlax-ename->vla-object ed))) ; AcDbTable ) ) (setq acount (+ acount 1)) ) ; end while ) ; end progn, ss ) ; end if ss ) 1 Quote
Nikon Posted 4 hours ago Author Posted 4 hours ago 12 minutes ago, Steven P said: So we can force the height to be something like this - just as an example for your sample drawings above, see if it makes your text visible again No, empty texts again... Quote
Nikon Posted 4 hours ago Author Posted 4 hours ago (edited) 57 minutes ago, SLW210 said: Did you reset AutoCAD to defaults as I suggested a long time ago? as I suggested a long time ago? If I reset the AutoCAD settings to the default values and then add my custom settings again, will the error happen again? It doesn't seem to me to be related to user settings. I use a lot of codes, and they all work flawlessly. Edited 4 hours ago by Nikon Quote
GLAVCVS Posted 1 hour ago Posted 1 hour ago Paste this function into your code. (defun supriFMT (tx / rtx separa<->palabras) (defun separa<->palabras (tx lstCtrs / c p l) (foreach c (vl-string->list tx) (if (member (setq c (chr c)) lstCtrs) (if p (setq l (cons p l) p nil)) (setq p (if p (strcat p c) c)) ) ) (reverse (if p (cons p l) l)) ) (foreach v (separa<->palabras tx '(";" "{" "}" )) (if (not (wcmatch v "\\*")) (setq rtx (strcat (if rtx rtx "") (car (separa<->palabras v '("\\" ))))) ) ) ) Then replace 'LM:UnFormat' with 'supriFMT' inside the '((= otyp "MTEXT")' clause. 1 Quote
GLAVCVS Posted 1 hour ago Posted 1 hour ago I don't know if the format used in the other LM:UnFormat objects is the same as in MTEXT. Therefore, this function is, in principle, only valid for MTEXT. Quote
GLAVCVS Posted 1 hour ago Posted 1 hour ago PS: You should also remove the T argument from the call to 'supriFMT'. 1 Quote
Nikon Posted 1 hour ago Author Posted 1 hour ago 16 minutes ago, GLAVCVS said: Then replace 'LM:UnFormat' with 'supriFMT' inside the '((= otyp "MTEXT")' clause. ; UnFormat MText, MLeader, Table - strip formatting contol codes from texts ; ; based on Lee Mac's UnFormat string - www.lee-mac.com/unformatstring.html ; CAD Studio, 2018, www.cadstudio.cz www.cadforum.cz ; ; (vl-load-com) ;;-------------------=={ UnFormat String }==------------------;; ;; ;; ;; Returns a string with all MText formatting codes removed. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; str - String to Process ;; ;; mtx - MText Flag (T if string is for use in MText) ;; ;;------------------------------------------------------------;; ;; Returns: String with formatting codes removed ;; ;;------------------------------------------------------------;; (defun supriFMT (tx / rtx separa<->palabras) (defun separa<->palabras (tx lstCtrs / c p l) (foreach c (vl-string->list tx) (if (member (setq c (chr c)) lstCtrs) (if p (setq l (cons p l) p nil)) (setq p (if p (strcat p c) c)) ) ) (reverse (if p (cons p l) l)) ) (foreach v (separa<->palabras tx '(";" "{" "}" )) (if (not (wcmatch v "\\*")) (setq rtx (strcat (if rtx rtx "") (car (separa<->palabras v '("\\" ))))) ) ) ) (defun LM:UnFormat ( str mtx / _replace rx ) (defun _replace ( new old str ) (vlax-put-property rx 'pattern old) (vlax-invoke rx 'replace str new) ) (if (setq rx (vlax-get-or-create-object "VBScript.RegExp")) (progn (setq str (vl-catch-all-apply (function (lambda ( ) (vlax-put-property rx 'global actrue) (vlax-put-property rx 'multiline actrue) (vlax-put-property rx 'ignorecase acfalse) (foreach pair '( ("\032" . "\\\\\\\\") (" " . "\\\\P|\\n|\\t") ("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]") ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);") ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}") ("$1" . "[\\\\]({)|{") ) (setq str (_replace (car pair) (cdr pair) str)) ) (if mtx (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str)) (_replace "\\" "\032" str) ) ) ) ) ) (vlax-release-object rx) (if (null (vl-catch-all-error-p str)) str ) ) ) ) ;----------------- (defun doUnformatTable (table / rowCounter colCounter) (setq rowCounter (vla-Get-Rows table)) (repeat rowCounter (setq rowCounter (1- rowCounter)) (setq colCounter (vla-Get-Columns table)) (repeat colCounter (setq colCounter (1- colCounter)) (setq cellType (vla-GetCellType table rowCounter colCounter)) (if (= cellType acTextCell)(progn (setq cellText (vla-GetText table rowCounter colCounter)) (if (/= cellText "") (vla-SetText table rowCounter colCounter (LM:UnFormat cellText T))) )) ) ; rep ) ; rep ) (defun c:UNFORMAT_FMT (/ ss ssl cnt en xxobj otyp txr ntx) (princ "\nSelect MTEXTs/DIMENSIONs/MLEADERs/TABLEs: ") (setq ss (ssget '((0 . "MTEXT,DIMENSION,MULTILEADER,ACAD_TABLE")))) (if (and ss (> (setq ssl (sslength ss)) 0))(progn (setq cnt 0) (repeat ssl ; (setq en (ssname ss cnt)) (setq en (ssname ss cnt)) ex en ;? (setq obj (vlax-ename->vla-object en)) (setq otyp (cdr (assoc 0 (entget en)))) ; (vla-get-objectname obj)) (cond ((= otyp "MTEXT")(vla-put-TextString obj (supriFMT (vla-get-TextString obj) T))) ; AcDbMText ((= otyp "DIMENSION")(vla-put-TextOverride obj (LM:UnFormat (vla-get-TextOverride obj) T))) ; AcDbRotatedDimension, AcDbAlignedDimension ((= otyp "MULTILEADER")(vla-put-TextString obj(LM:UnFormat (vla-get-TextString obj) T))) ; AcDbMLeader ((= otyp "ACAD_TABLE")(doUnformatTable obj)) ; AcDbTable ) (setq cnt (1+ cnt)) ) ;rep ) (princ "\nNothing selected!") ) ;if (princ) ) (princ "\nUNFORMAT loaded.") (princ) error: too many arguments 8 minutes ago, GLAVCVS said: You should also remove the T argument from the call to 'supriFMT'. ??? Quote
Steven P Posted 1 hour ago Posted 1 hour ago (supriFMT (vla-get-TextString obj) T) becomes (supriFMT (vla-get-TextString obj) ) 1 1 Quote
GLAVCVS Posted 1 hour ago Posted 1 hour ago The 'T' argument in the call to 'supriFMT' is unnecessary. That's why it returns 'too many arguments'. You should delete it. Find the line where you replaced LM:UnFormat with SupriFMT and notice there's a 'T': you should delete it. 1 Quote
Nikon Posted 1 hour ago Author Posted 1 hour ago 6 minutes ago, GLAVCVS said: The 'T' argument in the call to 'supriFMT' is unnecessary. That's why it returns 'too many arguments'. You should delete it. Find the line where you replaced LM:UnFormat with SupriFMT and notice there's a 'T': you should delete it. ((= otyp "MTEXT")(vla-put-TextString obj (supriFMT (vla-get-TextString obj)) ; error: incorrectly generated list at the entrance Quote
GLAVCVS Posted 1 hour ago Posted 1 hour ago (edited) Write before (vla-put-textstring obj (vla-get-TextString obj)) this: (print (vla-get-TextString obj)), load it, run it and share a screenshot of what happened on the command line PS: Also make sure you've closed all the parentheses in your Lisp expression: your last message seems to be missing a closing parenthesis. Edited 55 minutes ago by GLAVCVS 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.