Topic: Routine broken: Won't place text (certain alignments) in the right place

[T.Willey]

I don't know how else to title this thread.  I have this one routine that will continue text below it.  It works fine for all justification except Middle Left, and Top Left.  For some reason it acts as if it is only left justified, and sets the text alignment point (vlax term) to '(0.0.0 0.0).  I have no idea why, and am asking if anyone can enlighten me.  I will put a work around for now, but wish it to work the way it did before 2006.

Thanks in advance.

Code: [Select]

(defun c:XX (/ Ent Obj ActDoc Clay StyList TxtSty TxtHt TxtRot StyObj DftHt TxtAli InsPt TxtAli TxtAliStr
               clay ocmd)
; Continue notes at the same rotation, height and layer.
; Sub's 'tmw:nentsel

(if (setq Ent (tmw:nentsel "TEXT,ATTRIB" "\n Select text object: "))
 (progn
  (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
  (vla-StartUndoMark ActDoc)
  (setq clay (getvar "clayer"))
  (setq ocmd (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command "_.ucs" "_w")
  (setq StyList (vla-get-TextStyles ActDoc))
  (setq Obj (MakeX Ent))
  (setvar "clayer" (vla-get-Layer Obj))
  (setq TxtSty (vla-get-StyleName Obj))
  (setq TxtHt (vla-get-Height Obj))
  (setq TxtRot (RTD (vla-get-Rotation Obj)))
  (vlax-for item StyList
   (if (= (vla-get-Name item) TxtSty)
    (progn
     (setq StyObj item)
     (setq DftHt (vla-get-Height item))
     (vla-put-Height item 0.0)
    )
   )
  )
  (setq TxtAli (vla-get-Alignment Obj))
  (if (= TxtAli 0)
   (setq InsPt (vlax-get Obj 'InsertionPoint))
   (setq InsPt (vlax-get Obj 'TextAlignmentPoint))
  )
  (cond
   ((= TxtAli 1)
    (setq TxtAliStr "Center")
   )
   ((= TxtAli 2)
    (setq TxtAliStr "Right")
   )
   ((= TxtAli 4)
    (setq TxtAliStr "Middle")
   )
   ((= TxtAli 6)
    (setq TxtAliStr "TL")
   )
   ((= TxtAli 7)
    (setq TxtAliStr "TC")
   )
   ((= TxtAli 8)
    (setq TxtAliStr "TR")
   )
   ((= TxtAli 9)
    (setq TxtAliStr "ML")
   )
   ((= TxtAli 10)
    (setq TxtAliStr "MC")
   )
   ((= TxtAli 11)
    (setq TxtAliStr "MR")
   )
   ((= TxtAli 12)
    (setq TxtAliStr "BL")
   )
   ((= TxtAli 13)
    (setq TxtAliStr "BC")
   )
   ((= TxtAli 14)
    (setq TxtAliStr "BR")
   )
  )
  (if (= TxtAli 0)
   (command "_.text" "_s" TxtSty InsPt TxtHt TxtRot " ")
   (command "_.text" "_s" TxtSty "_j" TxtAliStr InsPt TxtHt TxtRot " ")
  )
  (command "_.dtext" "")
  (vla-put-Height StyObj DftHt)
  (setvar "clayer" clay)
  (command "_.ucs" "_p")
  (setvar "cmdecho" ocmd)
  (vla-EndUndoMark ActDoc)
 )
)
(princ)
)
;----------------------------------------------------------------
(defun tmw:nentsel (EntType Message / Ent)
(setvar "errno" 0)
(while (and (not Ent) (/= (getvar "errno") 52))
 (setq Ent (nentsel Message))
 (if
  (and
   Ent
   (wcmatch (cdr (assoc 0 (entget (car Ent)))) (strcase EntType))
  )
  (car Ent)
  (setq Ent nil)
 )
)
)


[CAB]

Worked for me in 2000 & 2004
top left & middle left.

You should include your subroutines for testing.
makex  rtd

I had to roll my own

[T.Willey]

Worked for me in 2000 & 2004
top left & middle left.

Yea, this problem is new to 2006.

You should include your subroutines for testing.
makex  rtd

I had to roll my own

Ooops.    I usually do, and I tried.  Thanks for pointing that out.

Here is my work around with ALL sub functions.

Code: [Select]

(defun c:XX (/ Ent Obj ActDoc Clay StyList TxtSty TxtHt TxtRot StyObj DftHt TxtAli InsPt TxtAli TxtAliStr
               clay ocmd LastEnt tmpPt Obj)
; Continue notes at the same rotation, height and layer.
; Sub's 'tmw:nentsel 'MakeX 'RTD

(if (setq Ent (tmw:nentsel "TEXT,ATTRIB" "\n Select text object: "))
 (progn
  (setq LastEnt (entlast))
  (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
  (vla-StartUndoMark ActDoc)
  (setq clay (getvar "clayer"))
  (setq ocmd (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command "_.ucs" "_w")
  (setq StyList (vla-get-TextStyles ActDoc))
  (setq Obj (MakeX Ent))
  (setvar "clayer" (vla-get-Layer Obj))
  (setq TxtSty (vla-get-StyleName Obj))
  (setq TxtHt (vla-get-Height Obj))
  (setq TxtRot (RTD (vla-get-Rotation Obj)))
  (vlax-for item StyList
   (if (= (vla-get-Name item) TxtSty)
    (progn
     (setq StyObj item)
     (setq DftHt (vla-get-Height item))
     (vla-put-Height item 0.0)
    )
   )
  )
  (setq TxtAli (vla-get-Alignment Obj))
  (if (= TxtAli 0)
   (setq InsPt (vlax-get Obj 'InsertionPoint))
   (setq InsPt (vlax-get Obj 'TextAlignmentPoint))
  )
  (cond
   ((= TxtAli 1)
    (setq TxtAliStr "Center")
   )
   ((= TxtAli 2)
    (setq TxtAliStr "Right")
   )
   ((= TxtAli 4)
    (setq TxtAliStr "Middle")
   )
   ((= TxtAli 6)
    (setq TxtAliStr "L")
   )
   ((= TxtAli 7)
    (setq TxtAliStr "TC")
   )
   ((= TxtAli 8)
    (setq TxtAliStr "TR")
   )
   ((= TxtAli 9)
    (setq TxtAliStr "L")
   )
   ((= TxtAli 10)
    (setq TxtAliStr "MC")
   )
   ((= TxtAli 11)
    (setq TxtAliStr "MR")
   )
   ((= TxtAli 12)
    (setq TxtAliStr "L")
   )
   ((= TxtAli 13)
    (setq TxtAliStr "BC")
   )
   ((= TxtAli 14)
    (setq TxtAliStr "BR")
   )
  )
  (if (vl-position TxtAli '(0 6 9 12))
   (command "_.text" "_s" TxtSty InsPt TxtHt TxtRot " ")
   (command "_.text" "_s" TxtSty "_j" TxtAliStr InsPt TxtHt TxtRot " ")
  )
  (command "_.dtext" "")
  (vla-put-Height StyObj DftHt)
  (if (vl-position TxtAli '(6 9 12))
   (while (setq LastEnt (entnext LastEnt))
    (setq Obj (vlax-ename->vla-object LastEnt))
    (setq tmpPt (vlax-get Obj 'InsertionPoint))
    (vla-put-Alignment Obj TxtAli)
    (vlax-put Obj 'TextAlignmentPoint tmpPt)
   )
  )
  (setvar "clayer" clay)
  (command "_.ucs" "_p")
  (setvar "cmdecho" ocmd)
  (vla-EndUndoMark ActDoc)
 )
)
(princ)
)
;---------------------------------------
(defun tmw:nentsel (EntType Message / Ent)
(setvar "errno" 0)
(while (and (not Ent) (/= (getvar "errno") 52))
(setq Ent (nentsel Message))
(if
  (and
   Ent
   (wcmatch (cdr (assoc 0 (entget (car Ent)))) (strcase EntType))
  )
  (car Ent)
  (setq Ent nil)
)
)
)
;--------------------------------
(defun MakeX (entname)
  (vlax-ename->vla-object entname)
)
;---------------------------------
(defun RTD (a) ;Radians to degrees conversion
(* 180.0 (/ a pi)))

How embrassing is posting my MakeX routine. Did that one before I learned more vlax stuff.

[CAB]

 Tangent.
 How about this for another way?
 

Code: [Select]

   (setq TxtAliStr
           (cadr (assoc TxtAli
                        '(
                          (0 "Left")(1 "Center")(2 "Right")(4 "Middle")(6 "TL")(7 "TC")
                          (8 "TR")(9 "ML")(10 "MC")(11 "MR")(12 "BL")(13 "BC")
                          (14 "BR")
                          )
                        )
                 )
          )         
Or this?

Code: [Select]

(setq TxtAliStr
       (nth TxtAli
            '("Left"    "Center"        "Right" nil     "Middle"
              nil     "TL"    "TC"    "TR"    "ML"    "MC"    "MR"
              "BL"    "BC"    "BR"
             )
       )
)

[T.Willey]

I like the first option.  Sometimes all I see is what I need to do, not what is the best method to get there.  I will keep that in mind next time I have to change that routine.
Thanks Alan.