txt2mtxt - no move

December 11

I have a problem with converting TEXT objects to MTEXT. Every time I use Lisp, the new MTEXT objects are slightly shifted from the original TEXT objects. Does anyone know why this happens and how to fix it? Sample image and DWG

White - orginal one
Yellow lisp t2m
Red lisp T1MJ

;;  Text1MtextJust.lsp [command name: T1MJ]

;;  TXT2MTXT command does not preserve all aspects of justification.  For
;;    one selected Text entity, retains horizontal component [except Aligned/
;;    Fit have Center imposed], but imposes Top for vertical component to
;;    all, regardless of Text entity's original justification.
;;  T1MJ converts each selected Text entity separately to Mtext with same or
;;    equivalent justification as original Text, including vertical component.
;;  "Equivalent" for Text-entity justifications not used with Mtext:
;;    Left/Center/Right become Bottom-Left/Bottom-Center/Bottom-Right;
;;    Middle becomes Middle-Center;
;;    Aligned/Fit become Bottom-Center with new insertion point half-way
;;      between original Text entity's baseline alignment/fit points, so that
;;      any positional change is minimized.
;;  Will sometimes result in slight positional change, depending on specific
;;    justification involved, text font, and/or whether text content includes
;;    characters extending above or below height of capital letters [e.g. lower-
;;    case letters with descenders, parentheses/brackets/braces, slashes, etc.].
;;  Fit-justified Text will retain original height, but lose width adjustment.
;;  Kent Cooper, 18 February 2014

