Author Topic: Flipping Text  (Read 8545 times)

0 Members and 1 Guest are viewing this topic.

JB

  • Guest
Flipping Text
« on: May 21, 2004, 12:57:31 PM »
Has anyone got a routine that will flip the text to the other side of the dimension line?
I have run across this several times and can't believe I'm the only one.
Any help would be appreciated.
Thanks !
JB:-)

ELOQUINTET

  • Guest
Flipping Text
« Reply #1 on: May 21, 2004, 12:59:59 PM »
by the other side what are referring to above or below or left or right?

JB

  • Guest
Flipping Text
« Reply #2 on: May 21, 2004, 01:08:12 PM »
Yes, Usually Puts dimension on a mirrored part, upsidedown. Not only is the text upsidedown, If I erase it and redraw it it is still upside down and always 180 degrees off.
JB:-)

Slim©

  • Needs a day job
  • Posts: 6566
  • The Dude Abides...
Flipping Text
« Reply #3 on: May 21, 2004, 01:14:22 PM »
Code: [Select]
;|
FLIP "Flip" selected objects by rotating them 180 degrees
03-25-2003 ;original
04-11-2004 ;
|;

(defun C:FLIP ( / MID FNO FBLK FTXT FLPL XSET XSL XCT ENAME ELST ETYP )

;; MIDpoint of two points
;;=====================================================

  (defun MID (A B)
    (list (/ (+ (car A) (car B)) 2) (/ (+ (cadr A) (cadr B)) 2))
    );end defun MID

;; Flip Not allowed
;;=====================================================

  (defun FNO ( / PT-F )
    (setq STRP (strcat "\r " ETYP " Object Not Flippable            "))
    (princ)
    );end defun FNO

;; Flip Block
;;=====================================================

  (defun FBLK ( / PT-F )
    (command "ROTATE" ENAME "" (cdr (assoc 10 ELST)) "180")
    (setq STRP (strcat "\r Flipping object: " (itoa (+ 1 XCT)) " of " (itoa XSL) "      " ))
    (princ)
    );end defun FBLK

;; Flip Text
;;=====================================================

  (defun FTXT ( / PT-F TB LL UL LR)
    (command "UCS" "ENTITY" ENAME)
    (setq TB (textbox (list (cons -1 ENAME))))
    (setq LL (car TB) UR (cadr TB))
    (setq UL (list (car LL) (cadr UR)) LR (list (car UR) (cadr LL)))
    (setq PT-F (MID LL UR))
    (command "ROTATE" ENAME  "" PT-F "180")
    (command "UCS" "P")
    (setq STRP (strcat "\r Flipping object: " (itoa (+ 1 XCT)) " of " (itoa XSL) "      " ))
    (princ)
    );end defun FTXT

;; Flip Mtext
;;=====================================================

  (defun FMTX ( / PT-A PT-B PT-C XPT XWD XHT XROT PT-F)

    (setq PT-A (cdr (assoc 10 ELST)) XPT (cdr (assoc 71 ELST)))
    (setq XWD (cdr (assoc 41 ELST)) XHT (cdr (assoc 43 ELST)))
    (setq XROT (cdr (assoc 50 ELST)))

    (cond
      ((= 1 XPT)
       (setq PT-B (polar PT-A XROT XWD)
    PT-C (polar PT-B (+ XROT (* PI 1.5)) XHT)
    PT-F (MID PT-A PT-C)
    )
       )
      ((= 2 XPT)
       (setq PT-B (polar PT-A XROT (/ XWD 2.0))
    PT-C (polar PT-B (+ XROT (* PI 1.5)) XHT)
    PT-F (MID PT-A PT-C)
    )
       )

      ((= 3 XPT)
       (setq PT-B (polar PT-A (+ XROT (* PI 1.0)) XWD)
    PT-C (polar PT-B (+ XROT (* PI 1.5)) XHT)
    PT-F (MID PT-A PT-C)
    )
       )
      ((= 4 XPT)
       (setq PT-F (polar PT-A XROT (/ XWD 2.0))
    )
       )
      ((= 5 XPT)
       (setq PT-F PT-A )
       )
      ((= 6 XPT)
       (setq PT-F (polar PT-A (+ XROT (* PI 1.0)) (/ XWD 2.0))
    )
       )
      ((= 7 XPT)
       (setq PT-B (polar PT-A XROT XWD)
    PT-C (polar PT-B (+ XROT (/ PI 2.0)) XHT)
    PT-F (MID PT-A PT-C)
    )
       )
      ((= 8 XPT)
       (setq PT-F (polar PT-A (+ XROT (/ PI 2.0)) (/ XHT 2.0))
    )
       )
      ((= 9 XPT)
       (setq PT-B (polar PT-A (+ XROT (* PI 1.0)) XWD)
    PT-C (polar PT-B (+ XROT (/ PI 2.0)) XHT)
    PT-F (MID PT-A PT-C)
    )
       )
      );end cond

    (command "ROTATE" ENAME "" PT-F "180")
    (setq STRP (strcat "\r Flipping object: " (itoa (+ 1 XCT)) " of " (itoa XSL) "      " ))
    (princ)
    );end defun FMTX


;; Flip Line
;;=====================================================

  (defun FLIN ( / PT-A PT-B PT-F)
    (setq PT-A (cdr (assoc 10 ELST)))
    (setq PT-B (cdr (assoc 11 ELST)))
    (setq PT-F (MID PT-A PT-B))
    (command "ROTATE" ENAME "" PT-F "180")
    (princ)
    );end defun FLIN

;; Flip Polylines
;;=====================================================

  (defun FLPL ( / XTYP VRTL VRT $2 $3 VA CNT VB PT-A PT-B PT-C XDIR SHORT)

    (setq XTYP (cdr (assoc 0 ELST)))
    (if (= XTYP "LWPOLYLINE")
      (command "Convertpoly" "heavy" ENAME "")
      );end if

    (progn
      (setq VRTL nil VRT nil)
      (setq $2 (entnext ENAME))
      (setq $3 (entnext $2))
      (setq VA (cdr (assoc 10 (entget $2))) CNT 1)
      (setq VRT (list (cdr (assoc 10 (entget $2))) (assoc 42 (entget $2))))
      (setq VRTL (append VRTL (list VRT)))
      (while
(/= "SEQEND" (cdr (assoc 0 (entget $3))))
(setq VRT (list (setq VB (cdr (assoc 10 (entget $3)))) (assoc 42 (entget $3))))
(setq VRTL (append VRTL (list VRT)))
(setq $2 $3 $3 (entnext $2) VA (cdr (assoc 10 (entget $2))) CNT (+ CNT 1))
);end while
      );end progn

    (setq PT-A (car (nth 0 VRTL)) PT-B (car (nth 0 (reverse VRTL))))
    (setq XDIR (angle PT-B PT-A) PT-C (polar PT-B XDIR 1.0))

    (command "PLINE" PT-C PT-B "")
    (setq SHORT (entlast))
    (command "PEDIT" SHORT "J" ENAME "" "")
    (command "Pedit" SHORT "E" "Next" "Break" "Go" "X" "")
    (entdel SHORT)
    (setq STRP (strcat "\r Flipping object: " (itoa (+ 1 XCT)) " of " (itoa XSL) "      " ))
    (princ)
    );end defun FLPL

;; Main Routine
;;=====================================================


  (setq XSET (ssget))
  (setq XSL (sslength XSET))
  (setq XCT 0)

  (repeat XSL
    (setq ENAME (ssname XSET XCT))
    (setq ELST (entget ENAME))
    (setq ETYP (strcase (cdr (assoc 0 ELST))))

    (cond
      ((= ETYP "LINE")
       (FLIN)
       )
      ((= ETYP "INSERT")
       (FBLK)
       )
      ((= ETYP "TEXT")
       (FTXT)
       )
      ((= ETYP "MTEXT")
       (FMTX)
       )
      ((= ETYP "LWPOLYLINE")
       (FLPL)
       )
      ((= ETYP "POLYLINE")
       (FLPL)
       )
      ((= ETYP "CIRCLE")
       (FNO)
       )
      ((= ETYP "ARC")
       (FNO)
       )
      );end cond

    (prompt STRP)
    (setq XCT (+ 1 XCT))
    );end repeat

  (princ)
  );end defin C:FLIP

