Topic: Rotate ucs icon

[csgoh]

Hi there;
How do you go about rotating the ucsicon to an angle specified? For eg, I normally set the direction of north as 270d and clockwise direction. However, sometimes I need to rotate the dwg in such a way the ucs icon is rotated at say 30d. Thanks.

csgoh

[Big G]

have you tried ddvpoint? or creating your own 3point ucs?

[CAB]

Here are two lisp that may help.
original post

Code: [Select]

;;  new UCS by picking two points to establish the x axis
;;  Command "UCS" "P" = Resets your UCS to the "previous" setting
(defun c:us1(/ us_1 us_2 us_2a us_3 userosmode userortho)
   (setq userortho (getvar "orthomode"))
   (setq userosmode (getvar "osmode"))
   (setvar "orthomode" 0)
   (setvar "osmode" 512)
   (prompt "\nChange UCS Icon orientation.  Pick a point, then, Pick positive direction of X.")
   (setq us_1 (getpoint "\nOsnap set @ nearest: "))
   (setq us_2 (getpoint "\nOsnap set @ Nearest: "))
   (setq us_2a (+ (* pi 0.5) (angle us_1 us_2)))
   (setq us_3 (polar us_1 us_2a 60.0))
   (command "UCS" "3" us_1 us_2 us_3 "")
   (setvar "orthomode" userortho)
   (setvar "osmode" userosmode)
)


;This routine will align your drawing to any angle picked using "US1"
(defun c:us2()
   (if
     (eq "C"
       (strcase
         (getstring "\nType <C>urrent view or <W>orld view\n")
       )
     )
     (command "plan" "c")
     (command "plan" "w")
   )
)

Code: [Select]

; (c)2001, CADALYST and Tony Hotchkiss
;;; UCS-ROT.LSP  A program to rotate the UCS to line
;;; up with any selected line or polyline entity.
;;; The entity may be part of a block or xref.
;;; command = UCR

(defun err (s)
  (if (= s "Function cancelled")
    (princ "\nUCS-ROT - cancelled: ")
    (progn (princ "\nUCS-ROT - Error: ")
           (princ s)
           (terpri)
    ) ;_ progn
  ) ; if
  (resetting)
  (princ "SYSTEM VARIABLES have been reset\n")
  (princ)
) ; err
(defun setv (systvar newval)
  (setq x (read (strcat systvar "1")))
  (set x (getvar systvar))
  (setvar systvar newval)
) ; setv
(defun setting ()
  (setq oerr *error*)
  (setq *error* err)
  (setv "CMDECHO" 0)
  (setv "BLIPMODE" 0)
  (setv "OSMODE" 512)
) ; end of setting
(defun rsetv (systvar)
  (setq x (read (strcat systvar "1")))
  (setvar systvar (eval x))
) ; restv
(defun resetting ()
  (rsetv "CMDECHO")
  (rsetv "BLIPMODE")
  (rsetv "OSMODE")
  (setq *error* oerr)
) ; end of resetting

(defun dxf (code ename)
  (cdr (assoc code (entget ename)))
) ; dxf

(defun ucs-rot (/ data ucsang ucsdeg)
  (command "UCS" "W")
  (setq data   (get-data)
        ucsang (get-ucs-ang data)
  ) ; setq
  (while (>= ucsang (/ pi 2))
    (setq ucsang (- ucsang pi))
  ) ;_ while
  (setq ucsdeg (/ (* ucsang 180.0) pi))
  (command "UCS" "Z" ucsdeg)
  (princ)
) ;_ ucs-rot

(defun get-data (/ no-ent en data pickp edata)
  (setq no-ent 1
        en nil
  ) ; setq
  (while no-ent
    (setq pickp (getpoint "\nSelect a line or polyline: ")
          edata (nentselp pickp)
    ) ; setq
    (if edata
      (setq en (nth 0 edata))
    ) ; if
    (if (and en
             (or (= (dxf 0 en) "LWPOLYLINE")
                 (= (dxf 0 en) "VERTEX")
                 (= (dxf 0 en) "LINE")
             ) ; or
        ) ; and
      (setq no-ent nil)
      (prompt
        (strcat "\nYou must select a "
                "line or polyline, try again."
        ) ;_ strcat
      ) ; prompt
    ) ; if
  ) ; while
  edata
) ; get-data

