(defun c:tbr (/ acode actdoc idx ipt ll obj obj2 objlen objul ofs ofs2 pickdist
pt rot sel str str2 textlen ur)

;; Breaks a text object selected at the character it is selected into two text objects, with them being
;; in the same location as they were when they were one text object.
;; Works with all justifications except Fit & Align

(defun *error* (msg)
(vla-endundomark ActDoc)
(prompt (strcat "\n Error--> " msg))
)
;---------------------------------------------------------------------
(setq ActDoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-endundomark ActDoc)
(vla-startundomark ActDoc)
(if
(and
(setq Sel
(entsel
"\n Select text object to break (in the end of the character to break at): "
)
)
(setq Obj (vlax-ename->vla-object (car Sel)))
(= (vla-get-objectname Obj) "AcDbText")
(setq Str (vla-get-textstring Obj))
(setq Rot (vla-get-rotation Obj))
(setq Pt (trans (cadr Sel) 1 0))
(vl-position (vla-get-alignment Obj) '(0 1 2 4 6 7 8 9 10 11 12 13 14))
)
(progn
(setq Ipt (safearray-value (vlax-variant-value(vla-get-insertionpoint obj))))
(setq pickdist (distance Ipt pt))

(vla-put-rotation obj 0.0)
(setq Ipt (safearray-value (vlax-variant-value(vla-get-insertionpoint obj))))
(setq obj2 (vlax-invoke Obj 'Copy))
(vla-getboundingbox Obj 'll 'ur)
(setq ll (safearray-value ll)
ur (safearray-value ur)
objul (list (car ll) (cadr ur))
objlen (distance ur objul))

(setq idx (strlen str)
str2 str
textlen (1+ pickdist)
)
(while (> textlen pickdist)
(setq str (substr str 1 (setq idx (1- idx))))
(vla-put-textstring Obj str)
(vla-getboundingbox Obj 'll 'ur)
(setq ll (safearray-value ll)
ur (safearray-value ur))
(setq textlen (distance (list (car ll) (cadr ur)) ur))
)
(setq str2 (substr str2 (1+ (strlen str))))
(vla-put-textstring obj2 str2)
(vla-getboundingbox Obj2 'll 'ur)
(setq ll (safearray-value ll)
ur (safearray-value ur)
ofs2 (- objlen (distance ll (list (car ur)(cadr ll)))))
(setq Ipt1 (safearray-value (vlax-variant-value(vla-get-insertionpoint obj))))
(setq Ipt2 (safearray-value (vlax-variant-value(vla-get-insertionpoint obj2))))

(vla-put-rotation obj rot)
(vla-put-rotation obj2 rot)
(setq acode (vla-get-alignment Obj))
(cond
((vl-position aCode '(0 6 9 12)) ; Left
(vla-move obj2 (vlax-3d-point objul)(vlax-3D-point (polar objul rot ofs2)))
)
((vl-position aCode '(1 4 7 10 13)) ; Center
(vla-move obj (vlax-3d-point objul)(vlax-3D-point (polar objul (+ rot pi) (distance ipt ipt1))))
(vla-move obj2 (vlax-3d-point objul)(vlax-3D-point (polar objul rot (distance ipt ipt2))))
)
((vl-position aCode '(2 8 11 14)) ;Right
(vla-move obj (vlax-3d-point objul)(vlax-3D-point (polar objul (+ rot pi) (distance ipt ipt1))))
)
) ; end cond stmt
)
(cond
((not Sel)
(prompt "\n No object selected.")
)
((not Str)
(prompt "\n Object selected was not a plain text object.")
)
(t
(prompt
"\n Text object selected does not have an alignment that would work."
)
)
)
)
(vla-endundomark ActDoc)
(princ)
)
(c:tbr)

Advertisements