Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 03/17/2019 in all areas

  1. (defun KGA_Conv_Pickset_To_ObjectList (ss / i ret) (if ss (repeat (setq i (sslength ss)) (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret)) ) ) ) (defun KGA_String_Join (strLst delim) (if strLst (apply 'strcat (cons (car strLst) (mapcar '(lambda (a) (strcat delim a)) (cdr strLst)) ) ) "" ) ) (defun KGA_String_SplitAll (str sub ignoreCaseP / i j len lst srchStr) (if (/= 0 (setq len (strlen sub))) (progn (if ignoreCaseP (progn (setq srchStr (strcase str)) (setq sub (strcase sub)) ) (setq srchStr str) ) (setq i 0) (while (setq j (vl-string-search sub srchStr i)) (setq lst (cons (substr str (1+ i) (- j i)) lst)) (setq i (+ j len)) ) (reverse (cons (substr str (1+ i)) lst)) ) ) ) (defun UpdateMtext (obj / strLst) (setq strLst (KGA_String_SplitAll (vla-get-textstring obj) "\\P" nil)) (vla-put-textstring obj (strcat "\\pxt15;" ; Tab setting. (KGA_String_Join (append (list (car strLst) (cadr strLst) ) (mapcar '(lambda (sub / lst) (strcat (last (vl-remove "NX" (KGA_String_SplitAll sub "\t" nil))) "\tNC" ) ) (cddr strLst) ) ) "\\P" ) ) ) ) (defun c:Test ( / doc ss) (setq doc (vla-get-activedocument (vlax-get-acad-object))) (vla-endundomark doc) (vla-startundomark doc) (if (setq ss (ssget '((0 . "MTEXT")))) (foreach obj (KGA_Conv_Pickset_To_ObjectList ss) (UpdateMtext obj) ) ) (vla-endundomark doc) (princ) )
    1 point
  2. @dlanorh you can use comma for the string pattern instead of the repetition of the same expression many times like this: *SEWER*,*SWR*" and you can add as many as you want.
    1 point
  3. This sort of works I need to go away and revisist, just do test and pick 1 mtext, if you pick them all does something screwy I just can not see it any one else please have a look. ; custom edit text remove some values add others ; convert mtext to list look for \\p 1st part ; then rip out anything past 1 word using tabs : BY alan H March 2019 ;(defun c:test ( / ans ss obj Y W lst nlst str x txt txtstr pos) (defun c:test ( /) (if (not AH:getvalsm)(load "Multi Getvals.lsp")) (setq ans (AH:getvalsm (list "Enter values" "Word to remove" 8 6 "NX" "Word to add" 8 6 "NC" "Lines at start" 5 4 "2"))) (setq txtstr "\\P") (setq ss (ssget (list (cons 0 "*text")))) (repeat (setq k (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss (setq k (- k 1))))) (setq txt (vla-get-textstring obj)) (setq y 1) (setq lst '()) (while (> (setq pos (vl-string-search txtstr txt)) 0) (setq str (SUBSTR TXT 1 POS )) (setq lst (cons str lst)) (Setq txt (substr txt (+ pos 3))) (princ (setq y(+ y 1))) ) (princ "\n") (setq nlst '()) (setq w 0) (setq txtstr "\t") (repeat (length lst) (setq txt (nth w lst)) (setq pos (vl-string-search txtstr txt)) (setq txt (SUBSTR TXT 1 POS )) (setq nlst (cons txt nlst)) (setq w (+ w 1)) ) (setq nlst (reverse nlst)) ( setq j 0) (setq str "") (repeat (length nlst) (setq str (strcat (nth j nlst) "\t" (nth 1 ans)"\\P" str )) (setq j (+ j 1)) ) (vla-put-textstring obj str) (princ lst) ) ) (c:test) Multi GETVALS.lsp
    1 point
×
×
  • Create New...