(defun get-ucs-ang (edata / len ang)
  (setq len (length edata))
  (if (= len 2)
    (progn
      (setq complex nil)
      (setq ang (do-simple-ang edata))
    ) ;_ progn
    (progn
      (setq complex t)
      (setq ang (do-complex-ang edata))
    ) ;_ progn
  ) ;_ if
  ang
) ;_ get-ucs-ang

(defun do-simple-ang (edata / en typ ang)
  (setq en  (nth 0 edata)
        typ (dxf 0 en)
        ang (cond
              ((= typ "LINE") (do-line en))
              ((= typ "VERTEX") (do-vertex edata))
              ((= typ "LWPOLYLINE") (do-lwpline edata))
            ) ;_ cond
  ) ;_ setq
) ;_ do-simple-ang

(defun do-complex-ang (edata / ang1 ang2 ang)
  (setq ang1 (do-block edata)
        ang2 (do-simple-ang edata)
        ang  (+ ang1 ang2)
  ) ;_ setq
) ;_ do-complex-ang

(defun do-block (edat / bnlist blen i insname ang)
  (setq bnlist   (nth 3 edat)
        blen     (length bnlist)
        inspoint (dxf 10 (nth (1- blen) bnlist))
        i        0
        angtot   0.0
  ) ;_ setq
  (repeat blen
    (setq insname (nth i bnlist)
          ang     (dxf 50 insname)
          angtot  (+ angtot ang)
          i       (1+ i)
    ) ;_ setq
  ) ;_ repeat
  angtot
) ;_ do-block

(defun do-line (en / p1 p2 ang)
  (setq p1  (dxf 10 en)
        p2  (dxf 11 en)
        ang (angle p1 p2)
  ) ;_ setq
) ;_ do-line

(defun do-vertex (edata / en1 v1 en2 v2 en2typ pname ang bulg)
  (setq en1    (nth 0 edata) ; search for next vertex
        v1     (dxf 10 en1)
        en2    (entnext en1)
        en2typ (dxf 0 en2)
  ) ;_ setq
  (if (= en2typ "SEQEND")
    (progn
      (setq pname (dxf -2 en2)
            v2    (dxf 10 (entnext pname))
      ) ;_ setq
    ) ;_ progn
    (setq v2 (dxf 10 en2))
  ) ;_ if
  (setq bulg (dxf 42 en1))
  (if (/= 0.0 bulg)
    (alert "POLYLINE segment is an arc")
  ) ;_ if
  (setq ang (angle v1 v2))
) ;_ do-vertex

(defun do-lwpline (edata / p en vlist pointz lwang1 lwdist1
                      lwp1 alpha lwang2 lwdist2 lwp2 pt ang)
  (setv "OSMODE" 0)
  (setq p     (nth 1 edata)
        en    (nth 0 edata)
        vlist (get-lwvlist en)
  ) ;_ setq
  (if complex
    (progn
      (setq pointz  (list 0.0 0.0)
            lwang1  (angle inspoint pointz)
            lwdist1 (distance inspoint pointz)
            lwp1    (polar p lwang1 lwdist1)
            alpha   (angle pointz lwp1)
            lwang2  (- alpha angtot)
            lwdist2 (distance lwp1 pointz)
            lwp2    (polar pointz lwang2 lwdist2)
            pt      lwp2
      ) ;_ setq
    ) ;_ progn
    (setq pt p)
  ) ;_ if
  (rsetv "OSMODE")
  (setq ang (get-segment vlist pt))
) ;_ do-lwpline

