Lisp To Select Multiple Text and MText Values Entered

May 28

Bonjour, super merci pour tous vos programmes, mais aucun ne sélectionne automatiquement tous les textes et multi textes lorsque ce que je tape le nom de la commande.

Rien ne se passe

May 28

Pour mon information , qu'est ce que veut dire " utiliser un caractère générique dans « ssget »,* "?

May 28

5 hours ago, Juan440 said:

Pour mon information , qu'est ce que veut dire " utiliser un caractère générique dans « ssget »,* "?

So a wildcard - caractere generique - is a modifier added to some text that some functions use to do other things.

In this case '*' is a wild card meaning any other characters, a string of characters or non at all:

"*text" will find 'Text' and also 'mtext'.

Here is a better (English Language) description than I can write with the different wildcards listed

https://help.autodesk.com/view/OARX/2023/ENU/?guid=GUID-EC257AF7-72D4-4B38-99B6-9B09952A53AD

In my examples above you can generally replace 'mtext' with '*text' to select both forms (and also rtext which is rarely used I think)

For example

(setq MySS (ssget (list (cons 0 "MTEXT")(cons 1 (strcat "*" MyText "*")))))

Can be to capture both types of text

(setq MySS (ssget (list (cons 0 "*TEXT")(cons 1 (strcat "*" MyText "*")))))

