Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 01/27/2024 in all areas

  1. For completion and continuing the discussion from above, a very small change (added 8 lines) to include for long text (250+ characters) (defun c:TxtRemCR ( / MySS SSCountMyEnt MyEntGet Mytext TextList OrderList NewText n p DXFCodes 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) ) ) ) ) ;;Initial setup (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object))) ;; for undo later (setq DXFCodes (list 1 3)) ;;List of DXF codes that could contain mtext ;;Assess text (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 (foreach p MyEntGet ;; Loop through mtext entity definition (if (= (member (car p) DXFCodes) nil) ;; If DXF is in list, DXF codes... () ;; not a text code (progn ;; modify the texts (setq MyText (cdr (assoc (car p) MyEntGet))) (if (vl-string-search "\P" MyText) (setq del "\\P")) ;; new line character: Direct MText entry (if (vl-string-search "\p" MyText) (setq del "\\p")) ;; new line character: Direct MText entry (if (vl-string-search "\N" MyText) (setq del "\N")) ;; new line character: Copied and pasted text (if (vl-string-search "\n" MyText) (setq del "\n")) ;; new line character: Copied and pasted text (setq TextList (LM:str->lst MyText del)) ;; Convert the text string to a list, (setq MyEntGet (subst (cons (car p) (LM:lst->str TextList " ")) p MyEntGet)) ;; modify the entity ) ; end progn ) ; end if ) ; end foreach (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 function
    1 point
×
×
  • Create New...