Topic: flipbrg ??

[alanjt]

http://www.theswamp.org/index.php?topic=1417.0

i know this is from a very very very old thread, but i was reading old ones last night....

is flipbrg an autocad command or a routine, i googled it but came up with nothing. thoughts?

[deegeecees]

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

That is a defined function within the Lisp coding, not a native AutoCad command. You'll need to load the Lisp file into your AutCad session in order to have it available to you.

[alanjt]

i searched the forum and google for it, but i can't find this routine.
could/would someone post it or direct me to a link? please?

[alanjt]

nevermind, i'm an idiot, i see it.
thanks

[MP]

never mind, I'm an idiot

Sorry, that position is taken. Glad you figured it out.

[CAB]

Alan,
Here is another that may interest you.

Code: [Select]

;;  CAB 10/04/2005
;;  Correct rotated dimension to reflect the current UCS
;;  Used when elevations are mirrored in a drawing
;;  Updates DXF code 51
(defun c:dimrot (/ d elst ang)
  (and
    (setq d (entsel))
    (setq elst (entget (car d)))
    (setq ang (- (* 2 pi)
                 (angle (trans '(0.0 0.0 0.0) 1 0)
                        (trans '(1.0 0.0 0.0) 1 0)
                 )
              )
    )
    ;;  prevent 2 * pi
    (if (equal ang (* 2 pi) 0.0001) (setq ang 0.0) t)
    (setq elst (subst (cons 51 ang) (assoc 51 elst) elst))
    (entmod elst)
  )
  (print ang)
  (princ)
)

[alanjt]

very cool, thanks. however, the one i was interested in was the one that will change the bearing of N 00°00'00" E to S 00°00'00" W. it works (sort of), you can't have any any text in front or behind or it won't work properly. i had one that will do it (with preceding & trailing text) but it will also turn (S) into (N) and CURVE into CURVW, neither a huge deal, but it would be nice to find one that will work around this. i tried looking at the code with the intent of modifying it to work, but i just can't figure out how to have it exclude certain words.

here's the code in case someone wants it:

Code: [Select]

;TIP917: BFLOP.LSP (C)1993, PAUL S. JOHNSON
<edit by CAB>
Because the code is copyrighted we prefer a link to the code unless you
have permission to post the code.

Use this link to aquire the code:
http://new.cadalyst.com/code/browseyear.cfm?fullyear=1993
Goto December 1993
Look for Flop Line Bearings by Paul S. Johnson

[CAB]

Would you post a sample DWG with the dimensions before & after?

Use the "Aditional Options" at the bottom of a New Post to attach the DWG.

[CAB]

Would something as simple as this work?

Code: [Select]

;;  Flips text to other side of Dim
;;  Updates DXF code 51
(defun c:dimFlopss (/ ss i ename elst ang)
  (princ "\nSelect Dim to Flip.")
  (setq ss (ssget '((0 . "DIMENSION"))))
  (setq i -1)
  (while (setq ename (ssname ss (setq i (1+ i))))
    (setq elst (entget ename))
    (setq ang (+ pi (cdr (assoc 51 elst))))
    (if (equal ang (* 2 pi) 0.0001) (setq ang 0.0));  prevent 2 * pi
    (setq elst (subst (cons 51 ang) (assoc 51 elst) elst))
    (entmod elst)
  )
  (princ)
)

[alanjt]

sorry about posting his material, i thought that when a person makes a submission to cadalyst.com they are the proper owners now and they give the right to alter a routine as one sees fit. i must have been mistaken. again, i'm sorry.

cab, i'm not trying to rotate a "dimension" i'm trying to flip the bearing within mtext (static, etc. labels) (changing out N 00°00'00" E for S 00°00'00" W) and so on.

[CAB]

I'm pretty weak when it come to Civil but if all you need is to swap the letters you can qualify the string
by using ( wcmatch str "*##@##'##\"*" ) which will be True for bearings.
Would that work or is there more text within the string to deal with?
Or is there some manipulation of the actual numbers needed?

[CAB]

As for posting the code, don't sweat it. Read this http://www.theswamp.org/index.php?topic=9202.0 about code.
I think Code from cadalyst.com is free to use but not to redistribute.

[CAB]

Here is a quickie.

Code: [Select]

;;  CAB 03.07.08
(defun c:BF (/ ent elst str idx chr1 chr2)
  (defun chrSwitch (str i / chr1 chr2)
    (setq i
           (apply 'min
                  (vl-remove nil
                             (mapcar '(lambda (x)
                                        (vl-string-position (ascii x) str (1+ i))
                                      )
                                     '("N" "S" "E" "W")))))
    (setq chr1 (substr str (1+ i) 1))
    (setq chr2 (cdr (assoc chr1
                           '(("N" . "S") ("S" . "N") ("E" . "W") ("W" . "E")))))
    (list chr1 chr2 i)
  )
  (setvar "cmdecho" 0)
  (cond
    ((not (setq ent (car (entsel "\nPick bearing to flop: "))))
     (princ "\nMissed, Try Again.")
    )
    ((and (setq elst (entget ent))
          (member (cdr (assoc 0 elst)) '("TEXT" "MTEXT"))
          (wcmatch (setq str (cdr (assoc 1 elst))) "*[NSEW ]##?##'##\"*")
     )

     (setq lst (chrSwitch str -1))
     (setq str (vl-string-subst (cadr lst) (car lst) str))


     (setq lst (chrSwitch str (caddr lst)))
     (setq str (vl-string-subst (cadr lst) (car lst) str (caddr lst)))

     (entmod (subst (cons 1 str) (assoc 1 elst) elst))
     (entupd ent)
    )
  )
  (princ)
)

[Bob Wahr]

<edit by CAB>
Because the code is copyrighted we prefer a link to the code unless you
have permission to post the code.

I think I just bit through my tongue.

[alanjt]

holy crap, that's brilliant!

the only issue i could find was that if you have

(S) CURVE DATA:
R=25.00'
D=25°00'00"
L=25.00'
Ch=25.00'
N 00°00'00" E

it will replace it with:

(N) CURVW DATA:
R=25.00'
D=25°00'00"
L=25.00'
Ch=25.00'
N 00°00'00" E

i guess it looks to the first N, S, E, W and changes that, is it possible to ignore certain strings of text?

[CAB]

<edit by CAB>
Because the code is copyrighted we prefer a link to the code unless you
have permission to post the code.

I think I just bit through my tongue.

Bob,
I sincerely hope your tongue can be re attached.

[CAB]

holy crap, that's brilliant!

the only issue i could find was that if you have

(S) CURVE DATA:
R=25.00'
D=25°00'00"
L=25.00'
Ch=25.00'
N 00°00'00" E

it will replace it with:

(N) CURVW DATA:
R=25.00'
D=25°00'00"
L=25.00'
Ch=25.00'
N 00°00'00" E

i guess it looks to the first N, S, E, W and changes that, is it possible to ignore certain strings of text?

I'll take a look after lunch to see if I can fiddle with the index pointer.

[alanjt]

thank you thank you thank you

[CAB]

OK, give this one a test drive.

Code: [Select]

;;  CAB 03.07.08
(defun c:BF (/ ent elst str idx idxf chr1 chr2)
  (defun chrSwitch (str i / chr1 chr2)
    (setq i
           (apply 'min
                  (vl-remove nil
                             (mapcar '(lambda (x)
                                        (vl-string-position (ascii x) str i);  base 0
                                      )
                                     '("N" "S" "E" "W")))))
    (setq chr1 (substr str (1+ i) 1))
    (setq chr2 (cdr (assoc chr1
                           '(("N" . "S") ("S" . "N") ("E" . "W") ("W" . "E")))))
    (list chr1 chr2 i)
  )
  (setvar "cmdecho" 0)
  (cond
    ((not (setq ent (car (entsel "\nPick bearing to flop: "))))
     (princ "\nMissed, Try Again.")
    )
    ((and (setq elst (entget ent))
          (member (cdr (assoc 0 elst)) '("TEXT" "MTEXT"))
          (wcmatch (setq str (cdr (assoc 1 elst))) "*[NSEW ]##?##'##\"*")
     )

     (setq idx 0)
     (while (and (< (setq idx (1+ idx)) (- (strlen str) 10))
                 (if (wcmatch (substr str idx) "*[NSEW ]##?##'##\"[NSEW ]*");  base 1
                   (setq idxf idx)
                 ))
     )
     
     (setq lst (chrSwitch str (- idxf 2)))
     (setq str (vl-string-subst (cadr lst) (car lst) str (caddr lst))) ; base 0

     (setq lst (chrSwitch str (1+ (caddr lst))))
     (setq str (vl-string-subst (cadr lst) (car lst) str (caddr lst)))

     (entmod (subst (cons 1 str) (assoc 1 elst) elst))
     (entupd ent)
    )
  )
  (princ)
)

[alanjt]

SUCCESS!

cab, you are my hero.
i can't thank you enough.

thank you thank you thank you thank you

on a side note, how do you know when to insert the wcmatch?

[CAB]

Here is one with comments & user feedback.

Code: [Select]

;;  CAB 03.07.08
;;  Bearing Flip
;;  switch the bearing direction characters
(defun c:BF (/ ent elst str idx idxf chr1 chr2)
  ;;  find char in string & return the swap char & the position
  (defun chrSwitch (str i / chr1 chr2)
    (setq i
           (apply 'min
                  (vl-remove nil
                             (mapcar '(lambda (x)
                                        (vl-string-position (ascii x) str i);  base 0
                                      )
                                     '("N" "S" "E" "W")))))
    (setq chr1 (substr str (1+ i) 1))
    (setq chr2 (cdr (assoc chr1 '(("N" . "S") ("S" . "N") ("E" . "W") ("W" . "E")))))
    (list chr1 chr2 i) ; return list
  )

  ;;   =====   START HERE   =====
  (setvar "cmdecho" 0)
  (setvar "ErrNo" 0) ; reset variable
  (while ; loop until nil is returned
   (cond
    ((and (not (setq ent (car (entsel "\nPick bearing to flop: "))))
          (= (getvar "errno") 7))
     (princ "\nMissed, Try Again.")
    )
    ((and ent (setq elst (entget ent))
          (or (member (cdr (assoc 0 elst)) '("TEXT" "MTEXT"))
              (prompt "\nError, Not a Text object."))
          (or (wcmatch (setq str (cdr (assoc 1 elst))) "*[NSEW ]##?##'##\"*")
              (prompt "\nError, No Bearing in Text object."))
     )
     ;;  get position of bearing within the string
     (setq idx 0)
     (while (and (< (setq idx (1+ idx)) (- (strlen str) 10))
                 (if (wcmatch (substr str idx) "*[NSEW ]##?##'##\"[NSEW ]*");  base 1
                   (setq idxf idx)
                 ))
     )
     ;;  swap the first character
     (setq lst (chrSwitch str (- idxf 2)))
     (setq str (vl-string-subst (cadr lst) (car lst) str (caddr lst))) ; base 0
     ;;  swap the second character
     (setq lst (chrSwitch str (1+ (caddr lst))))
     (setq str (vl-string-subst (cadr lst) (car lst) str (caddr lst)))
     ;;  change the object string
     (entmod (subst (cons 1 str) (assoc 1 elst) elst))
     (entupd ent)
    )
    ((= (getvar "errno") 52) ; enter pressed
     (prompt "\nUser Quit.")
     )
    (t) ; stay in loop
   )
  )
  (princ)
)
(prompt "\nBearing Flip Loaded, Enter BF to run.")
(princ)

[CAB]

Glad you can make some use of the routine.

WCMATCH is a powerful function and you use it when you need to match part of a string
and there are variations of the string you must match. It can be a bit tricky to get the
setup you need but it is worth the effort.
The way I used it in this routine is to first rule out any string that does not contain a
bearing and then to find where in the string the bearing starts so I can ignore the first part
of the string.