To automatically select all the texts in the page you can change (ssget (list (.... or (ssget '(( to add a modifier to the function, for everything add '_X'

(setq MySS (ssget "_X" (list (cons 0 "*TEXT")(cons 1 (strcat "*" MyText "*")))))

Again a link with a better description and more modfiers:

https://lee-mac.com/ssget.html

June 3

Bonjour, ok merci, je comprend mieux.

Mais comme je n'ai jamais fait de programmation, c'est un peu compliqué pour moi. Je ne fais que charger des lisps.

Quand je charge la commande "test" que tu m'a envoyée, les *textes ne sont pas sélectionnés. il me demande de sélectionner un mtext mais rien ne se passe.

il me demande de sélectionner un mtext mais rien ne se passe. Qu'est ce que je ne fais pas ?

June 4

Your not very clear on what you want.

You might also mention what you want to do with the selection.

I hope @Steven P doesn't mind, I adapted his code to type in the search parameters.

See if this is what you want?

;;; Select all the matching texts/mtexts of the file at the same time.
;;;
;;; https://www.cadtutor.net/forum/topic/74112-lisp-to-select-multiple-text-and-mtext-values-entered/#findComment-671522
;;;
;;; By Steven P
;;;
;;; SLW210 (a.k.a. Steve Wilson) Changed original to add typed in selection for search.
;;;
;;; https://www.cadtutor.net/forum/topic/74112-lisp-to-select-multiple-text-and-mtext-values-entered/page/2/#findComment-672082
;;;

(defun c:SATM ( / MyEnt MyText MySS FinalSS acount EntData txtString )
  ;; Prompt for search string instead of selecting a MTEXT entity
  (setq MyText (getstring T "\nEnter text to search for: "))

  ;; Select all TEXT and MTEXT entities in the drawing
  (setq MySS (ssget "X" '((0 . "TEXT,MTEXT"))))

  ;; Create an empty selection set for matched entities
  (setq FinalSS (ssadd))
  (setq acount 0)

  ;; Loop through all entities and match their text content
  (while (< acount (sslength MySS))
    (setq MyEnt (ssname MySS acount))
    (setq EntData (entget MyEnt))
    (setq txtString (strcase (cond 
                               ((cdr (assoc 1 EntData))) ; TEXT or MTEXT first part
                               ((cdr (assoc 3 EntData))) ; Additional MTEXT
                             )))

    (if (and txtString (wcmatch txtString (strcat "*" (strcase MyText) "*")))
      (setq FinalSS (ssadd MyEnt FinalSS))
    )
    (setq acount (1+ acount))
  )

  ;; Optional: highlight matching entities
  (if (> (sslength FinalSS) 0)
    (progn
      (sssetfirst nil FinalSS)
      (princ (strcat "\nFound " (itoa (sslength FinalSS)) " matching entities."))
    )
    (princ "\nNo matching text found.")
  )

;; do what you want here with found texts

  (princ)
)

June 4

34 minutes ago, SLW210 said:

I hope @Steven P doesn't mind, I adapted his code to type in the search parameters.

That's no problem - if it helps everyone out then all is good.

June 4

I had use for this...still modifying for my needs with options added.

Thanks for the start!

June 4

Updated with DCL and some options, I have other options to add, but for now this is it.

All credit to @Steven P and others on this thread and elsewhere, still reading up on doing the rest of mods.

I am sure this could be cleaner...

If you leave the search blank, it gets all Text/MText

;;; Select all the matching texts/mtexts of the file at the same time, option to CopyClip, export to CSV/Txt, change color or delete.
;;;
;;; https://www.cadtutor.net/forum/topic/74112-lisp-to-select-multiple-text-and-mtext-values-entered/#findComment-671522
;;;
;;; By Steven P
;;;
;;; SLW210 (a.k.a. Steve Wilson) Changed original to add typed in selections for search and added options by DCL.
;;;
;;; https://www.cadtutor.net/forum/topic/74112-lisp-to-select-multiple-text-and-mtext-values-entered/page/2/#findComment-672088
;;;

;; Clean up MText for exporting
;__________________________________________________________________________________________________
(defun decode-unicode (txt / pos code chr) 
  (while (setq pos (vl-string-search "\\U+" txt)) 
    (setq code (substr txt (+ pos 3) 4))
    (setq chr (chr (atoi (strcat "16#" code))))
    (setq txt (vl-string-subst chr (substr txt pos 8) txt))
  )
  txt
)

(defun clean-mtext (txt / pos start end) 
  (while (setq pos (vl-string-search "{\\" txt)) 
    (setq txt (vl-string-subst "" 
                               (substr txt 
                                       pos
                                       (- (1+ (vl-string-search ";" txt pos)) pos)
                               )
                               txt
              )
    )
  )
  ;; Remove formatting codes
  (setq pos 0)
  (while (setq pos (vl-string-search "\\" txt pos)) 
    (setq start pos)
    (setq end (vl-string-search ";" txt pos))
    (if end 
      (progn 
        (setq txt (vl-string-subst "" (substr txt start (1+ (- end start))) txt))
      )
      (setq pos (1+ pos))
    )
  )
  ;; Remove braces }
  (setq txt (vl-string-subst "" "}" txt))
  ;; Replace \P with newline (optional)
  (setq txt (vl-string-subst "\n" "\\P" txt))
  ;; Decode unicode escapes
  (decode-unicode txt)
)


;; DCL starts here, modify as you prefer
(defun write-embedded-dcl (/ dclfile f) 
  (setq dclfile (vl-filename-mktemp "satm.dcl"))
  (setq *satm_dcl_path* dclfile) ;; store globally for loading

  (setq f (open dclfile "w"))
  (if f 
    (progn 
      (foreach line 
        '("satm : dialog {" "  label = \"Select Action for Matching Text\";" 
          "  : edit_box {" "    label = \"Search Text:\";" "    key = \"search\";" 
          "    edit_width = 40;" "  }" 
          "  : toggle { label = \"Change Color\"; key = \"chgcolor\"; }" 
          "  : toggle { label = \"Delete Entities\"; key = \"delete\"; }" 
          "  : toggle { label = \"Export to TXT\"; key = \"txt\"; }" 
          "  : toggle { label = \"Export to CSV\"; key = \"csv\"; }" 
          "  : toggle { label = \"Copy to Clipboard\"; key = \"clip\"; }" 
          "  : edit_box { label = \"Color Index (1–255):\"; key = \"color\"; edit_width = 8; }" 
          "  : spacer { height = 1; }" "  : row {" 
          "    : button { label = \"OK\"; is_default = true; key = \"accept\"; }" 
          "    : button { label = \"Cancel\"; is_cancel = true; key = \"cancel\"; }" 
          "  }" "}"
         )
        (write-line line f)
      )
      (close f)
      dclfile
    )
    (progn 
      (prompt "\nError writing DCL file.")
      nil
    )
  )
)

;; Main code starts here 
(defun c:SATM (/ dclfile dcl_id search chgcolor delete exporttxt exportcsv clip color 
               MySS FinalSS acount MyEnt EntData txtString filePath f tempfile
              ) 
  ;; Write DCL and load
  (setq dclfile (write-embedded-dcl))
  (if (and dclfile (setq dcl_id (load_dialog dclfile))) 
    (progn 
      (if (not (new_dialog "satm" dcl_id)) 
        (progn (unload_dialog dcl_id) (princ "\nFailed to create dialog.") (exit))
      )
    )
    (progn (prompt "\nFailed to load dialog.") (exit))
  )

  ;; Defaults
  (set_tile "color" "1")

  ;; Dialog actions
  (action_tile "accept" 
               "(progn
      (setq search (get_tile \"search\"))
      (setq chgcolor (= (get_tile \"chgcolor\") \"1\"))
      (setq delete (= (get_tile \"delete\") \"1\"))
      (setq exporttxt (= (get_tile \"txt\") \"1\"))
      (setq exportcsv (= (get_tile \"csv\") \"1\"))
      (setq clip (= (get_tile \"clip\") \"1\"))
      (setq color (atoi (get_tile \"color\")))
      (done_dialog 1)
    )"
  )
  (action_tile "cancel" "(done_dialog 0)")

  ;; Start dialog, exit if canceled
  (if (/= (start_dialog) 1) 
    (progn (unload_dialog dcl_id) (princ "\nCanceled.") (exit))
  )
  (unload_dialog dcl_id)

  ;; Select all TEXT and MTEXT
  (setq MySS (ssget "X" '((0 . "TEXT,MTEXT"))))
  (if (not MySS) 
    (progn (princ "\nNo TEXT or MTEXT found.") (exit))
  )

  (setq FinalSS (ssadd))
  (setq acount 0)

  ;; Filter matching entities
  (while (< acount (sslength MySS)) 
    (setq MyEnt (ssname MySS acount))
    (setq EntData (entget MyEnt))
    (setq txtString (cond 
                      ((assoc 1 EntData) (cdr (assoc 1 EntData)))
                      ((assoc 3 EntData) (cdr (assoc 3 EntData)))
                      (T "")
                    )
    )
    (if 
      (and txtString 
           (wcmatch (strcase txtString) (strcat "*" (strcase search) "*"))
      )
      (setq FinalSS (ssadd MyEnt FinalSS))
    )
    (setq acount (1+ acount))
  )

  (if (= (sslength FinalSS) 0) 
    (progn (princ "\nNo matching text found.") (exit))
  )
  ;; Options start here
;__________________________________________________________________________________________________
  ;; Change Color
  (if chgcolor 
    (progn 
      (setq acount 0)
      (while (< acount (sslength FinalSS)) 
        (setq MyEnt (ssname FinalSS acount))
        (setq EntData (entget MyEnt))
        (if (assoc 62 EntData) 
          (setq EntData (subst (cons 62 color) (assoc 62 EntData) EntData))
          (setq EntData (append EntData (list (cons 62 color))))
        )
        (entmod EntData)
        (entupd MyEnt)
        (setq acount (1+ acount))
      )
      (princ (strcat "\nChanged color to " (itoa color) " for matched entities."))
    )
  )

  ;; Delete
  (if delete 
    (progn 
      (setq acount 0)
      (while (< acount (sslength FinalSS)) 
        (entdel (ssname FinalSS acount))
        (setq acount (1+ acount))
      )
      (princ "\nDeleted matched entities.")
    )
  )

  ;; Function to get cleaned text string from entity
  (defun get-clean-text (ent / data txt) 
    (setq data (entget ent))
    (setq txt (cond 
                ((assoc 1 data) (cdr (assoc 1 data)))
                ((assoc 3 data) (cdr (assoc 3 data)))
                (T "")
              )
    )
    (clean-mtext txt)
  )

  ;; Export TXT
  (if exporttxt 
    (progn 
      (setq filePath (getfiled "Save TXT As" "text_export.txt" "txt" 1))
      (if filePath 
        (progn 
          (setq f (open filePath "w"))
          (setq acount 0)
          (while (< acount (sslength FinalSS)) 
            (write-line (get-clean-text (ssname FinalSS acount)) f)
            (setq acount (1+ acount))
          )
          (close f)
          (princ (strcat "\nExported to TXT: " filePath))
        )
        (princ "\nTXT export canceled.")
      )
    )
  )

  ;; Export CSV
  (if exportcsv 
    (progn 
      (setq filePath (getfiled "Save CSV As" "text_export.csv" "csv" 1))
      (if filePath 
        (progn 
          (setq f (open filePath "w"))
          (setq acount 0)
          (while (< acount (sslength FinalSS)) 
            ;; Use semicolon separated for CSV, clean text, no headers
            (write-line (get-clean-text (ssname FinalSS acount)) f)
            (setq acount (1+ acount))
          )
          (close f)
          (princ (strcat "\nExported to CSV: " filePath))
        )
        (princ "\nCSV export canceled.")
      )
    )
  )

  ;; Copy to Clipboard
  (if clip 
    (progn 
      (setq tempfile (vl-filename-mktemp "clip.txt"))
      (setq f (open tempfile "w"))
      (setq acount 0)
      (while (< acount (sslength FinalSS)) 
        (write-line (get-clean-text (ssname FinalSS acount)) f)
        (setq acount (1+ acount))
      )
      (close f)
      ;; Copy file content to clipboard using cmd
      (startapp "cmd.exe" (strcat "/c type \"" tempfile "\" | clip"))
      (princ "\nCopied matched text to clipboard.")
    )
  )

  (princ)
)

June 5

@SLW210Just a comment I use my Multi toggles.lsp to write the dcl code. so need about 3 lines of code to do all the dcl toggle.

The answer is returned as a list of (0 1 1 0 1 1 0) etc meaning the toggle is on or off then compare that to your variables as an example (nth 0 ans) = 1 so search = (nth 0 lst) else is nil.

I also use the RLX convert dcl to lisp.lsp so just edit the multi toggles.lsp to write to a file it saves a lot of typing, then use the RLX convert and it makes the code for insertion into your lisp. Saves typo's.

.Multi toggles.lsp

June 5

I'm adding some List Box Selections among other things and working on doing these myself.

You are correct for the OPs likely uses, that would make altering the LISP for options more convenient for them.

Sign In

Lisp To Select Multiple Text and MText Values Entered

Recommended Posts

Juan440

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

mhupp

mhupp

BIGAL

Posted Images

Juan440

Steven P

Juan440

SLW210

Steven P

SLW210

SLW210

BIGAL

SLW210

Join the conversation

mhupp

mhupp

BIGAL

Tutorials

Forums

Activity