Author Topic: mtext overlapping  (Read 5500 times)

0 Members and 1 Guest are viewing this topic.

kith

  • Guest
mtext overlapping
« on: August 17, 2004, 06:12:39 AM »
hai,

Is there any routine to mark errors for only Mtext overlapping with each other.

Mark

  • Custom Title
  • Seagull
  • Posts: 28753
mtext overlapping
« Reply #1 on: August 17, 2004, 01:45:34 PM »
I've never seen anything like that! I suppose it could be done by extracting the position of each mtext object and then comparing those values for overlap.
TheSwamp.org  (serving the CAD community since 2003)

Fuccaro

  • Guest
mtext overlapping
« Reply #2 on: August 18, 2004, 01:36:26 AM »
The TEXTBOX function will work on text entities only. I don't think you can use it with mtext.
It should be extracted the insertion point, the width and height and the rotation angle.
The width of the Mtext is not always occupied entirely by the text itself. So it is possible that the lisp says ERROR but the texts are not overlapping each other.

daron

  • Guest
mtext overlapping
« Reply #3 on: August 18, 2004, 07:30:00 AM »
vla-getboundingbox works on all entities, though.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
mtext overlapping
« Reply #4 on: August 18, 2004, 08:12:51 AM »
Try this in a rotated mtext object:

