Leaderboard
Popular Content
Showing content with the highest reputation on 01/23/2024 in all areas
-
No problem, hoping it speeds things up a lot for you.1 point
-
Tried this, i had to add pkenewell's mxv functions, and removed the non used linebreak filters, then in works perfectly! Thanks so much !! I tried this, and it removes all linebreaks, but the "defined width" seems to be super small at the end. Like 50 instead of a 9000 long text. Thanks for this anyway Love you all!1 point
-
Wow, this is an old thread. The recursion used here will only cause problems for very large point lists, for which the stack limit may be reached (i.e. the size of the stack imposes a limit on the maximum number of recursive calls).1 point
-
Tamim, I have updated code above - not tested and no error checking.1 point
-
Likewise, I guess it will be corrected shortly.1 point
-
Try this to adjust the text box width: The parts I added aren't indented for clarity of the changes, and I borrowed some code from Lee Macs Box Text LISP. The width used is a little bit wider than the widest line in the existing text - just as a starting point. Also corrected as above for //P and /n new line references. Not corrected today anything for long text strings as discussed above (that bit wasn't working right for 500+ characters). (defun c:TxtRemCR ( / MySS SSCountMyEnt MyEntGet Mytext TextList OrderList NewText n acount) ; txt remove carriage returns ;;Sub Functions: ;;Starting with LM: Refer to Lee Macs website (defun LM:str->lst ( str del / pos ) (if (setq pos (vl-string-search del str)) (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del)) (list str) ) ) (defun LM:lst->str ( lst del ) (if (cdr lst) (strcat (car lst) del (LM:lst->str (cdr lst) del)) (car lst) ) ) ;; From Box Text LISP ;; Text Box - gile / Lee Mac ;; Returns an OCS point list describing a rectangular frame surrounding ;; the supplied text or mtext entity with optional offset ;; enx - [lst] Text or MText DXF data list ;; off - [rea] offset (may be zero) (defun text-box-off ( enx off / bpt hgt jus lst ocs org rot wid ) ;;; VXV Returns the dot product of 2 vectors (defun vxv (v1 v2) (apply '+ (mapcar '* v1 v2)) ) ;; MXV Apply a transformation matrix to a vector -Vladimir Nesterovsky- (defun mxv (m v) (mapcar '(lambda (r) (vxv r v)) m) ) (cond ( (= "TEXT" (cdr (assoc 00 enx))) (setq bpt (cdr (assoc 10 enx)) rot (cdr (assoc 50 enx)) lst (textbox enx) lst (list (list (- (caar lst) off) (- (cadar lst) off)) (list (+ (caadr lst) off) (- (cadar lst) off)) (list (+ (caadr lst) off) (+ (cadadr lst) off)) (list (- (caar lst) off) (+ (cadadr lst) off)) ) ) ) ( (= "MTEXT" (cdr (assoc 00 enx))) (setq ocs (cdr (assoc 210 enx)) bpt (trans (cdr (assoc 10 enx)) 0 ocs) rot (angle '(0.0 0.0) (trans (cdr (assoc 11 enx)) 0 ocs)) wid (cdr (assoc 42 enx)) hgt (cdr (assoc 43 enx)) jus (cdr (assoc 71 enx)) org (list (cond ((member jus '(2 5 8)) (/ wid -2.0)) ((member jus '(3 6 9)) (- wid)) (0.0)) (cond ((member jus '(1 2 3)) (- hgt)) ((member jus '(4 5 6)) (/ hgt -2.0)) (0.0)) ) lst (list (list (- (car org) off) (- (cadr org) off)) (list (+ (car org) wid off) (- (cadr org) off)) (list (+ (car org) wid off) (+ (cadr org) hgt off)) (list (- (car org) off) (+ (cadr org) hgt off)) ) ) ) ) (if lst ( (lambda ( m ) (mapcar '(lambda ( p ) (mapcar '+ (mxv m p) bpt)) lst)) (list (list (cos rot) (sin (- rot)) 0.0) (list (sin rot) (cos rot) 0.0) '(0.0 0.0 1.0) ) ) ) ) (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object))) (princ "\nSelect MText") ;; Note in command line "Select text" (setq MySS (ssget '((0 . "MTEXT")))) ;; Select objects with a selection set, filtered to 'MTEXT' entity type (setq SSCount 0) ;; Just a counter set to 0 (while (< SSCount (sslength MySS)) ;; loop through length or selection set using SSCount (vla-startundomark thisdrawing) ;;Undo mark start for each text (setq MyEnt (ssname MySS SSCount)) ;; get the nth item in the selection set entity name (setq MyEntGet (entget MyEnt)) ;; get the entity definition from the above (setq MTextCoords (text-box-off MyEntGet 1)) ;;Use sub function above to get text coordinates (setq MyText (cdr (assoc 1 MyEntGet))) ;; get the text from the entity (first 256 characters) (if (vl-string-search "\P" MyText) (setq del "\\P")) ; adjust depends on new line character used (if (vl-string-search "\p" MyText) (setq del "\\p")) ; adjust depends on new line character used (if (vl-string-search "\N" MyText) (setq del "\N")) ; adjust depends on new line character used (if (vl-string-search "\n" MyText) (setq del "\n")) ; adjust depends on new line character used (setq TextList (LM:str->lst MyText del)) ;; Convert the text string to a list, (setq MyEntGet (subst (cons 1 (LM:lst->str TextList " ")) (assoc 1 MyEntGet) MyEntGet)) (setq MTextWidth (Distance (car MTextCoords) (cadr MTextCoords))) ;; Existing text width (setq MyEntGet (subst (cons 41 MTextWidth) (assoc 41 MyEntGet) MyEntGet)) ;; Adjust modified text width (entmod MyEntGet) ;; Modify the text (vla-endundomark thisdrawing) ;;End undo mark for this text string (setq SSCount (+ SSCount 1)) ) ; end while (princ) ); end function1 point
-
Nice code Lee as usual maybe OP has limited lisp experience added a couple of extras. (defun c:pretext ( / p ) (if (/= "" (setq p (getstring t "\nSpecify prefix: "))) (pstext p "" 1)) (princ) ) (defun c:sufftext ( / s ) (if (/= "" (setq s (getstring t "\nSpecify suffix: "))) (pstext "" s 1)) (princ) ) (defun c:presuff( / p s) (if (and (/= "" (setq p (getstring t "\nSpecify prefix: "))) (/= "" (setq s (getstring t "\nSpecify suffix: "))) ) (pstext p s 1) ) (princ) )1 point
-
Using the code found here, you can define a program such as the following: (defun c:pretext ( / p ) (if (/= "" (setq p (getstring t "\nSpecify prefix: "))) (pstext p "" 1)) (princ) ) ;; (pstext "Prefix Text" "Suffix Text" <mode>) ;; ;; <mode> = 0 - single selection ;; = 1 - window selection ;; ;; Author: Lee Mac 2011 - www.lee-mac.com (defun pstext ( preftext sufftext mode / a e i s ) (cond ( (= 0 mode) (while (progn (setvar 'ERRNO 0) (setq e (car (nentsel))) (cond ( (= 7 (getvar 'ERRNO)) (princ "\nMissed, try again.") ) ( (eq 'ENAME (type e)) (if (wcmatch (cdr (assoc 0 (entget e))) "TEXT,MTEXT,ATTRIB") (entmod (setq e (entget e) a (assoc 1 e) e (subst (cons 1 (strcat preftext (cdr a) sufftext)) a e) ) ) (princ "\nInvalid Object.") ) ) ) ) ) ) ( (setq s (ssget "_:L" (list '(0 . "TEXT,MTEXT")))) (repeat (setq i (sslength s)) (entmod (setq e (entget (ssname s (setq i (1- i)))) a (assoc 1 e) e (subst (cons 1 (strcat preftext (cdr a) sufftext)) a e) ) ) ) ) ) (princ) ) The command for the above is pretext.1 point
-
Use the getstring function to prompt the user for the prefix/suffix, e.g.: (defun c:test ( ) (pstext (getstring t "\nSpecify Prefix <none>: ") (getstring t "\nSpecify Suffix <none>: ") 1) )1 point
-
Apologies... won't let me upload a DCL... erm, try this zip of it... I've run it on 2006/7/8 stripmtext[3].zip1 point
-
I use one called stripmtext.lsp but I suspect it does essentially the same thing... stripmtext[308].lsp1 point