Topic: Middle Center justify text in rectangle?

[Dommy2Hotty]

Gonna work on this at lunch, wanted to see if anyone has done one.  Looking to update older text tables and was thinking of this procedure:

Start lisp
Select text to Middle Center justify
Pick inside rectangle to use as boundary
Get corners of boundary
Calculate Middle Center
Justify text MC
Move text to MC of rectangle
take sip of coffee


Too much?  Faster methods? 

[Lee Mac]

The only difficulty I can see is finding the rectangle that the user has picked inside, but other than that -should be ok

[alanjt]

Just cheat and use: BPoly, (vlax-ename->vla-object (entlast)), (vla-getboundingbox..., calculate midpoint b/w two points.

[Dommy2Hotty]

The only difficulty I can see is finding the rectangle that the user has picked inside, but other than that -should be ok

I was going to invoke the boundary command, pick inside rectangle to create boundary (lwpolyline), (setq ent (entlast)) to grab the boundary, then extract from there.

[Dommy2Hotty]

Just cheat and use: BPoly, (vlax-ename->vla-object (entlast)), (vla-getboundingbox..., calculate midpoint b/w two points.

Cheaters never win...but I don't care about winning 
I don't know too much about VLISP (if that's what VL functions are), but I know enough to get myself in trouble, so I'll start there.  Thanks for the direction.

[Lee Mac]

Possible Solution (WITHOUT CHEATING!)

Code: [Select]

;; Find Center of Cell Without Cheating  ~  14.12.2009  ~  Lee McDonnell

(defun c:test (/ vlax-list->3D-point ssInter DOC E ENT I IPTS MAP MID
                              MIP OBJLST PT PTS SPC SS TMP1 TMP2 TOBJ)
  (vl-load-com)

  (setq doc (vla-get-ActiveDocument
              (vlax-get-Acad-Object))
       
        spc (if (zerop (vla-get-activespace doc))
              (if (= (vla-get-mspace doc) :vlax-true)
                (vla-get-modelspace doc)
                (vla-get-paperspace doc))
              (vla-get-modelspace doc)))
 

  (defun vlax-list->3D-point (lst)
    (if lst
      (cons (list (car lst) (cadr lst) (caddr lst))
            (vlax-list->3D-point (cdddr lst)))))
 

  (defun ssInter (vlst /  i j obj1 obj2 iArr iLst)
    (setq i (length vLst))
   
    (while (not (minusp (setq j (1- i) i (1- i))))
      (setq obj1 (nth i vLst))
     
      (while (not (minusp (setq j (1- j))))
        (setq obj2 (nth j vLst))

        (if (setq iLst (vlax-list->3D-point
                         (vlax-invoke Obj1 'IntersectWith Obj2 acExtendNone)))
          (setq iPts (cons (car iLst) iPts)))))
   
    iPts)   


  (if (setq i -1 ss (ssget "_X" '((0 . "LINE,*POLYLINE"))))
    (progn
      (while (setq e (ssname ss (setq i (1+ i))))
        (setq ObjLst (cons (vlax-ename->vla-object e) ObjLst)))

      (while
        (progn
          (setq ent (car (entsel "\nSelect Text: ")))

          (cond (  (eq 'ENAME (type ent))

                   (if (eq (cdr (assoc 0 (entget ent))) "TEXT")
                 
                     (while
                       (progn
                         (setq pt (getpoint "\nPick Inside Cell: "))

                         (cond (  (vl-consp pt)
 
                                  (setq tmp1 (vla-AddLine spc
                                               (vlax-3D-point (polar pt 0 1.))
                                                 (vlax-3D-point (polar pt pi 1.)))
                                        tmp2 (vla-AddLine spc
                                               (vlax-3D-point (polar pt (/ pi 2.) 1.))
                                                 (vlax-3D-point (polar pt (/ (* 3 pi) 2.) 1.))))

                                  (setq ObjLst
                                    (vl-remove-if
                                      (function
                                        (lambda (x) (not (cdr x))))
                                      (mapcar
                                        (function
                                          (lambda (x)
                                            (cons x
                                              (cond ( (vlax-list->3D-point
                                                        (vlax-invoke tmp1 'IntersectWith x acExtendThisEntity)))

                                                    ( (vlax-list->3D-point
                                                        (vlax-invoke tmp2 'IntersectWith x acExtendThisEntity))))))) ObjLst)))

                                (if (and ObjLst (<= 4 (length ObjLst)))
                                  (progn
                                   
                                    (setq ObjLst (vl-sort ObjLst
                                                   (function
                                                     (lambda (a b)
                                                       (< (distance (cadr a) pt)
                                                            (distance (cadr b) pt))))))

                                    (if (not (vl-position 'nil
                                               (setq ObjLst
                                                 (mapcar 'car
                                                     (list (car ObjLst)   (cadr ObjLst)
                                                           (caddr ObjLst) (cadddr ObjLst))))))
                                     
                                      (if (setq pts (ssInter ObjLst))
                                        (progn
                                         
                                          (setq miP (apply 'mapcar (cons 'min pts))
                                                maP (apply 'mapcar (cons 'max pts)))

                                          (setq Mid (polar miP (angle miP maP) (/ (distance MiP maP) 2.)))

                                          (vla-put-Alignment
                                            (setq tOBj (vlax-ename->vla-object ent)) acAlignmentMiddleCenter)

                                          (vla-put-TextAlignmentPoint tObj (vlax-3D-point Mid))

                                          (mapcar 'vla-delete (list tmp1 tmp2)))

                                        (princ "\n** Error Detecting Cell **"))

                                      (princ "\n** Error Detecting Cell **")))

                                   (princ "\n** Boundary not Found **"))))))

                     (princ "\n** Object Must be Text **")))

                (princ "\n** Nothing Selected **")))))

    (princ "\n** No Lines or Polylines Found in Drawing **"))

  (princ))
                         
     


[CAB]

If the rectangle (pline) exist then picking the rectangle make things simple.
Did I miss something?

[Dommy2Hotty]

If the rectangle (pline) exist then picking the rectangle make things simple.
Did I miss something?

I did when I describe it...tables are made of lines

[Dommy2Hotty]

Possible Solution (WITHOUT CHEATING!)

Maybe I need a little more background:
Tables already exist, made of lines, with text already populated. Some text isn't justified Middle Center of the "cells" they are within (cells being crossing lines).  I was thinking of picking the text to MC (middle center) in "cell", pick inside of "cell", modify text to be MC within that "cell".

[alanjt]

If the text is within the area, you could just select the text object, then use it's insertion point for the interior point with -boundary. From there, you could iterate through a multiple selection.

Possible Solution (WITHOUT CHEATING!)

Maybe I need a little more background:
Tables already exist, made of lines, with text already populated. Some text isn't justified Middle Center of the "cells" they are within (cells being crossing lines).  I was thinking of picking the text to MC (middle center) in "cell", pick inside of "cell", modify text to be MC within that "cell".

[Lee Mac]

If the text is within the area, you could just select the text object, then use it's insertion point for the interior point with -boundary. From there, you could iterate through a multiple selection.

Possible Solution (WITHOUT CHEATING!)

Maybe I need a little more background:
Tables already exist, made of lines, with text already populated. Some text isn't justified Middle Center of the "cells" they are within (cells being crossing lines).  I was thinking of picking the text to MC (middle center) in "cell", pick inside of "cell", modify text to be MC within that "cell".

Nice idea.

My above code (crudely written), is assuming the table to be made from lines/polylines so that each cell is not a separate polyline.

[wizman]

not directly answering your question but you may want to try qjchen's lisp.  after dumping datas to excel then you can bring it back to cad as acad table and easily fix justification from there.

http://cadtips.cadalyst.com/ole-files/autocad-excel-interface

[Lee Mac]

The Cheating way 

Code: [Select]

(defun c:test (/ *error* vl ov i ss ent obj pt prop eLst poly)
  (vl-load-com)

  (defun *error* (msg)
    (and ov (mapcar 'setvar vl ov))
    (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
        (princ (strcat "\n** Error: " msg " **")))
    (princ))

  (setq vl '("CMDECHO" "OSMODE") ov (mapcar 'getvar vl))
  (mapcar 'setvar vl '(0 0))

  (if (setq i -1 ss (ssget "_:L" '((0 . "MTEXT,TEXT"))))
    (while (setq ent (ssname ss (setq i (1+ i))))
      (setq obj (vlax-ename->vla-object ent))

      (if (eq "AcDbText" (vla-get-ObjectName obj))
        (if (eq AcAlignmentLeft (vla-get-Alignment obj))
          (progn
            (setq tmp (vla-get-InsertionPoint obj))
            (vla-put-Alignment obj acAlignmentMiddleCenter)
            (vla-put-TextAlignmentPoint obj tmp))
          (vla-put-Alignment obj acAlignmentMiddleCenter))
        (vla-put-AttachmentPoint obj acAttachmentPointMiddleCenter))

      (setq pt (vlax-get obj
                 (setq prop
                   (if (eq "TEXT" (cdr (assoc 0 (entget ent))))
                     'TextAlignmentPoint 'InsertionPoint))))

      (setq eLst (entlast))
      (vl-cmdf "_.-boundary" pt "")
     
      (if (not (eq eLst (setq poly (entlast))))
        (progn
          (vla-getBoundingBox (vlax-ename->vla-object poly) 'MiP 'MaP)

          (setq pLst (mapcar 'vlax-safearray->list (list mIP maP)))

          (vlax-put-property obj prop
            (vlax-3D-point
              (polar (car pLst) (apply 'angle pLst) (/ (apply 'distance pLst) 2.))))

          (entdel poly))

        (princ "\n ** Boundary not Found ** "))))

  (mapcar 'setvar vl ov)
  (princ))

 

[alanjt]

I like this, I supply the method and you do all the work. Want to share an office? 

The Cheating way 

Code: [Select]

(defun c:test (/ *error* vl ov i ss ent obj pt prop eLst poly)
  (vl-load-com)

  (defun *error* (msg)
    (and ov (mapcar 'setvar vl ov))
    (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
        (princ (strcat "\n** Error: " msg " **")))
    (princ))

  (setq vl '("CMDECHO" "OSMODE") ov (mapcar 'getvar vl))
  (mapcar 'setvar vl '(0 0))

  (if (setq i -1 ss (ssget "_:L" '((0 . "MTEXT,TEXT"))))
    (while (setq ent (ssname ss (setq i (1+ i))))
      (setq obj (vlax-ename->vla-object ent))

      (if (eq "AcDbText" (vla-get-ObjectName obj))
        (if (eq AcAlignmentLeft (vla-get-Alignment obj))
          (progn
            (setq tmp (vla-get-InsertionPoint obj))
            (vla-put-Alignment obj acAlignmentMiddleCenter)
            (vla-put-TextAlignmentPoint obj tmp))
          (vla-put-Alignment obj acAlignmentMiddleCenter))
        (vla-put-AttachmentPoint obj acAttachmentPointMiddleCenter))

      (setq pt (vlax-get obj
                 (setq prop
                   (if (eq "TEXT" (cdr (assoc 0 (entget ent))))
                     'TextAlignmentPoint 'InsertionPoint))))

      (setq eLst (entlast))
      (vl-cmdf "_.-boundary" pt "")
     
      (if (not (eq eLst (setq poly (entlast))))
        (progn
          (vla-getBoundingBox (vlax-ename->vla-object poly) 'MiP 'MaP)

          (setq pLst (mapcar 'vlax-safearray->list (list mIP maP)))

          (vlax-put-property obj prop
            (vlax-3D-point
              (polar (car pLst) (apply 'angle pLst) (/ (apply 'distance pLst) 2.))))

          (entdel poly))

        (princ "\n ** Boundary not Found ** "))))

  (mapcar 'setvar vl ov)
  (princ))

 

[CAB]

You're too fast 

Code: [Select]

(defun c:CenterText (/ ss i elast obj bent ipt)
  (defun getmid (ent)
    (setq lst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget ent))))
    (if (= (length lst) 4)
      (mapcar '(lambda (a b) (/ (+ a b) 2.)) (car lst) (caddr lst))
    )
  )

  (command "_undo" "begin")
  (prompt "\Selext text within the table.")
  (setq ss (ssget "_:L" '((0 . "TEXT"))))
  (setq i -1)
  (while (setq ename (ssname ss (setq i (1+ i))))
    (setq obj (vlax-ename->vla-object ename))
    (setq elast (entlast))
    (setq ipt (vlax-get obj 'insertionpoint))
    (if (vl-catch-all-error-p
          (vl-catch-all-apply
            '(lambda ()
               (vl-cmdf "_-BOUNDARY" (trans ipt 0 1) "")
               (while (> (getvar "CMDACTIVE") 0) (command ""))
             )
          )
        )
      (princ "\nText boundry not found.")
      ;;  got a boundry
      (progn
        (if (and (not (eq elast (setq bent (entlast))))
                 (setq midpt (getmid bent))
            )
          (progn
            (vla-put-Alignment obj acAlignmentMiddleCenter)
            (vla-put-TextAlignmentPoint Obj (vlax-3D-point MidPT))
          )
          (and (eq bent (entlast)) (entdel bent))
        )
      )
    )
  )
  (command "_undo" "end")

  (princ)
)