Code: [Select]
(defun getboundingbox (ent / minpt maxpt)
  (vla-getboundingbox (vlax-ename->vla-object ent) 'minpt 'maxpt)
  (mapcar 'vlax-safearray->list (list minpt maxpt))
  (setq llc       (vlax-safearray->list minpt)
        urc       (vlax-safearray->list maxpt)
  )
  (list llc urc)
)

(defun c:test ()
  (while (setq ent (entsel "\nPick text."))
    (if ent
      (progn
        (setq blst (getboundingbox (car ent)))
        (command "_rectang" (car blst) (cadr blst))
      )
    )
  )
)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
mtext overlapping
« Reply #5 on: August 18, 2004, 08:24:38 AM »
I use this one for text boxes.
Code: [Select]
;| TBOX.lsp draws a box around selected text based on a user defined offset factor.
   Written and Tested in R2000.
   Version 1.2 - by Tippit CADD Services
   Version 1.3 - by pd
------------------------------------------------------------------------
------------------------------------------------------------------------
 Created by J. Tippit, SPAUG President
    E-mail:                                     jefft@wilkersonproperties.com
    Web Site:                                   http://www.spaug.org

------------------------------------------------------------------------
------------------------------------------------------------------------

 Revisions:
1.0     Originally created                                              ?
1.1     Added scale factor prompt & entity verification                 10/21/99                        
1.2     Added MTEXT support, osmode handling, error trapping            11/26/99
1.3     Added MTEXT angle-support, replacement scale with offset        12/29/00
05/23/03 Modified by Charles Alan Butler as follows
Added alternate boxes (Flat Oval & Hexagonal)
Ask for offset value only on the first box in each session
Check Pline width & prompt user if > 0
Loop until ESCAPE pressed
|;

 ;----------------------------------------------------------------------
 ; Error Handler
 ;----------------------------------------------------------------------
(defun tboxerr (s)
  (if (not (member s '("console break" "Function cancelled")))
    (princ (strcat "\nError: " s "\nResetting Variables."))
  )
  (setvar "osmode" OSM)
  (command "._undo" "e")
  (setvar "cmdecho" 1)
  (setq *error* tboxolderr)
  (princ)
)
 ;----------------------------------------------------------------------
 ; Main Program
 ;----------------------------------------------------------------------
(defun C:TBOX (/    E1   TB   LL   UR   UL   LR   EL   PT   APT  WDT
               HGT  PT1  PT2  PT3  PT4  PT5  PT6  PT7  PT8  PT9  BoxType
              )
  (setq tboxolderr *error*
        *error* tboxerr
  )
  (setvar "cmdecho" 0)
  (command "._undo" "be")
  (setq OSM (getvar "osmode"))
  (setvar "osmode" 0)
  (setq TE  nil
        Plw (getvar "PlineWid") ; width of Poly Line
  )
  (if (/= Plw 0)
    (Progn
      (setq Plw (getint (strcat "Enter Pline Width <" (rtos Plw) ">:")))
      (if (= Plw nil)
        (Setq Plw 0)
      )
      (setvar "PlineWid" Plw)
    )
  )
 ;===================================================
  (Setq BoxType "")
  (initget 1 "Rectangle Flat Hexagon")
  (setq BoxType
         (getkword
           "\n Type of box to use? (R)ectangle (F)lat Oval (H)exagon"
         )
  )

 ;===================================================
  ;(setq SF "1.5")
  (setq SF (rtos (abs(getvar "offsetdist"))))
  (setq SF2 SF)
  (setq
    SF (getstring
         (strcat "\nEnter Offset TextFrame <" SF ">: ")
       )
  )
  (if (or (= SF nil) (= SF ""))
    (setq SF SF2)
  )

 ;===================================================

  (while (not TE)
    (progn
      (setq TE (car (entsel "\nSelect Text or MText: ")))
      (if TE
        (progn
          (setq E1 (entget TE))
          (if (= (cdr (assoc 0 E1)) "TEXT")
            (progn
              (command "ucs" "Entity" TE)
              (setq TB (textbox (list (cons -1 TE)))
                    LL (car TB)
                    UR (cadr TB)
                    UL (list (car LL) (cadr UR))
                    LR (list (car UR) (cadr LL))
              )

              (if (= BoxType "Rectangle")
                (command "._pline" LL LR UR UL "c")
              )
              (if (= BoxType "Flat")
                (command "._pline" LL LR "a" UR "l" UR UL "a" LL "")
              )
              (if (= BoxType "Hexagon")
                (progn
                  (setq d (/ (distance LR UR) 2)
                        d (sqrt (* (* d d) 2))
                  )
                  (command "._pline"
                           LL
                           LR
                           (polar LR (- (angle LR UR) 0.7854) d)
                           UR
                           UL
                           (polar UL (- (angle UL LL) 0.7854) d)
                           "c"
                  )
                )
              )


              (setq EL (entlast))
              (setq PT (list (+ (car UL) 1000) (+ (cadr UL) 1000)))
              (command "._offset" SF EL PT "")
              (entdel EL)
              (command "ucs" "w")
              (setq TE nil)
            )
            (progn
              (if (= (cdr (assoc 0 E1)) "MTEXT")
                (progn
                  (setq APT (cdr (assoc 71 E1))) ; attachment point
                  (setq WDT (cdr (assoc 42 E1))) ; width
                  (setq HGT (cdr (assoc 43 E1))) ; height
                  (setq PT7 (cdr (assoc 10 E1))) ; insertion point
                  (setq PT9
                         (list (+ (car PT7) WDT) (cadr PT7) (caddr PT7))
                  )
                  (setq PT3
                         (list (car PT9) (+ (cadr PT9) HGT) (caddr PT9))
                  )
                  (setq PT1
                         (list (car PT7) (+ (cadr PT7) HGT) (caddr PT7))
                  )

                  (cond
                    ((= BoxType "Rectangle")
                     (command "._pline" PT7 PT9 PT3 PT1 "c")
                    )
                    ((= BoxType "Flat")
                     (command "._pline" PT7 PT9 "a" PT3 "l" PT3 PT1 "a"
                              PT7 "")
                    )
                    ((= BoxType "Hexagon")
                     (progn
                       (setq d (/ (distance PT9 PT3) 2)
                             d (sqrt (* (* d d) 2))
                       )
                       (command "._pline"
                                PT7
                                PT9
                                (polar PT9 (- (angle PT9 PT3) 0.7854) d)
                                PT3
                                PT1
                                (polar PT1 (- (angle PT1 PT7) 0.7854) d)
                                "c"
                       )
                     )
                    )
                  )

                  (setq EL (entlast))

                  (command "._move" EL "" PT1 PT7)
                  (command "._rotate"
                           "last"
                           ""
                           (list (car pt7) (cadr pt7))
                           (/ (* (cdr (assoc 50 E1)) 180) pi)
                  )
                  (command "._offset" SF EL PT7 "")
                  (entdel EL)
                  (setq TE nil)
                )
                (progn
                  (setq TE nil)
                  (prompt
                    "\nSelected object is not TEXT or MTEXT. Try again. "
                  )
                )
              )
            )
          )
        )
        (prompt "\nMissed. Try again.")
      )
    )
  )

  (command "._erase" EL "")
  (if (= (cdr (assoc 0 E1)) "TEXT")
    (command "ucs" "w")
  )
  (redraw)
  (setq SF nil)

  (setvar "osmode" OSM)
  (command "_undo" "e")
  (setvar "cmdecho" 1)
  (setq *error* tboxolderr)
  (princ)
)
(prompt
  (strcat
    "\nCopyright \251 TCS 1999 Version 1.3 *-* CAB modified - Text Box Routine loaded."
  )
)
(prompt "\nType TBOX to execute.")
(princ)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

kith

  • Guest
mtext overlapping
« Reply #6 on: August 18, 2004, 10:03:12 AM »
Thanks Cab,
thanks for spending your time for this.
one query on this tool is
it's ignoring the tail spaces, but not the preceding ones.
means if a Mtext with spaces at end it's ignoring.
but if the starting of Mtext has any spaces it's placing boundary for that also.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
mtext overlapping
« Reply #7 on: August 18, 2004, 10:19:35 AM »
Not sure what you mean.

Did some testing and when mtext objects overlap, the function
is unreliable, that is the box does not cover the entire
mtext object.
Using ACAD2000 and this function.
Code: [Select]
(defun getboundingbox (ent / minpt maxpt)
  (vla-getboundingbox (vlax-ename->vla-object ent) 'minpt 'maxpt)
  (mapcar 'vlax-safearray->list (list minpt maxpt))
  (setq llc       (vlax-safearray->list minpt)
        urc       (vlax-safearray->list maxpt)
  )
  (list llc urc)
)


PS Sorry but my workload is such that I will be away for a few days.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Jeff_M

  • King Gator
  • Posts: 4087
  • C3D user & customizer
mtext overlapping
« Reply #8 on: August 18, 2004, 12:42:01 PM »
Here's another way of doing this. This method places a circle at the overlap points. If all Mtext entities have 0 degree rotation then only the bounding box is checked. If the rotation is anything else, then both the boundingbox AND any points of intersection of the actual textboxes are also shown. I'm not sure why "intersectwith" operates this way......
Code: [Select]

(defun c:overlap (/ ss lay space intersects circ int_list done_list)
  (vl-load-com)
  (and (setq *doc* (vla-get-activedocument (vlax-get-acad-object)))
       (setq lay (vla-add (vla-get-layers *doc*) "OVERLAP"))
       (or (vla-put-color lay acred) t)
       (setq space (get_space))
       (setq ss (active_ss '((0 . "MTEXT"))))
       (vlax-for ent1 ss
(vlax-for ent2 ss
  (if (not (= (vla-get-handle ent1) (vla-get-handle ent2)))
    (progn
      (setq intersects (vlax-invoke ent1 "intersectwith" ent2 acextendnone)
    int_list nil)
      (repeat (/ (length intersects) 3)
(setq int_list (cons (list (car intersects) (cadr intersects)(caddr intersects)) int_list))
(setq intersects (cdr (cdr (cdr intersects))))
)
      (foreach x int_list
(if (not (member x done_list))
  (progn
    (setq circ (vlax-invoke space "addcircle" x 4.0))
    (vla-put-layer circ "OVERLAP")
    (setq done_list (cons x done_list))
    )
  )
)
      )
    )
  )
)
       )
  (princ)
  )


;| Create an ActiveX selection Set. May use selset filters.
   (c) Jeff Mishler Jan 2004
   Usage:
   Don't apply Filters: (setq ss (active_ss nil))
   Apply Filters: (setq ss (active_ss '((0 . "LINE"))))
   The filter lists must comply with the standard ss filters,
   |;
(defun active_ss (flist / code val ss)
  (vl-catch-all-apply 'vla-add
    (list (vla-get-selectionsets *doc*) "activex_ss"))
  (setq ss (vla-item (vla-get-selectionsets *doc*) "activex_ss"))
  (vla-clear ss)
  (if flist
    (progn
      (mapcar '(lambda (a)
(setq code (cons (car a) code))
(setq val (cons (cdr a) val))
)
     flist
     )
      (setq code (vlax-safearray-fill
  (vlax-make-safearray
    vlax-vbinteger
    (cons 0 (- (length code) 1))
    )
  code
  )
   val  (vlax-safearray-fill
  (vlax-make-safearray
    vlax-vbvariant
    (cons 0 (- (length val) 1))
    )
  val
  )
   )
      (vlax-invoke-method ss 'selectonscreen code val)
      )
    (vla-selectonscreen ss)
    )
  (vla-highlight ss :vlax-true)
  (if (> (vla-get-count ss) 0)
    ss
    nil
    )
  )

(defun get_space ()
  (if (= 1 (vla-get-activespace *doc*))
    (vla-get-modelspace *doc*);we're in modelspace
    (if (= (vla-get-mspace *doc*) :vlax-true)
      (vla-get-modelspace *doc*);we're in modelspace
                                ;thru paperspace VPort
      (vla-get-paperspace *doc*);we're in paperspace
      )
    )
  )

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
mtext overlapping
« Reply #9 on: August 18, 2004, 01:13:58 PM »
Jeff,
That is very nice.  :)
Worked well on my limited test.
You do have a typo in the first routine, I think you meant to
use *doc* but used doc instead. Edit the code when you get a chance.

Thanks for the routine, I will dig into the code a little more as soon as
I get some time. My visual lisp is very weak. :?

CAB
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Jeff_M

  • King Gator
  • Posts: 4087
  • C3D user & customizer
mtext overlapping
« Reply #10 on: August 18, 2004, 01:52:15 PM »
Quote from: CAB
Jeff,
That is very nice.  :)
Worked well on my limited test.
You do have a typo in the first routine, I think you meant to
use *doc* but used doc instead. Edit the code when you get a chance.

Thanks for the routine, I will dig into the code a little more as soon as
I get some time. My visual lisp is very weak. :?

CAB

Thanks, CAB
The "doc" was originally intended that way, but as I worked through the routine I decided to use a couple of my "Toolbox" functions which rely on the global *doc* that I set in my start-up lisp. It, of course, worked on my machine but would choke on others....Thanks for catching that, it's now been edited.