(defun C:T1MJ ; = Text to 1-line Mtext, retaining Justification
  (/ *error* cmde tss inc tent tobj tins tjust)

  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
      (princ (strcat "\nError: " errmsg))
    ); if
    (command "_.undo" "_end")
    (setvar 'cmdecho cmde)
    (princ)
  ); defun - *error*

  (setq cmde (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (command "_.undo" "_begin")
  (prompt "\nTo change Text to 1-line Mtext, preserving Justification,")
  (if (setq tss (ssget "_:L" '((0 . "TEXT"))))
    (repeat (setq inc (sslength tss))
      (setq
        tent (ssname tss (setq inc (1- inc)))
        tobj (vlax-ename->vla-object tent)
        tins (vlax-get tobj 'TextAlignmentPoint)
        tjust (vla-get-Alignment tobj)
      ); setq
      (cond
        ((= tjust 0) (setq tjust 7 tins (vlax-get tobj 'InsertionPoint))); Left
        ((< tjust 3) (setq tjust (+ tjust 7))); 1/2 [Center/Right] to 7/8/9
        ((= tjust 4) (setq tjust 5)); Middle to Middle-Center
        ((member tjust '(3 5)); Aligned/Fit
          (setq
            tjust 8 ; to Bottom-Center
            tins (mapcar '/ (mapcar '+ (vlax-get tobj 'InsertionPoint) tins) '(2 2 2))
              ; with new insertion point
          ); setq
        ); Aligned/Fit
        ((setq tjust (- tjust 5))); all vertical-horizontal pair justifications
      ); cond
      (command "_.txt2mtxt" tent ""); convert, then
      (setq tobj (vlax-ename->vla-object (entlast))); replace Text with new Mtext
      (vla-put-AttachmentPoint tobj tjust); original Text's justification [or equiv.]
      (vlax-put tobj 'InsertionPoint tins); original Text's insertion
    ); repeat
  ); if
  (command "_.undo" "_end")
  (setvar 'cmdecho cmde)
  (princ)
); defun -- T1MJ
(vl-load-com)
(prompt "\nType T1MJ to change Text to 1-line Mtext, preserving Justification.")

;changes text to individual mtext by Carl B.

(princ "\nType T2M to start")
(defun c:t2m ()
  (setq Tset (ssget '((0 . "*TEXT"))))   ;filter text in selection set
                    
  (setq    Setlen (sslength Tset)       ;setq number of entties in selection set, setq count(er) to 0
    Count  0
  )
                    
  (repeat SetLen                             ;repeat setq times
                    
    (setq Ename (ssname Tset Count))   ;setq ename to be the "0..." entity in selection set Tset
                    
    (command "_txt2mtxt" Ename "")
    (setq Count (+ 1 Count))                  ; add 1 to Count(er)
                    
  )                ; Repeat    
  (princ)
)

t2m.dwg

December 11

maybe try : https://lee-mac.com/text2mtext.html

usually Lee's functions are very well behaved.

also read that later express tools version behave better : https://forums.autodesk.com/t5/autocad-forum/text-to-mtex/td-p/13133960

December 11

@zwonko Why not just use Express Tools TXT2MTXT command?

December 11

The width of .79 seems to be the issue.

It remains in position if width is 1 on my test with the Express Tool.

December 11

Odd, never noticed this before, even with width of 1 it is shifting slightly

Untested for now, perhaps grab the first text justification (dxf codes 70 and 73 (https://help.autodesk.com/view/OARX/2024/ENU/?guid=GUID-62E5383D-8A14-47B4-BFC4-35824CAE8363) ), justify the text to top left (see below), grab the text coordinates, txt2mtxt the first text, move to the recorded coordinates and reset to the justification recorded earlier.. then add all the other texts. Might fix it.

It is a known bug but not quite fixed yet.

(defun jut ( just / var ent);; Just: "TL" Top Left... the others arn't hard to guess! "MC".. middle centre, "BR"....
  ;;https://www.cadtutor.net/forum/topic/35569-text-justification-lisp/
 (princ (strcat "\nSelect Text"))
 (if (setq ss (ssget "_:L" '((0 . "ATTDEF,MTEXT,TEXT"))))
   (command "_.justifytext" ss "" just)
 )
)

Edited December 11 by Steven P

December 11

1 hour ago, rlx said:

maybe try : https://lee-mac.com/text2mtext.html

usually Lee's functions are very well behaved.

this is not placeing mtext in same point. You must select new point. This lisp is different, not like I need.

1 hour ago, rlx said:

also read that later express tools version behave better : https://forums.autodesk.com/t5/autocad-forum/text-to-mtex/td-p/13133960

I'm using ZWCAD, but I will ask someone to test in newer autocad 2022.

34 minutes ago, pkenewell said:

@zwonko Why not just use Express Tools TXT2MTXT command?

One of lisp from first post - t2m - is using exprees tools txt2mtxt. Just multiple times.

24 minutes ago, SLW210 said:

The width of .79 seems to be the issue.

It remains in position if width is 1 on my test with the Express Tool.

In my test no. Even insertion point is same, widht 1 there is a diverence in apperance:

December 11

if this offset is a constant you could consider a dirty fix and use move command to move mtext's back with this offset

December 11

@zwonko Next time, I recommend you tell us what CAD system your using. Your profile just says "2020". I cannot personally test with ZWCAD so I cannot be of help.

December 11

Try this as a quick dirty fix idea.

Not sure if it worked for widths anything other than 1.... fix will be the same as below, set width to 1, convert to mtext, reset width factor I think

(defun c:NMtxt2MTXT ( / )


;;Do ssget
;;Start ssget Loop

  (setq MyEnt (car (entsel "Select Text")))        ;; Select Entity
  (setq MyEntJust (cdr (assoc 71 (entget MyEnt)))) ;; Get Justification
  (if (= MyEntJust 1) (setq JU "TL"))
  (if (= MyEntJust 2) (setq JU "TC"))
  (if (= MyEntJust 3) (setq JU "TR"))
  (if (= MyEntJust 4) (setq JU "ML"))
  (if (= MyEntJust 5) (setq JU "MC"))
  (if (= MyEntJust 6) (setq JU "MR"))
  (if (= MyEntJust 7) (setq JU "BL"))
  (if (= MyEntJust 8) (setq JU "BC"))
  (if (= MyEntJust 9) (setq JU "BR"))              ;; Text justification code
  (command "_.justifytext" MyEnt "" "MC")          ;; Justify Top Left
  (setq EntCoords (cdr (assoc 10 (entget MyEnt)))) ;; Text insert point
  (command "_txt2mtxt" MyEnt "")                   ;; Make mtext
  (setq MyEnt (entlast))                           ;; Grab new entity
  (command "_.justifytext" MyEnt "" "MC")          ;; Justify Top Left
  (setq ed (entget MyEnt))
  (setq ed (subst (cons 10 EntCoords) (assoc 10 ed) ed ))
  (entmod ed)
  (command "_.justifytext" MyEnt "" JU)          ;; Justify Top Left


;;end ssget loop.
;; Do stuff to combine all mtexts, txt2mtxt again


)

December 11

30 minutes ago, Steven P said:

Try this as a quick dirty fix idea.

sorry but it is't working properly.

1 hour ago, rlx said:

if this offset is a constant you could consider a dirty fix and use move command to move mtext's back with this offset

thing is that it isn't

1 hour ago, pkenewell said:

Next time, I recommend you tell us what CAD system your using. Your profile just says "2020". I cannot personally test with ZWCAD so I cannot be of help.

It is propably same in ACAD like in ZWCAD. Sorry but I can't set ZWCAD 2020 to visible in post. But if You go further in my profile it will show it is zwcad 2020.

December 12

Had another look at this one, if you entmake the mtext using the text as a basis, it will shift in a similar way to txt2mtxt command. The insert points are still the same as in your example but it is as if there is a border around dtext that isn't there in mtext. Might have to accept that this is still a bit buggy to get them lined up exactly.

Test code but noting the new mtext in this retains the width of the text style - would need to add a bit more to adjust that to the original taxt width

(defun c:test ( / MyEnt )

;; Get entity data
  (setq MyEnt (car (entsel "Select Text")))         ;; Select Entity
  (setq MyEntHJust (cdr (assoc 72 (entget MyEnt)))) ;; Get H Justification
  (setq MyEntVJust (cdr (assoc 73 (entget MyEnt)))) ;; Get V Justification

;;Get justification codes
  (if (= MyEntHJust 0)(setq JU 1))
  (if (= MyEntHJust 1)(setq JU 2))
  (if (= MyEntHJust 2)(setq JU 3))
  (if (= MyEntHJust 3)(setq JU 1))

  (if (= MyEntVJust 0)(setq JU (+ JU 6)))
  (if (= MyEntVJust 1)(setq JU (+ JU 6)))
  (if (= MyEntVJust 2)(setq JU (+ JU 3)))
  (if (= MyEntVJust 3)(setq JU (strcat JU 0)))

;; Create mtext
  (entmake (list
    '(0 . "MTEXT")
    '(100 . "AcDbEntity")
    (assoc 410 (entget MyEnt)) ;; space
    (assoc 8 (entget MyEnt)) ;; layer
    (if (= (assoc 62 (entget MyEnt)) nil)(cons 62 256) (assoc 62 (entget MyEnt)) )
    '(100 . "AcDbMText")
    (assoc 10 (entget MyEnt)) ;; insert point
    (assoc 40 (entget MyEnt)) ;; text height
    (cons 71 JU) ;; attachment point, 0-9
    '(72 . 5)
    (assoc 1 (entget MyEnt)) ;; text value
    (assoc 7 (entget MyEnt)) ;; text style
    (assoc 41 (entget MyEnt)) ;; Width
    (cons 42 (cdr (assoc 41 (entget MyEnt)))) ;; text width
    (assoc 50 (entget MyEnt)) ;; rotation
    '(73 . 1) ;; line spacing
    '(44 . 1.0) ;; line spacing factor
  ))

  (princ)
)

December 12

20 hours ago, SLW210 said:

The width of .79 seems to be the issue.

It remains in position if width is 1 on my test with the Express Tool.

It does move very slightly in my AutoCAD if Width is 1 and then only vertically.

You might also look into line space style on the MText after Txt2Mtxt I set to exact and it lined up.

Not sure about ZWCAD.

December 12

This was bugging me earlier - will look at that also SLW210

December 13

how it looks in zwcad:

From my observation the difference in move depends of what is written inside. "1" on the beggining gives bigger difference. But thought about workaround. I will try write it later.

December 13

Not sure on ZWCAD, but my last post shows a perfect match with width = 1 and line space style set exact.

If those options are not available in ZWCAD, we need to determine an alternative solution to do the same thing.

I am very busy at work, but I'll try to do what I can, later maybe, otherwise next week.

Hopefully someone with ZWCAD can jump in.

December 13

long way, maybe slowly, maybe dirty but working:

(defun c:txt2mtxZW (/ ss ssFiltered ent entdata txt_height txt_widthfactor txt_obliqueangle txt_style style_obj style_data font_name entlast_set i text1 text1cont first_char mtext1 mtext1cont dummy_txt1 dummy_mtxt1 dummy_txt1_vert1 dummy_mtxt1_vert1 diffX diffY insert_point elast elast1 new new1)
  ;; Ask to select TEXT objects
  (setq ss (ssget '((0 . "TEXT"))))
  (princ (strcat "\nNumber of TEXT objects selected: " (itoa (sslength ss))))
  
  ;; For the first selected object, read its properties
  (if ss
    (progn
      (setq ent (ssname ss 0))
      (setq entdata (entget ent))
      ;; Get text height
      (setq txt_height (cdr (assoc 40 entdata)))
      (princ (strcat "\nText Height: " (rtos txt_height 2 2)))
      ;; Get text width factor
      (setq txt_widthfactor (cdr (assoc 41 entdata)))
      (princ (strcat "\nText Width Factor: " (rtos txt_widthfactor 2 2)))
      ;; Get text oblique angle
      (setq txt_obliqueangle (cdr (assoc 51 entdata)))
      (princ (strcat "\nText Oblique Angle: " (rtos txt_obliqueangle 2 2)))
      ;; Get text style
      (setq txt_style (cdr (assoc 7 entdata)))
      (princ (strcat "\nText Style: " txt_style))
      ;; Get font name from text style
      (setq style_obj (tblobjname "style" txt_style))
      (setq style_data (entget style_obj))
      (setq font_name (cdr (assoc 3 style_data)))
      (princ (strcat "\nFont Name: " font_name))
      
      ;; Create the new text style Standard_parcels
      (entmakex
        (list
          '(0 . "STYLE")
          '(100 . "AcDbSymbolTableRecord")
          '(100 . "AcDbTextStyleTableRecord")  ; Subclass marker (AcDbTextStyleTableRecord)
          (cons 2 "Standard_parcels")  ; Style name
          '(70 . 0) ; Standard flag values (bit-coded values):
          (cons 40 0.0) ; Fixed text height; 0 if not fixed
          (cons 41 txt_widthfactor) ; Width factor
          (cons 50 txt_obliqueangle) ; Oblique angle
          '(71 . 0) ; Text generation flags:
          '(42 . 0.0) ; Last height used
          (cons 3 font_name) ; Primary font file name
          '(4 . "") ; Bigfont file name; blank if none
        )
      )
      (princ "\nText style Standard_parcels created.")
      
      ;; Set Standard_parcels as the current text style
      (setvar "TEXTSTYLE" "Standard_parcels")
      (princ "\nText style Standard_parcels has been set as current.")
      
      ;; Create the selection set for TEXT objects
      (setq ss (ssget '((0 . "TEXT"))))
      (princ (strcat "\nNumber of TEXT objects in selection set: " (itoa (sslength ss))))
      (setq entlast_set (ssadd))
      
      ;; Iterate through each selected TEXT entity
      (setq i 0)
      (while (< i (sslength ss))
        (setq text1 (ssname ss i))
        (princ (strcat "\nProcessing TEXT entity: " (rtos i 2 0)))
        ;; Read the text content from text1
        (setq text1cont (cdr (assoc 1 (entget text1))))



    ;    (setq first_char (substr text1cont 1 1))

        (setq first_char text1cont)


        (princ (strcat "\nText content: " text1cont))
        (princ (strcat "\nFirst character: " first_char))
        ;; Copy text1 to a new location
        (command "_copybase" "0,0,0" text1 "")
        (command "_pasteclip" "0,0,0" "")
        (setq text1_copy (entlast))
        (princ "\nCopied TEXT entity.")
        ;; Convert TEXT to MTEXT
        (command "_txt2mtxt" text1 "")
        (princ "\nConverted TEXT to MTEXT.")
        ;; Assign the last created entity to mtext1
        (setq mtext1 (entlast))
        ;; Read the text content from mtext1
        (setq mtext1cont (cdr (assoc 1 (entget mtext1))))
        (princ (strcat "\nMTEXT content: " mtext1cont))
        ;; Change the text style of mtext1 to Standard_parcels
        (entmod (subst (cons 7 "Standard_parcels") (assoc 7 (entget mtext1)) (entget mtext1)))
        (princ "\nChanged text style of mtext1 to Standard_parcels.")
        ;; Read the insertion point from mtext1
        (setq insert_point (cdr (assoc 10 (entget mtext1))))
        (princ (strcat "\nInsertion point: " (vl-prin1-to-string insert_point)))
        ;; Change the text content to first_char in text1_copy and mtext1
        (entmod (subst (cons 1 first_char) (assoc 1 (entget text1_copy)) (entget text1_copy)))
        (princ "\nChanged text1_copy content to first_char.")
        (entmod (subst (cons 1 first_char) (assoc 1 (entget mtext1)) (entget mtext1)))
        (princ "\nChanged mtext1 content to first_char.")
        ;; Copy text1_copy to a new location before exploding
        (command "_copybase" "0,0,0" text1_copy "")
        (command "_pasteclip" "0,0,0" "")
        (setq text1_copy_explode (entlast))
        ;; Use the _txtexp command on text1_copy_explode
		;;;start selection
	(setq
 	 elast (entlast); mark last-drawn entity before Copying
 	 new (ssadd); start empty selection set
	); setq

        (command "_txtexp" text1_copy_explode "")
        (princ "\nExploded text1_copy_explode.")
	;;;create selection set 
	(while (setq elast (entnext elast)); step through everything newer than the previously-saved last entity
	  (ssadd elast new); and put it into the selection set
	); while	


        ;; Assign the created entity to dummy_txt1
        (setq dummy_txt1 (entlast))
        ;; Read the first vertex from dummy_txt1
        (setq dummy_txt1_vert1 (vlax-curve-getPointAtDist dummy_txt1 0.0))
        (princ (strcat "\nFirst vertex of dummy_txt1: " (vl-prin1-to-string dummy_txt1_vert1)))
        ;; Copy mtext1 to a new location before exploding
  ;      (command "_copybase" "0,0,0" mtext1 "")
  ;      (command "_pasteclip" "0,0,0" "")
        (command "_copybase" "0,0,0" mtext1 "")
        (command "_pasteclip" "0,0,0" "")
        (setq mtext1_copy_explode (entlast))
        ;; Use the _txtexp command on mtext1_copy_explode
		;;;start selection
	(setq
 	 elast1 (entlast); mark last-drawn entity before Copying
 	 new1 (ssadd); start empty selection set
	); setq


        (command "_txtexp" mtext1_copy_explode "")
        (princ "\nExploded mtext1_copy_explode.")

	;;;create selection set 
	(while (setq elast1 (entnext elast1)); step through everything new1er than the previously-saved last entity
	  (ssadd elast1 new1); and put it into the selection set
	); while



        ;; Assign the created entity to dummy_mtxt1
        (setq dummy_mtxt1 (entlast))
        ;; Read the first vertex from dummy_mtxt1
        (setq dummy_mtxt1_vert1 (vlax-curve-getPointAtDist dummy_mtxt1 0.0))
        (princ (strcat "\nFirst vertex of dummy_mtxt1: " (vl-prin1-to-string dummy_mtxt1_vert1)))
        ;; Calculate the differences in X and Y coordinates
        (setq diffX (- (car dummy_mtxt1_vert1) (car dummy_txt1_vert1)))
        (setq diffY (- (cadr dummy_mtxt1_vert1) (cadr dummy_txt1_vert1)))
        (princ (strcat "\nDifference X: " (rtos diffX 2 4) ", Difference Y: " (rtos diffY 2 4)))
        ;; Change the insertion point coordinates in mtext1
        (entmod (subst (cons 10 (list (- (car insert_point) diffX) (- (cadr insert_point) diffY) 0.0)) (assoc 10 (entget mtext1)) (entget mtext1)))
        (princ "\nChanged insertion point of mtext1.")
	(princ "\n new X: ")
	(princ (- (car insert_point) diffX))
	(princ "\n")
	(princ "\n new Y: ")
	(princ (- (cadr insert_point) diffY))
	(princ "\n")
        ;; Restore the text content in text1_copy and mtext1
        (entmod (subst (cons 1 text1cont) (assoc 1 (entget text1_copy)) (entget text1_copy)))
        (princ "\nRestored text1_copy content.")
        (entmod (subst (cons 1 mtext1cont) (assoc 1 (entget mtext1)) (entget mtext1)))
        (princ "\nRestored mtext1 content.")
        ;; Assign text1_copy back to text1
        (setq text1 text1_copy)
        ;; Delete dummy_txt1 and dummy_mtxt1 entities
        ;; Delete dummy_txt1 and dummy_mtxt1 entities
        (entdel dummy_txt1)
        (princ "\nDeleted dummy_txt1.")
        (entdel dummy_mtxt1)
        (princ "\nDeleted dummy_mtxt1.")
        (command "_erase" new "")
        (command "_erase" new1 "")
        (princ "\nDeleted new and new1")
        ;; Add mtext1 to entlast_set
        (setq entlast_set (ssadd mtext1 entlast_set))
        (setq i (1+ i))
      )

      (princ (strcat "\nNumber of MTEXT entities created: " (itoa (sslength entlast_set))))
    )
  )
  (princ)
)

Maybe somebody tell's me why it is slow (29objects in 13sec). Popably it is becouse off many commands. Maybe somebody knows how to speed up this code?

Edited December 13 by zwonko

December 14

code updated, much faster (29objects in 1.3sec)

(defun copy-entity (entity)
  ;; Get all DXF codes for the entity
  (setq entdata (entget entity))
  ;; Create a new entity with the same DXF codes
  (entmakex entdata)
  ;; Return the newly created entity name
  (entlast))

(defun c:txt2mtxZW (/ ss ssFiltered ent entdata txt_height txt_widthfactor txt_obliqueangle txt_style style_obj style_data font_name entlast_set i text1 text1cont first_char mtext1 mtext1cont dummy_txt1 dummy_mtxt1 dummy_txt1_vert1 dummy_mtxt1_vert1 diffX diffY insert_point elast elast1 new new1)
  ;; Ask to select TEXT objects
  (setq ss (ssget '((0 . "TEXT"))))
  (princ (strcat "\nNumber of TEXT objects selected: " (itoa (sslength ss))))
  
  ;; For the first selected object, read its properties
  (if ss
    (progn
      (setq ent (ssname ss 0))
      (setq entdata (entget ent))
      ;; Get text height
      (setq txt_height (cdr (assoc 40 entdata)))
      (princ (strcat "\nText Height: " (rtos txt_height 2 2)))
      ;; Get text width factor
      (setq txt_widthfactor (cdr (assoc 41 entdata)))
      (princ (strcat "\nText Width Factor: " (rtos txt_widthfactor 2 2)))
      ;; Get text oblique angle
      (setq txt_obliqueangle (cdr (assoc 51 entdata)))
      (princ (strcat "\nText Oblique Angle: " (rtos txt_obliqueangle 2 2)))
      ;; Get text style
      (setq txt_style (cdr (assoc 7 entdata)))
      (princ (strcat "\nText Style: " txt_style))
      ;; Get font name from text style
      (setq style_obj (tblobjname "style" txt_style))
      (setq style_data (entget style_obj))
      (setq font_name (cdr (assoc 3 style_data)))
      (princ (strcat "\nFont Name: " font_name))
      
      ;; Create the new text style Standard_parcels
      (entmakex
        (list
          '(0 . "STYLE")
          '(100 . "AcDbSymbolTableRecord")
          '(100 . "AcDbTextStyleTableRecord")  ; Subclass marker (AcDbTextStyleTableRecord)
          (cons 2 "Standard_parcels")  ; Style name
          '(70 . 0) ; Standard flag values (bit-coded values):
          (cons 40 0.0) ; Fixed text height; 0 if not fixed
          (cons 41 txt_widthfactor) ; Width factor
          (cons 50 txt_obliqueangle) ; Oblique angle
          '(71 . 0) ; Text generation flags:
          '(42 . 0.0) ; Last height used
          (cons 3 font_name) ; Primary font file name
          '(4 . "") ; Bigfont file name; blank if none
        )
      )
      (princ "\nText style Standard_parcels created.")
      
      ;; Set Standard_parcels as the current text style
      (setvar "TEXTSTYLE" "Standard_parcels")
      (princ "\nText style Standard_parcels has been set as current.")
      
      ;; Create the selection set for TEXT objects
      (setq ss (ssget '((0 . "TEXT"))))
      (princ (strcat "\nNumber of TEXT objects in selection set: " (itoa (sslength ss))))
      (setq entlast_set (ssadd))
      
      (start-timer)
      ;; Iterate through each selected TEXT entity
      (setq i 0)
      (while (< i (sslength ss))
        (setq text1 (ssname ss i))
        ;; Read the text content from text1
        (setq text1cont (cdr (assoc 1 (entget text1))))
        ;(setq first_char (substr text1cont 1 1))
	(setq first_char text1cont)
        ;; Copy text1 using the new function
        (setq text1_copy (copy-entity text1))
        ;; Convert TEXT to MTEXT
        (command "_txt2mtxt" text1 "")
        ;; Assign the last created entity to mtext1
        (setq mtext1 (entlast))
        ;; Read the text content from mtext1
        (setq mtext1cont (cdr (assoc 1 (entget mtext1))))
        ;; Change the text style of mtext1 to Standard_parcels
        (entmod (subst (cons 7 "Standard_parcels") (assoc 7 (entget mtext1)) (entget mtext1)))
        ;; Read the insertion point from mtext1
        (setq insert_point (cdr (assoc 10 (entget mtext1))))
        ;; Change the text content to first_char in text1_copy and mtext1
        (entmod (subst (cons 1 first_char) (assoc 1 (entget text1_copy)) (entget text1_copy)))
        (entmod (subst (cons 1 first_char) (assoc 1 (entget mtext1)) (entget mtext1)))
        ;; Copy text1_copy to a new location before exploding
        (setq text1_copy_explode (copy-entity text1_copy))
      ;  (setq text1_copy_explode (copy-entity text1_copy))
        ;; Use the _txtexp command on text1_copy_explode
        (setq elast (entlast)) ; mark last-drawn entity before copying
        (setq new (ssadd)) ; start empty selection set
        (command "_txtexp" text1_copy_explode "")
        ;; Create selection set 
        (while (setq elast (entnext elast))
          (setq new (ssadd elast new)))
        ;; Assign the created entity to dummy_txt1
        (setq dummy_txt1 (entlast))
        ;; Read the first vertex from dummy_txt1
        (setq dummy_txt1_vert1 (vlax-curve-getPointAtDist dummy_txt1 0.0))
        ;; Copy mtext1 to a new location before exploding
        (setq mtext1_copy_explode (copy-entity mtext1))
       ; (setq mtext1_copy_explode (copy-entity mtext1))
        ;; Use the _txtexp command on mtext1_copy_explode
        (setq elast1 (entlast)) ; mark last-drawn entity before copying
        (setq new1 (ssadd)) ; start empty selection set
        (command "_txtexp" mtext1_copy_explode "")
        ;; Create selection set 
        (while (setq elast1 (entnext elast1))
          (setq new1 (ssadd elast1 new1)))
        ;; Assign the created entity to dummy_mtxt1
        (setq dummy_mtxt1 (entlast))
        ;; Read the first vertex from dummy_mtxt1
        (setq dummy_mtxt1_vert1 (vlax-curve-getPointAtDist dummy_mtxt1 0.0))
        ;; Calculate the differences in X and Y coordinates
        (setq diffX (- (car dummy_mtxt1_vert1) (car dummy_txt1_vert1)))
        (setq diffY (- (cadr dummy_mtxt1_vert1) (cadr dummy_txt1_vert1)))
	(princ "\n")
	(princ diffY)
	(princ "\n")
        ;; Change the insertion point coordinates in mtext1
       (entmod (subst (cons 10 (list (- (car insert_point) diffX) (- (cadr insert_point) diffY) 0.0)) (assoc 10 (entget mtext1)) (entget mtext1)))
        ;(entmod (subst (cons 10 (list (- (car insert_point) diffX) ((cadr insert_point) 0.0) (assoc 10 (entget mtext1)) (entget mtext1)))
        ;; Restore the text content in text1_copy and mtext1
        (entmod (subst (cons 1 text1cont) (assoc 1 (entget text1_copy)) (entget text1_copy)))
        (entmod (subst (cons 1 mtext1cont) (assoc 1 (entget mtext1)) (entget mtext1)))
        ;; Assign text1_copy back to text1
        (setq text1 text1_copy)
        ;; Delete dummy_txt1 and dummy_mtxt1 entities
        (entdel dummy_txt1)
        (entdel dummy_mtxt1)
        (command "_erase" new "")
        (command "_erase" new1 "")
        ;; Add mtext1 to entlast_set
        (setq entlast_set (ssadd mtext1 entlast_set))
        (setq i (1+ i))
      )
      (princ (strcat "\nNumber of MTEXT entities created: " (itoa (sslength entlast_set))))
      (stop-timer)
    )
  )
  (princ)
)





(defun start-timer ()
  "Start the timer and store the start time."
  (setq start-time (getvar "DATE")))

(defun stop-timer ()
  "Stop the timer, calculate the elapsed time, and display it."
  (setq end-time (getvar "DATE"))
  ;; Calculate the elapsed time in seconds
  (setq elapsed-time (* (- end-time start-time) 86400.0))
  ;; Display the elapsed time
  (princ (strcat "\nElapsed Time: " (rtos elapsed-time 2 2) " seconds"))
  (princ))


(defun copy-entity (entity)
  ;; Get all DXF codes for the entity
  (setq entdata (entget entity))
  ;; Create a new entity with the same DXF codes
  (entmakex entdata)
  ;; Return the newly created entity name
  (entlast))

December 14

Just because it stands out as one of the first lines in copy-entity

  (entmakex entdata)
  ;; Return the newly created entity name
  (entlast)

You don't need the last (entlast), entmakex returns the entity name

Sign In

txt2mtxt - no move

Recommended Posts

zwonko

rlx

pkenewell

SLW210

Steven P

zwonko

rlx

pkenewell

Steven P

zwonko

Steven P

SLW210

Steven P

zwonko

SLW210

zwonko

zwonko

Steven P

Join the conversation

Tutorials

Forums

Activity