Dtext 2 Mtext <selection order>

Discussion in 'AutoCAD' started by GaryDF, Jan 3, 2005.

Page 1 of 2
  1. GaryDF

    GaryDF Guest

    I want to modify the code below to be able to select multiple
    lines of dtext (with filter) and have the dtext remain in the proper
    order (no matter how I window select the dtext).

    Now, I just select the individual dtext lines in the order I want
    them to be converted over to mtext.......I want to use a crossing
    window......but this changes the selection order.

    Gary

    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;;;;
    ;;;by: Peter Jamtgaard Courtesy 2003
    ;;;usage (MTLS 0.825)
    (defun MTLS (spght / sset factor cnt)
    (setq SSET (ssget "x" (list (cons 0 "MTEXT")))
    CNT 0)
    (repeat (sslength SSET)
    (vla-put-LineSpacingFactor
    (vlax-ename->vla-object (ssname SSET CNT))
    spght)
    (setq CNT (1+ CNT)))
    (princ))

    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;;;;
    ;;;Dtext to Mtext
    ;;;by: David Adie 1998
    (defun c:DTOM (/ ccolor one rot sett width total newinspt newstring tempset
    stringa)
    (princ "\n* Convert Dtext to Mtext <select dtext in correct order> *")
    ;t<---this what I want to change
    (if (not (setq sett (ssget '((0 . "TEXT,MTEXT")))))
    (princ "\n*** ///////// Program CANCELLED ///////// ***"))
    (setvar "CMDECHO" 0)
    (setq one (ssname sett 0))
    (if (/= one nil)
    (progn (setq one (entget one))
    (setq height (cdr (assoc 40 one)))
    (setq rot (cdr (assoc 50 one)))
    (setq style (cdr (assoc 7 one)))
    (setq color (cdr (assoc 62 one)))
    (setq layer (cdr (assoc 8 one)))))
    (setq rot (angtos rot 0 4))
    (setq ang90 (/ pi 2))
    (setvar "orthomode" 1)
    ;;(setq width (getdist "\n* Pick Width of new Mtext *"))
    (setq width (* (getvar "textsize") 20)) ;set mtext width
    (setq total (sslength sett))
    (setq newinspt (entget (ssname sett 0)))
    (setq newinspt (cdr (assoc 10 newinspt)))
    (setq newinspt (polar newinspt ang90 height))
    (setq newstring (entget (ssname sett 0)))
    (setq newstring (cdr (assoc 1 newstring)))
    (setq count 1)
    (if (/= sett nil)
    (while (< count total)
    (setq tempset (entget (ssname sett count)))
    (setq stringa (cdr (assoc 1 tempset)))
    (setq newstring (strcat newstring " " stringa))
    (setq count (1+ count)))) ;if / while
    (command "erase" sett "")
    (command "-mtext" newinspt "r" rot "s" style "h" height "w" width newstring "")
    ;;(command ".ddedit" "l" "")
    (MTLS 0.825) ;adjust mtext line spacing
    (princ))
     
    GaryDF, Jan 3, 2005
    #1
  2. GaryDF

    T.Willey Guest

    Could you selected the text, then sort the items in a way that you want?

    Here is how I did it in one that spaces dtext to the current default spacing of the font.

    (if (setq ss (ssget '((0 . "TEXT"))))
    (progn
    (setq TxtList (tmw:ss->Objlist ss))
    (setq TxtList
    (vl-sort
    TxtList
    '(lambda (a b)
    (>
    (cadr (tmw:Var->Safe (vla-get-InsertionPoint a)))
    (cadr (tmw:Var->Safe (vla-get-InsertionPoint b)))
    )
    )
    )
    )

    And here is the sub-routine I used within here.

    (defun tmw:ss->Objlist (ss / RtnList temp1)

    (while (setq temp1 (ssname ss 0))
    (setq RtnList (cons (vlax-ename->vla-object temp1) RtnList))
    (ssdel temp1 ss)
    )
    RtnList
    )

    Hope that helped.
    Tim
     
    T.Willey, Jan 3, 2005
    #2
  3. GaryDF

    GaryDF Guest

    Thanks

    Whta is your tmw:Var->Safe function?

    Gary
     
    GaryDF, Jan 3, 2005
    #3
  4. GaryDF

    T.Willey Guest

    One of those lazy routines. Got tired of typeing it out, so here it is. Sorry about that.

    (defun tmw:Var->Safe (VariantValue /)

    (if (= (type VariantValue) 'variant)
    (safearray-value (variant-value VariantValue))
    )
    )

    Tim
     
    T.Willey, Jan 3, 2005
    #4
  5. GaryDF

    GaryDF Guest

    Here is the modifiied code...so what is it doing for me?
    I still have to select the lines of dtext individually in the correct
    order to get that order in to the converted mtext.

    Still lost....

    Gary

    Code:
    ;;;by: Tim Willey 2005
(defun tmw:ss->Objlist  (ss / RtnList temp1)
(while (setq temp1 (ssname ss 0))
(setq RtnList (cons (vlax-ename->vla-object temp1) RtnList))
(ssdel temp1 ss))
RtnList)
;;;
(defun tmw:Var->Safe (VariantValue /)
(if (= (type VariantValue) 'variant)
(safearray-value (variant-value VariantValue))
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;by: Peter Jamtgaard 2003
;;;usage (MTLS 0.825)
(defun MTLS  (spght / sset factor cnt)
(setq SSET (ssget "x" (list (cons 0 "MTEXT")))
CNT  0)
(repeat (sslength SSET)
(vla-put-LineSpacingFactor
(vlax-ename->vla-object (ssname SSET CNT))
spght)
(setq CNT (1+ CNT)))
(princ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;Dtext to Mtext
;;;by: David Adie 1998
(defun c:D2M  (/ ccolor one rot sett width total newinspt newstring tempset
stringa)
(princ "\n* Convert Dtext to Mtext <select dtext in correct order> *")
;;(if (not (setq sett (ssget '((0 . "TEXT,MTEXT")))))
;;  (princ "\n*** ///////// Program  CANCELLED ///////// ***"))
(if (setq sett (ssget '((0 . "TEXT"))))
(progn (setq TxtList (tmw:ss->Objlist ss))
(setq TxtList
(vl-sort
TxtList
'(lambda (a b)
(> (cadr (tmw:Var->Safe (vla-get-InsertionPoint a)))
(cadr (tmw:Var->Safe (vla-get-InsertionPoint b)))))))))
(setvar "CMDECHO" 0)
(setq one (ssname sett 0))
(if (/= one nil)
(progn (setq one (entget one))
(setq height (cdr (assoc 40 one)))
(setq rot (cdr (assoc 50 one)))
(setq style (cdr (assoc 7 one)))
(setq color (cdr (assoc 62 one)))
(setq layer (cdr (assoc 8 one)))))
(setq rot (angtos rot 0 4))
(setq ang90 (/ pi 2))
(setvar "orthomode" 1)
;;(setq width (getdist "\n* Pick Width of new Mtext *"))
(setq width (* (getvar "textsize") 20))
(setq total (sslength sett))
(setq newinspt (entget (ssname sett 0)))
(setq newinspt (cdr (assoc 10 newinspt)))
(setq newinspt (polar newinspt ang90 height))
(setq newstring (entget (ssname sett 0)))
(setq newstring (cdr (assoc 1 newstring)))
(setq count 1)
(if (/= sett nil)
(while (< count total)
(setq tempset (entget (ssname sett count)))
(setq stringa (cdr (assoc 1 tempset)))
(setq newstring (strcat newstring " " stringa))
(setq count (1+ count)))) ;if / while
(command "erase" sett "")
(command
"-mtext" newinspt "r" rot "s" style "h" height "w" width newstring "")
;;(command ".ddedit" "l" "")
(MTLS 0.825)
(princ))
     
    GaryDF, Jan 3, 2005
    #5
  6. GaryDF

    GaryDF Guest

    Now, I'm really lost. Am I tring to mix apples and oranges?
    What do I do wth the TxtList?

    Gary

     
    GaryDF, Jan 3, 2005
    #6
  7. GaryDF

    T.Willey Guest

    See if this helps.

    Tim

    (defun c:Dt2Mt (/ ActDoc ss TxtList TxtLine CurSpace MtPt1 MtDist othm)

    (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
    (vla-StartUndoMark ActDoc)
    (setq othm (vla-GetVariable ActDoc "orthomode"))
    (vla-SetVariable ActDoc "orthomode" 1)
    (if (setq ss (ssget '((0 . "TEXT"))))
    (progn
    (setq TxtList (tmw:ss->Objlist ss))
    (setq TxtList
    (vl-sort
    TxtList
    '(lambda (a b)
    (>
    (cadr (tmw:Var->Safe (vla-get-InsertionPoint a)))
    (cadr (tmw:Var->Safe (vla-get-InsertionPoint b)))
    )
    )
    )
    )
    (foreach item TxtList
    (if TxtLine
    (setq TxtLine (strcat TxtLine " " (vla-get-TextString item)))
    (setq TxtLine (vla-get-TextString item))
    )
    (vla-Delete item)
    )
    (setq CurSpace (GetCurrentSpace ActDoc))
    (setq MtPt1 (getpoint "\n Select starting point: "))
    (setq MtDist (getdist MtPt1 "\n Select width of Mtext: "))
    (if MtDist
    (vla-AddMText CurSpace (vlax-3d-point MtPt1) MtDist TxtLine)
    )
    )
    )
    (vla-SetVariable ActDoc "orthomode" othm)
    (vla-EndUndoMark ActDoc)
    )
     
    T.Willey, Jan 3, 2005
    #7
  8. GaryDF

    T.Willey Guest

    Forgot you will need this one also.

    Tim

    (defun GetCurrentSpace (Doc / BlkCol SpaceList CurSpace ActSpace temp1)
    ; Returns the "block object" for the active space

    (setq Doc (vla-get-ActiveDocument (vlax-get-ACAD-Object)))
    (setq BlkCol (vla-get-Blocks Doc))
    (vlax-for item BlkCol
    (if (= (vla-get-IsLayout item) ':vlax-true)
    (setq SpaceList (cons item SpaceList))
    )
    )
    (setq ActSpace (vla-get-ActiveLayout Doc))
    (foreach item SpaceList
    (setq temp1 (vla-get-Layout item))
    (if (= (vla-get-Name temp1) (vla-get-Name ActSpace))
    (setq CurSpace item)
    )
    )
    CurSpace
    )
     
    T.Willey, Jan 3, 2005
    #8
  9. GaryDF

    GaryDF Guest

    Perfect

    Thanks for taking the time...

    I notice taht it changes the text line spacing....it would be great
    if it could pick up on the dtext line spacing and use that for the mtext.

    Anyway, thanks for the help, even though its way over my head.

    Gary
     
    GaryDF, Jan 3, 2005
    #9
  10. GaryDF

    wkiernan Guest

    The way I did it with a selection set of TEXT entities:

    1.) take the first entity in the selection set, create a UCS relative to that object (this is so you can sort text that is not at angle zero)

    2.) go through the selection set, make an index list of sublists where the first element of the sublist is the y-coordinate transformed from the world UCS to the user UCS and the second element is the count

    3.) sort that list by the first element in each sublist, to sort by y-coordinates

    4.) now step through the index list and the second element of each sublist is the index of the text entity

    5.) restore your previous UCS

    Here's a sample:

    (defun C:SORTEXT()
    (if (setq eset (ssget (list (cons 0 "TEXT"))))
    (progn
    (setq ecount (sslength eset) srtlst nil)
    (command "ucs" "e" (ssname eset 0))
    (while (>= (setq ecount (1- ecount)) 0)
    (setq ename (ssname eset ecount)
    edata (entget ename)
    srtlst (cons (list (cadr (trans (cdr (assoc 10 edata)) 0 1)) ecount) srtlst)
    )
    )
    (setq srtlst (vl-sort srtlst (quote (lambda (e1 e2)(> (car e1)(car e2))))))
    ; at this point you've sorted the TEXT entities
    ; by y-coordinates, so do something with them
    ; in this example, print their text value
    (foreach el srtlst
    (princ (cdr (assoc 1 (entget (ssname eset (cadr el))))))
    (princ "\n")
    )
    )
    (princ "\nNo TEXT entities selected. ")
    )
    (command "ucs" "p")
    (prin1)
    )
     
    wkiernan, Jan 3, 2005
    #10
  11. GaryDF

    T.Willey Guest

    No problem. I always wanted one, just never got around to writing one. And now that I understand the vlisp stuff better, it was easy. If you want to get the distance you could get the distance for the first two item within the TxtList, or maybe if that isn't the most stabe way of doing it, you could just select two text items and get the distance that way. It depends on how you plan on selecting the text.

    Or, you could get the text style and make two text objects, get the distance from those, erase them and set the mtext properities to that spaceing after the mtext object has been created.

    Just thinking out loud. You could use this.

    (setq temp1 (tblsearch "style" CurSty))
    (if (= (setq temp1 (value 40 temp1)) 0.0)
    (command "_.text" InsPt TxtHt TxtRot "N")
    (command "_.text" InsPt TxtRot "N")
    )
    (setq temp1 (entlast))
    (command "_.text" "" "N")
    (setq temp2 (entlast))
    (setq Dis1 (distance (value 10 (entget temp1)) (value 10 (entget temp2))))
    (vla-Delete (MakeX temp1))
    (vla-Delete (MakeX temp2))

    Where CurSty is the style you want to make the mtext object.

    (defun MakeX (entname)
    (vlax-ename->vla-object entname)
    )

    (defun VALUE (num ent /)
    (cdr (assoc num ent))
    )

    Tim
     
    T.Willey, Jan 3, 2005
    #11
  12. GaryDF

    GaryDF Guest

    Thanks again.
    Question, could the code be modified to except the insertion point
    of the first dtext line, in lieu of picking the new mtext point?

    For now I will just use Peter's line spacing

    Gary

    ;;;by: Peter Jamtgaard 2003
    ;;;usage (MTLS 0.825)
    (defun MTLS (spght / sset factor cnt)
    (setq SSET (ssget "x" (list (cons 0 "MTEXT")))
    CNT 0)
    (repeat (sslength SSET)
    (vla-put-LineSpacingFactor
    (vlax-ename->vla-object (ssname SSET CNT))
    spght)
    (setq CNT (1+ CNT)))
    (princ))


    now that I understand the vlisp stuff better, it was easy. If you want to get
    the distance you could get the distance for the first two item within the
    TxtList, or maybe if that isn't the most stabe way of doing it, you could just
    select two text items and get the distance that way. It depends on how you plan
    on selecting the text.
    from those, erase them and set the mtext properities to that spaceing after the
    mtext object has been created.
     
    GaryDF, Jan 3, 2005
    #12
  13. GaryDF

    MP Guest

    looks like you're in the process of revising this to accept doc as an arg?

    (defun GetCurrentSpace (Doc / BlkCol SpaceList CurSpace ActSpace temp1)

    ;so maybe this goes away?
     
    MP, Jan 3, 2005
    #13
  14. GaryDF

    T.Willey Guest

    Good point. I don't know why that is there, but thanks for pointing it out.

    Tim
     
    T.Willey, Jan 3, 2005
    #14
  15. GaryDF

    T.Willey Guest

    Yes. If you mean the first insertion point of the highest dtext. Then you would just
    (setq MtPt1 (vla-get-InsertionPoint (car TxtList)))

    Because TxtList has been sorted so that the one with the greatest Y value is first, so you would just get the Insetion Point of that object.

    Tim
     
    T.Willey, Jan 3, 2005
    #15
  16. GaryDF

    Jason Piercey Guest

    Hi Tim,

    Perhaps I am not seeing something here but
    doesn't this code accomplish the same thing?

    (defun activeSpaceObject (document)
    (vla-get-block
    (vla-get-activelayout document)) )


    --
    Autodesk Discussion Group Facilitator



    <snip>
     
    Jason Piercey, Jan 3, 2005
    #16
  17. GaryDF

    T.Willey Guest

    It appears so. Thanks Jason. It is always nice to learn the shorter ways to things.

    Tim
     
    T.Willey, Jan 3, 2005
    #17
  18. GaryDF

    GaryDF Guest

    Thanks

    Here is my final version...

    Gary


    Code:
    (defun c:D2M  (/ ActDoc ss TxtList TxtLine CurSpace MtPt1 MtDist othm)
(princ "\n* Convert Dtext to Mtext <window select> *")
(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(vla-StartUndoMark ActDoc)
(setq othm (vla-GetVariable ActDoc "orthomode"))
(vla-SetVariable ActDoc "orthomode" 1)
(if (setq ss (ssget '((0 . "TEXT"))))
(progn (setq TxtList (tmw:ss->Objlist ss))
(setq TxtList
(vl-sort
TxtList
'(lambda (a b)
(> (cadr (tmw:Var->Safe (vla-get-InsertionPoint a)))
(cadr (tmw:Var->Safe (vla-get-InsertionPoint b)))))))
(setq MtPt1 (tmw:Var->Safe (vla-get-InsertionPoint (car TxtList))))
;<- added this line
(foreach
item  TxtList
(if TxtLine
(setq TxtLine (strcat TxtLine " " (vla-get-TextString item)))
(setq TxtLine (vla-get-TextString item)))
(vla-Delete item))
(setq CurSpace (GetCurrentSpace ActDoc))
;  (setq MtPt1 (getpoint "\n Select starting point: "))  <- took out this
line
;(setq MtDist (getdist MtPt1 "\n Select width of Mtext: "))
(setq MtDist (* (getvar "textsize") 20)) ;ADDED
(if MtDist
(vla-AddMText CurSpace (vlax-3d-point MtPt1) MtDist TxtLine))))
(vla-SetVariable ActDoc "orthomode" othm)
(vla-EndUndoMark ActDoc)
(ARCH:MTLS 0.825) ;ADDED
(princ))
     
    GaryDF, Jan 3, 2005
    #18
  19. GaryDF

    GaryDF Guest

    Thanks

    I'm learning more every day........

    Gary


    object (this is so you can sort text that is not at angle zero)
    first element of the sublist is the y-coordinate transformed from the world UCS
    to the user UCS and the second element is the count
     
    GaryDF, Jan 3, 2005
    #19
  20. GaryDF

    Jason Piercey Guest

    You're welcome. I will also be revising my
    toolbox function to use this method rather
    than the way I was doing things.
     
    Jason Piercey, Jan 3, 2005
    #20
Page 1 of 2
Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments (here). After that, you can post your question and our members will help you out.
Similar Threads

  1. Dtext -> Mtext

  2. Modify lisp for dtext to mtext

  3. mtext to dtext

  4. Problem with DTEXT and MTEXT

  5. lisp routine to combine mtext to mtext

  6. DText to MText

  7. DTEXT to MTEXT

  8. WINAPI Multiple File Selection Order

Loading...