;| FlipBrg.lsp used to "Flip" the direction of bearing text. NW=SE, NE=SW etc
|;

(defun C:FLIPBRG (/ ENAME ELST TXT OLDVAL NEWVAL CNT SSL SUF PRE BDY XPR)

  (setvar "cmdecho" 0)

  (defun DOBRG ( )
    (cond
      ((= "C" PRE)
       (setq PRE (substr TXT 5 1) SUF (substr TXT (strlen TXT) 1))
       (setq BDY (substr TXT 6 (- (strlen TXT) 6)) XPR "Ch= ")
       )
      );end cond
    (cond
      ((= "N" PRE)
       (setq PRE "S" )
       )
      ((= "S" PRE)
       (setq PRE "N")
       )
      );end cond
    (cond
      ((= "E" SUF)
       (setq SUF "W")
       )
      ((= "W" SUF)
       (setq SUF "E")
       )
      );end cond

    (if (null XPR)
      (setq NBRG (strcat PRE BDY SUF))
      (setq NBRG (strcat XPR PRE BDY SUF))
      );end if

    (setq OLDVAL (assoc 1 ELST) NEWVAL (cons 1 NBRG) ELST (Subst NEWVAL OLDVAL ELST))
    (entmod ELST)
    (entupd ENAME)
    (setq CNT (1+ CNT) XPR nil)
    (prompt (strcat "\r Working on Text item: " (itoa CNT) " of " (itoa SSL)))
    (princ)
    );end defun DOBRG

  (setq SS (ssget ) SS (ssget "P" '((0 . "TEXT"))) SSL (sslength SS) CNT 0)
  (repeat SSL
    (setq ENAME (ssname SS CNT) ELST (entget ENAME) TXT (cdr (assoc 1 ELST)))
    (setq PRE (substr TXT 1 1) SUF (substr TXT (strlen TXT) 1) BDY (substr TXT 2 (- (strlen TXT) 2)))
    (if (or (= "N" PRE) (= "S" PRE) (= "C" PRE))
      (DOBRG)
      (progn
(setq CNT (1+ CNT) XPR nil)
(prompt (strcat "\r Working on Text item: " (itoa CNT) " of " (itoa SSL)))
);end progn
      );end if
    );end repeat
  (princ)
  );end defun C:FLIPBRG


See if this helps.
I drink beer and I know things....

JB

  • Guest
Flipping Text
« Reply #4 on: May 21, 2004, 02:31:17 PM »
Maybe I don't Know how to run it.
I loaded it and ran "flip". It tells me
"FLIP
Select objects: 1 found

Select objects: Specify opposite corner: 1 found (1 duplicate), 1 total

Select objects:
; error: bad argument type: stringp nil"

What did I miss?
JB

Mark

  • Custom Title
  • Seagull
  • Posts: 28762
Flipping Text
« Reply #5 on: May 21, 2004, 02:33:48 PM »
try FLIPBRG
TheSwamp.org  (serving the CAD community since 2003)

Anonymous

  • Guest
TRIED IT !
« Reply #6 on: May 21, 2004, 03:48:57 PM »
I already tried that !
Posted is the reaction.
It will be fine. I just copy another dimension and grip the node, put it where I want it to be. It does not "flip" it that way.
It just does not make since. Sometimes it does, sometimes it doesn't.
Thank you for all your input!
JB:-)

"Command: FLIPBRG

Select objects: 1 found

Select objects:
; error: bad argument type: lselsetp nil"

Slim©

  • Needs a day job
  • Posts: 6566
  • The Dude Abides...
Flipping Text
« Reply #7 on: May 21, 2004, 03:51:04 PM »
Too bad, works great for me. Maybe one of your setvars or somthings it doesn't like. Or you might have some variables with the same names as mine elsewhere. It also works well for my users.

BTW "FLIPBRG" changes a bearing from S 89°54'30" W to N 89°54'30" E.
I drink beer and I know things....

Mark

  • Custom Title
  • Seagull
  • Posts: 28762
Flipping Text
« Reply #8 on: May 21, 2004, 05:13:52 PM »
-JB
Are you using LDT?
TheSwamp.org  (serving the CAD community since 2003)

Ron Heigh

  • Guest
Flipping Text
« Reply #9 on: May 21, 2004, 07:02:02 PM »
Try This:
Code: [Select]
;;; FUNCTION
;;; allows the user to select numerous dimensions
;;; and proceeds to rotate the ucs origin by 180 degrees
;;;
;;; ARGUMENTS
;;; none
;;;
;;; USAGE
;;; DIMFLIP
;;;
;;; PLATFORMS
;;; 2000+
;;;
;;; AUTHOR
;;; Copyright© 2003 Ron Heigh
;;;
;;; VERSION
;;; 1.0 January 01, 2003

(DEFUN c:dimflip ()

  '(acet-ss-clear-prev)

  (PRINC "\nPress Enter to select all or...")

  (IF (SETQ ss:dims (SSGET '((0 . "DIMENSION"))))
      (SETQ ss:dims (SSGET "P"))
      (SETQ ss:dims (SSGET "X" '((0 . "DIMENSION"))))
  ) ;_ end of if

  (IF ss:dims
    (main:flipper)
    (PRINC "\nNo valid objects selected.")
  ) ;_ end of if
  (PRINC)

) ;_ end of defun


  ;***CALL THE MODULES***

(DEFUN main:flipper ()
  (SETQ index 0
        cnt 0)
  (REPEAT (SSLENGTH ss:dims)
    (SETQ en (SSNAME ss:dims index))
    (test:code51)
    (SETQ index (+ index 1))
  ) ;_ end of REPEAT

  (PRINC (STRCAT "\n***Process Complete***"))
) ;_ end of defun


(DEFUN test:code51 ()
  (SETQ en:data (ENTGET en)
        val:51 (CDR (ASSOC 51 en:data))
        nval:51 (+ val:51 PI))
  (ENTMOD (SUBST (CONS 51 nval:51) (ASSOC 51 en:data) en:data))

) ;_ end of defun

JB

  • Guest
Thank You All
« Reply #10 on: June 01, 2004, 06:03:59 PM »
It works like a charm. I love this site !!
Thanks to everyone for the input, and code.
I APPRECIATE the help.
Jamie:-)
Special thanks to RON:-)