Jump to content

Updated TXT2MTXT not doing what I want


Rooster

Recommended Posts

  • Replies 33
  • Created
  • Last Reply

Top Posters In This Topic

  • Rooster

    17

  • ronjonp

    7

  • ReMark

    4

  • tombu

    3

Top Posters In This Topic

Posted Images

Ron - spoke a little too soon! I'm finding that your code does do what I want, but only if the starting bits of single line text are already in position. See the attached screenshot - above are three versions of single line text, underneath are the converted groups of mtext. The left one combines perfectly into one mtext object. The middle version keeps the wide line spacing, which I don't want - I'd like it to default to the left version. The right hand version combines 'Spread' & 'Diam' together, but 'Apple' is not joined to these because it's position is slightly different. (The yellow boxes are intended to indicate what your lisp has combined)

 

Is it possible to build in any flexibility to this to cover these scenarios?

 

MTEXT.jpg

Link to comment
Share on other sites

Try this version:

;;; AUTHOR
;;; Copyright© 2010 Ron Perez
;;; 11.02.2010 added grouping text by X values
(defun c:t2mt (/ rjp-removextraspaces rjp-ent2obj rjp-getbbwdth	rjp-getbbtlc rjp-dxf d doc elst	hgt
       i n nxt obj otxt	out pt ss txt w	x x_sort y xfuzz
      )
 (defun rjp-removextraspaces (txt)
   (while (vl-string-search "  " txt) (setq txt (vl-string-subst " " "  " txt)))
   txt
 )
 (defun rjp-ent2obj (ent)
   (if	(= (type ent) 'ename)
     (vlax-ename->vla-object ent)
     ent
   )
 )
 (defun rjp-dxf (code ent)
   (if	(and ent (= (type ent) 'ename))
     (cdr (assoc code (entget ent)))
   )
 )
 (defun rjp-getbb (ent / ll ur)
   (vla-getboundingbox (rjp-ent2obj ent) 'll 'ur)
   (mapcar 'vlax-safearray->list (list ll ur))
 )
 (defun rjp-getbbwdth (ent / out)
   (setq out (mapcar 'car (rjp-getbb (rjp-ent2obj ent))))
   (abs (- (car out) (cadr out)))
 )
 (defun rjp-getbbtlc (ent / out)
   (setq out (rjp-getbb (rjp-ent2obj ent)))
   (list (caar out) (cadr (last out)) 0.0)
 )
 (if (and (setq ss (ssget ":L" (list '(0 . "text"))))
   (setq doc (vla-get-activedocument (vlax-get-acad-object)))
   ;;list as X Y TEXT ENAME
   (setq elst (mapcar '(lambda (x)
			 (list (car (rjp-dxf 10 x))
			       (cadr (rjp-dxf 10 x))
			       (strcat (rjp-removextraspaces (rjp-dxf 1 x)) " ")
			       x
			 )
		       )
		      (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
	      )
   )
     )
   (progn ;; RJP added so user can specify  value for grouping text items
   (setq
     xfuzz (cond
	     ((getdist (strcat "\Enter distance for x fuzz value ["
			       (vl-princ-to-string (setq xfuzz (rjp-dxf 40 (last (car elst)))))
			       "]: "
		       )
	      )
	     )
	     (xfuzz)
	   )
   )
   ;;Sort top to bottom
   (setq elst (vl-sort elst '(lambda (y1 y2) (> (cadr y1) (cadr y2)))))
   ;;Group by x values using text height as fuzz value
   (while (setq i (car elst))
     (setq y (vl-remove-if-not '(lambda (x) (equal (car i) (car x) xfuzz)) elst))
     (mapcar '(lambda (x) (setq elst (vl-remove x elst))) y)
     (setq x_sort (cons y x_sort))
   )
   (foreach item x_sort
     (setq ;;Get widest piece of text to set mtext width
	   w	(* 1.0125 (car (vl-sort (mapcar 'rjp-getbbwdth (mapcar 'last item)) '>)))
	   hgt	(rjp-dxf 40 (last (car item)))
	   pt	(rjp-getbbtlc (last (car item)))
	   ;;Grab top text to pull properties from
	   otxt	(vlax-ename->vla-object (last (car item)))
     )
     ;;Puts hard returns for text spaced greater than (* 2. hgt)
     (setq n 0)
     (foreach x	item
;;;	       (if (setq nxt (nth (setq n (1+ n)) item))
;;;		 (if (>= (setq d (abs (- (cadr x) (cadr nxt)))) (* 2. hgt))
;;;		   (setq out (cons (strcat (caddr x) "\\P\\P") out))
;;;		   (setq out (cons (caddr x) out))
;;;		 )
;;;		 (setq out (cons (caddr x) out))
;;;	       )
       (setq out (cons (caddr x) out))
     )
     ;;Join the text into one string
     (setq txt (apply 'strcat (reverse out)))
     ;;Insert mtext
     (setq obj (vla-addmtext
		 (if (= (getvar 'cvport) 1)
		   (vla-get-paperspace doc)
		   (vla-get-modelspace doc)
		 )
		 (vlax-3d-point pt)
		 w
		 txt
	       )
	   txt nil
	   out nil
     )
     ;;Match properties from top text object
     (vla-put-height obj (vla-get-height otxt))
     (vla-put-attachmentpoint obj actopleft)
     (vlax-put obj 'insertionpoint pt)
     (vla-put-rotation obj 0.0)
     (vla-put-layer obj (vla-get-layer otxt))
     (vla-put-stylename obj (vla-get-stylename otxt))
     ;;Delete selected single line text
     (mapcar 'entdel (mapcar 'last item))
   )
   )
 )
 (princ)
)

Edited by ronjonp
Link to comment
Share on other sites

Thanks Ron. By entering a big enough value for xfuzz I can get the right of the three scenarios to now join into one piece of mtext, which it wasn't previously doing. However, I'm still not getting the line spacing that I want - on the middle and right bits of text where the three single line texts are spaced further apart, the conversion into mtext maintains this spacing. What I really want is for the mtext to look as the left hand version does, regardless of the vertical position/spacing of the single line text. Nearly there...

Link to comment
Share on other sites

Thanks Ron. By entering a big enough value for xfuzz I can get the right of the three scenarios to now join into one piece of mtext, which it wasn't previously doing. However, I'm still not getting the line spacing that I want - on the middle and right bits of text where the three single line texts are spaced further apart, the conversion into mtext maintains this spacing. What I really want is for the mtext to look as the left hand version does, regardless of the vertical position/spacing of the single line text. Nearly there...

 

Code updated .. try again.

Link to comment
Share on other sites

  • 10 months later...

Ron - just a quick question on your lisp, please... how can I change the default value for XFUZZ? I get the option to enter my own fuzz distance, but each time it reverts back to 0.25 for the next use. Can I either change the default 0.25 value somewhere in the lisp (I've searched!), or alternatively can the lisp remember the previous value entered?

 

Many thanks.

Link to comment
Share on other sites

Ron - just a quick question on your lisp, please... how can I change the default value for XFUZZ? I get the option to enter my own fuzz distance, but each time it reverts back to 0.25 for the next use. Can I either change the default 0.25 value somewhere in the lisp (I've searched!), or alternatively can the lisp remember the previous value entered?

 

Many thanks.

 

Give this version a try. The variable *xfuzz* is now global for the session so it will retain your previous entry.

;;; AUTHOR
;;; Copyright© 2010 Ron Perez
;;; 11.02.2010 added grouping text by X values
(defun c:t2mt (/	  rjp-removextraspaces	rjp-ent2obj	      rjp-getbbwdth
       rjp-getbbtlc	     rjp-dxf	d	   doc	      elst	 hgt
       i	  n	     nxt	obj	   otxt	      out	 pt
       ss	  txt	     w		x	   x_sort     y
      )
 (defun rjp-removextraspaces (txt)
   (while (vl-string-search "  " txt) (setq txt (vl-string-subst " " "  " txt)))
   txt
 )
 (defun rjp-ent2obj (ent)
   (if	(= (type ent) 'ename)
     (vlax-ename->vla-object ent)
     ent
   )
 )
 (defun rjp-dxf (code ent)
   (if	(and ent (= (type ent) 'ename))
     (cdr (assoc code (entget ent)))
   )
 )
 (defun rjp-getbb (ent / ll ur)
   (vla-getboundingbox (rjp-ent2obj ent) 'll 'ur)
   (mapcar 'vlax-safearray->list (list ll ur))
 )
 (defun rjp-getbbwdth (ent / out)
   (setq out (mapcar 'car (rjp-getbb (rjp-ent2obj ent))))
   (abs (- (car out) (cadr out)))
 )
 (defun rjp-getbbtlc (ent / out)
   (setq out (rjp-getbb (rjp-ent2obj ent)))
   (list (caar out) (cadr (last out)) 0.0)
 )
 (if (and (setq ss (ssget ":L" (list '(0 . "text"))))
   (setq doc (vla-get-activedocument (vlax-get-acad-object)))
   ;;list as X Y TEXT ENAME
   (setq elst (mapcar '(lambda (x)
			 (list (car (rjp-dxf 10 x))
			       (cadr (rjp-dxf 10 x))
			       (strcat (rjp-removextraspaces (rjp-dxf 1 x)) " ")
			       x
			 )
		       )
		      (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
	      )
   )
     )
   (progn
     ;; RJP added so user can specify  value for grouping text items
     (or *xfuzz* (setq *xfuzz* (rjp-dxf 40 (last (car elst)))))
     (setq *xfuzz* (cond
((getdist (strcat "\Enter distance for x fuzz value [" (vl-princ-to-string *xfuzz*) "]: "))
)
(*xfuzz*)
     ))
     ;;Sort top to bottom
     (setq elst (vl-sort elst '(lambda (y1 y2) (> (cadr y1) (cadr y2)))))
     ;;Group by x values using text height as fuzz value
     (while (setq i (car elst))
(setq y (vl-remove-if-not '(lambda (x) (equal (car i) (car x) *xfuzz*)) elst))
(mapcar '(lambda (x) (setq elst (vl-remove x elst))) y)
(setq x_sort (cons y x_sort))
     )
     (foreach item x_sort
(setq ;;Get widest piece of text to set mtext width
      w	   (* 1.0125 (car (vl-sort (mapcar 'rjp-getbbwdth (mapcar 'last item)) '>)))
      hgt  (rjp-dxf 40 (last (car item)))
      pt   (rjp-getbbtlc (last (car item)))
      ;;Grab top text to pull properties from
      otxt (vlax-ename->vla-object (last (car item)))
)
;;Puts hard returns for text spaced greater than (* 2. hgt)
(setq n 0)
(foreach x item
;;;	       (if (setq nxt (nth (setq n (1+ n)) item))
;;;		 (if (>= (setq d (abs (- (cadr x) (cadr nxt)))) (* 2. hgt))
;;;		   (setq out (cons (strcat (caddr x) "\\P\\P") out))
;;;		   (setq out (cons (caddr x) out))
;;;		 )
;;;		 (setq out (cons (caddr x) out))
;;;	       )
  (setq out (cons (caddr x) out))
)
;;Join the text into one string
(setq txt (apply 'strcat (reverse out)))
;;Insert mtext
(setq obj (vla-addmtext
	    (if	(= (getvar 'cvport) 1)
	      (vla-get-paperspace doc)
	      (vla-get-modelspace doc)
	    )
	    (vlax-3d-point pt)
	    w
	    txt
	  )
      txt nil
      out nil
)
;;Match properties from top text object
(vla-put-height obj (vla-get-height otxt))
(vla-put-attachmentpoint obj actopleft)
(vlax-put obj 'insertionpoint pt)
(vla-put-rotation obj 0.0)
(vla-put-layer obj (vla-get-layer otxt))
(vla-put-stylename obj (vla-get-stylename otxt))
;;Delete selected single line text
(mapcar 'entdel (mapcar 'last item))
     )
   )
 )
 (princ)
)

Edited by ronjonp
Link to comment
Share on other sites

Thanks, Ron. Appreciate you coming back to this! However it doesn't seem to work now...

 

1. The default fuzz value is 0.25, and only text already within this margin is converted. Entering a larger value seems to make no difference (it did in the previous version)

2. After entering a new fuzz value the lisp reverts back to the default of 0.25 on each subsequent use

Link to comment
Share on other sites

Thanks, Ron. Appreciate you coming back to this! However it doesn't seem to work now...

 

1. The default fuzz value is 0.25, and only text already within this margin is converted. Entering a larger value seems to make no difference (it did in the previous version)

2. After entering a new fuzz value the lisp reverts back to the default of 0.25 on each subsequent use

 

oops .. try the code again. :oops:

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...