ik zoek een lisp (?) waarbij ik een x-aantal geselecteerde single-line texten kan onderlijnen. (%%u prefix geven dus)
Is dit mischien iets:
(defun c:UnderlineTextAtt (/ entdata btxt ntxt bltxt)
(command "UNDO" "BEGIN")
(while (not (setq bltxt (nentsel "\nSelect attribute or text to change: ")))
(prompt " Nothing selected, retry!\n")
);_while
(setq entdata (entget (car bltxt))
btxt (cdr (assoc 1 entdata))
ntxt (strcat "%%U" btxt )
);_setq
(entmod (subst (cons 1 ntxt)(assoc 1 entdata) entdata))
(entupd (cdr (assoc -1 entdata)))
(command "UNDO" "END")
);_defun
Groeten
Werkt goed! :)
Maar kan deze lisp worden uitgebreid met een selectievenster?
THX!
(defun c:UnderlineText ( / doc)
(vl-load-com)
(if (ssget '((0 . "TEXT") (1 . "~*%%U*"))) ; Alleen tekst zonder onderlijningen selecteren.
(progn
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(if (= (logand (getvar 'undoctl) 8) 8)
(vla-endundomark doc)
)
(vla-startundomark doc)
(vlax-for obj (vla-get-activeselectionset doc)
(vla-put-textstring obj (strcat "%%U" (vla-get-textstring obj)))
)
(vla-endundomark doc)
)
)
(princ)
)
Bedankt Roy_043!
Is er mss ook een mogelijkheid met selectievenster om reeds single-line onderlijnde texten de onderlijning weg te halen?
Grts, S.
Is dit wat je zoekt?
(defun c:UnderlineText_remove_underline ( / doc)
(if (ssget '((0 . "TEXT") (1 . "*%%U*"))) ; Alleen tekst zonder onderlijningen selecteren.
(progn
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(if (= (logand (getvar 'undoctl) 8) 8)
(vla-endundomark doc)
)
(vla-startundomark doc)
(vlax-for obj (vla-get-activeselectionset doc)
(vla-put-textstring obj (vl-string-trim "%%U" (vla-get-textstring obj)))
)
(vla-endundomark doc)
)
)
(princ)
)
Hmm. vl-string-trim gebruiken is gevaarlijk. De tekst zonder onderlijning kan immers beginnen met de hoofdletter U en die letter zal ook worden verwijderd. Verder kan "%%U" en "%%u" (klein letter u) gebruikt worden en hoeven de codes niet aan het begin van de tekst te staan.
Mijn versie:
; (String_RemoveUnderline "%%Uaaa%%ubbb") => "aaabbb"
(defun String_RemoveUnderline (str)
(while (wcmatch str "*%%[Uu]*")
(setq str (vl-string-subst "" "%%U" (vl-string-subst "" "%%u" str)))
)
str
)
(defun c:UnUnderlineText ( / doc)
(vl-load-com)
(if (ssget '((0 . "TEXT") (1 . "*%%U*"))) ; Alleen tekst met onderlijningen selecteren.
(progn
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(if (= (logand (getvar 'undoctl) 8) 8)
(vla-endundomark doc)
)
(vla-startundomark doc)
(vlax-for obj (vla-get-activeselectionset doc)
(vla-put-textstring obj (String_RemoveUnderline (vla-get-textstring obj)))
)
(vla-endundomark doc)
)
)
(princ)
)
Citaat van: roy_043 op do 18 12 2014, 12:20:41
Hmm. vl-string-trim gebruiken is gevaarlijk. De tekst zonder onderlijning kan immers beginnen met de hoofdletter U en die letter zal ook worden verwijderd. Verder kan "%%U" en "%%u" (klein letter u) gebruikt worden en hoeven de codes niet aan het begin van de tekst te staan.
...
Daar was ik ook achter gekomen.
Maar met een kleine aanpassing en toevoeging van Lee-Mac...
(defun c:Iv_UnderlineText_remove_underline ( / doc)
(if (ssget '((0 . "TEXT") (1 . "*%%U*"))) ; Alleen tekst met onderlijningen selecteren.
(progn
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(if (= (logand (getvar 'undoctl) 8) 8)
(vla-endundomark doc)
)
(vla-startundomark doc)
(vlax-for obj (vla-get-activeselectionset doc)
(vla-put-textstring obj (StringSubst "" "%%U" (vla-get-textstring obj)))
(vla-put-textstring obj (StringSubst "" "%%u" (vla-get-textstring obj)))
)
(vla-endundomark doc)
)
)
(princ)
)
;;;Bron http://www.lee-mac.com/stringsubst.html
(defun StringSubst ( new old str / inc len )
(setq len (strlen new)
inc 0
)
(while (setq inc (vl-string-search old str inc))
(setq str (vl-string-subst new old str inc)
inc (+ inc len)
)
)
str
)