(defun get-lwvlist (en / elist num-vert flag-bit vlist)
  (setq elist    (entget en)
        num-vert (cdr (assoc 90 elist))
        flag-bit (cdr (assoc 70 elist))
        elist    (member (assoc 10 elist) elist)
        vlist    nil
  ) ; setq
  (repeat num-vert
    (setq
      vlist (append vlist (list (cdr (assoc 10 elist))))
      vlist (append vlist (list (cdr (assoc 42 elist))))
    ) ; setq
    (setq elist (cdr elist)
          elist (member (assoc 10 elist) elist)
    ) ; setq
  ) ; repeat
  vlist
) ; get-lwvlist

(defun get-segment (vlst p / not-found segdat first-vertex
                        vlst i vertex1 bulge vertex2 vertdata)
  (setq not-found    1
        segdat       nil
        first-vertex (nth 0 vlst)
        vlst         (append vlst (list first-vertex))
        i            0
  ) ; setq
  (while not-found
    (setq vertex1  (nth i vlst)
          bulge    (nth (+ i 1) vlst)
          vertex2  (nth (+ i 2) vlst)
          vertdata (list vertex1 bulge vertex2)
          segdat   (test-segment vertdata p)
    ) ;_ setq
    (if segdat
      (setq not-found nil)
    ) ; if
    (setq i (+ i 2))
  ) ; while
  (if (/= 0.0 (nth 1 vertdata))
    (alert "LWPOLYLINE segment is an arc")
  ) ;_ if
  segdat
) ; get-segment

(defun test-segment (vdat p / v1 bulg v2 fuzz rad rad2 dat ang dist2-1
                    dist2-2 d h p3 ang1 ang2 cen s-ang e-ang p-ang angtest)
  (setq v1   (nth 0 vdat)
        bulg (nth 1 vdat)
        v2   (nth 2 vdat)
        fuzz 0.000001
        rad  nil
        rad2 nil
        dat  nil
  ) ; setq
  (if (= bulg 0.0)
    (progn
      (setq dist1   (distance v1 v2)
            ang     (angle v1 v2)
            dist2-1 (distance v1 p)
            dist2-2 (distance p v2)
            ang2    (angle v1 p)
      ) ; setq
      (if (and
            (equal (+ dist2-1 dist2-2) dist1 fuzz)
            (equal ang ang2 fuzz)
          ) ; and
        (progn
          (setq dat ang)
        ) ; progn
        (progn
          (setq dat nil)
        ) ; progn
      ) ; if
    ) ; progn
    (progn ; ARC segments
      (setq ang  (abs (* 4.0 (atan bulg)))
            d    (* 0.5 (distance v1 v2))
            rad  (/ d (sin (/ ang 2.0)))
            h    (* rad (cos (/ ang 2.0)))
            ang1 (angle v1 v2)
            p3   (polar v1 ang1 d)
      ) ; setq
      (if (minusp bulg)
        (setq cen (polar p3 (- ang1 (/ pi 2)) h))
        (setq cen (polar p3 (+ ang1 (/ pi 2)) h))
      ) ; if
      (setq rad2  (distance p cen)
            s-ang (angle cen v1)
            e-ang (angle cen v2)
            p-ang (angle cen p)
      ) ; setq
      (if (> ang pi)
        (progn
          (if (minusp bulg)
            (progn
              (setq angtest (or
                              (> s-ang p-ang e-ang)
                              (> e-ang s-ang p-ang)
                              (> p-ang e-ang s-ang)
                            ) ; or
              ) ; setq
            ) ; progn
            (progn
              (setq angtest (or
                              (> p-ang s-ang e-ang)
                              (> s-ang e-ang p-ang)
                              (> e-ang p-ang s-ang)
                            ) ; or
              ) ; setq
            ) ; progn
          ) ; if
        ) ; progn
        (progn
          (setq angtest (inters cen p v1 v2))
        ) ; progn
      ) ; if
      (if (and angtest
               (equal rad rad2 fuzz)
          ) ; and
        (progn
          (setq dat ang1)
        ) ; progn
        (progn
          (setq dat nil)
        ) ; progn
      ) ; if
    ) ; progn
  ) ; if
  dat
) ; test-segment

(defun c:ucr ()
  (setting)
  (ucs-rot)
  (resetting)
  (princ)
) ;_ c:ucr

(prompt "\nEnter UCR to start: ")