Some one can help me ?

Some one can help me ?

Anonymous
Not applicable
364 Views
1 Reply
Message 1 of 2

Some one can help me ?

Anonymous
Not applicable

 Hi all
Have a routine like this?

gif.gif

 

 use dialog to choose 

dcl.png

 

symbol: A,B,C,D......Z
scale: 1:1 , 1:1.5 ,1:2 ,1:2.5 ,1:3 ,1:4 ,1:5 ,1:10 and 2:1 , 2.5:1 , 4:1 , 5:1 ,10:1 
Dir.of rotation: left rotation , right rotation , and rotation 

 

example

 

sy.png

 

1. symbol "A" , scale"5:1" , "left rotation"
2. symbol "B" , scale "10:1" ,"right rotation"
3. symbol "B" , scale "10:1" , "rotation"

 

The height of rotating symbol (with arrow)= The text height 

 

This is a complete example.

 

draw.png

 

 

Thanks Alberto

0 Likes
365 Views
1 Reply
Reply (1)
Message 2 of 2

marko_ribar
Advisor
Advisor

For arrow label, you can try this :

 

(defun c:arrowlabel ( / *error* _acapp _getosmode _grX _OLE->ACI _OLE->RGB _RGB->ACI _snap _polarangs _polar _ortho 
                         osm ape as a b l s pp txt otxts arrowent txtent gr gp gpp gps ang )

  (vl-load-com)

  (defun *error* ( msg )
    (if ape (setvar 'aperture ape))
    (if as (setvar 'autosnap as))
    (if osm (setvar 'osmode osm))
    (if msg (prompt msg))
    (redraw)
    (princ)
  )

  (defun _acapp nil
      (eval (list 'defun '_acapp 'nil (vlax-get-acad-object)))
      (_acapp)
  )

  (defun _getosmode ( os / lst )
      (foreach mode
         '(
              (0001 . "_end")
              (0002 . "_mid")
              (0004 . "_cen")
              (0008 . "_nod")
              (0016 . "_qua")
              (0032 . "_int")
              (0064 . "_ins")
              (0128 . "_per")
              (0256 . "_tan")
              (0512 . "_nea")
              (1024 . "_qui")
              (2048 . "_app")
              (4096 . "_ext")
              (8192 . "_par")
          )
          (if (not (zerop (logand (car mode) os)))
              (setq lst (cons "," (cons (cdr mode) lst)))
          )
      )
      (apply 'strcat (cdr lst))
  )

  (defun _grX ( p s c / -s r j )
      (setq -s (- s)
             r (/ (getvar 'viewsize) (cadr (getvar 'screensize)))
             j p
      )
      (grdraw (mapcar '+ j (list (* r -s) (* r -s))) (mapcar '+ j (list (* r s) (* r s))) c)
      (grdraw (mapcar '+ j (list (* r -s) (* r (1+ -s)))) (mapcar '+ j (list (* r (1- s)) (* r s))) c)
      (grdraw (mapcar '+ j (list (* r (1+ -s)) (* r -s))) (mapcar '+ j (list (* r s) (* r (1- s)))) c)
      
      (grdraw (mapcar '+ j (list (* r -s) (* r s))) (mapcar '+ j (list (* r s) (* r -s))) c)
      (grdraw (mapcar '+ j (list (* r -s) (* r (1- s)))) (mapcar '+ j (list (* r (1- s)) (* r -s))) c)
      (grdraw (mapcar '+ j (list (* r (1+ -s)) (* r s))) (mapcar '+ j (list (* r s) (* r (1+ -s)))) c)

      p
  )

  (defun _OLE->ACI ( c )
      (apply '_RGB->ACI (_OLE->RGB c))
  )

  (defun _OLE->RGB ( c )
      (mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(24 16 8))
  )

  (defun _RGB->ACI ( r g b / c o )
      (if (setq o (vla-getinterfaceobject (_acapp) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2))))
          (progn
              (setq c (vl-catch-all-apply '(lambda ( ) (vla-setrgb o r g b) (vla-get-colorindex o))))
              (vlax-release-object o)
              (if (vl-catch-all-error-p c)
                  (prompt (strcat "\nError: " (vl-catch-all-error-message c)))
                  c
              )
          )
      )
  )

  (defun _snap ( p osm )
    (if (osnap p (_getosmode osm))
      (osnap p (_getosmode osm))
      p
    )
  )

  (defun _polarangs ( ang / n k a l )
    (if (/= ang 0.0)
      (progn
        (setq n (/ 360.1 (cvunit ang "radians" "degrees")))
        (setq k -1.0)
        (repeat (1+ (fix n))
          (setq a (* (setq k (1+ k)) ang))
          (setq l (cons a l))
        )
        l
      )
      (list 0.0)
    )
  )

  (defun _polar ( p0 p flag ang / a b an )
    (if flag
      (progn
        (setq a (car (vl-sort (_polarangs ang) '(lambda ( a b ) (< a (angle p0 p) b)))))
        (setq b (last (vl-sort (_polarangs ang) '(lambda ( a b ) (< a (angle p0 p) b)))))
        (if (< (abs (- (angle p0 p) a)) (abs (- (angle p0 p) b))) (setq an a) (setq an b))
        (inters p0 (polar p0 an 1.0) p (polar p (+ an (* 0.5 pi)) 1.0) nil)
      )
      p
    )
  )

  (defun _ortho ( p0 p flag )
    (if flag
      (_polar p0 p t (* 0.5 pi))
      p
    )
  )

  (command "_.ucs" "_W")
  (setvar 'orthomode 1)
  (setq ape (getvar 'aperture))
  (setvar 'aperture 40)
  (setq as (getvar 'autosnap))
  (setvar 'autosnap 31)
  (setq osm (getvar 'osmode))
  (setvar 'osmode 15359)
  (if (eq (getvar 'orthomode) 1) (setq o t) (setq o nil))
  (if (eq (logand (getvar 'autosnap) 8) 8) (setq p t) (setq p nil))
  (if (eq (logand (getvar 'autosnap) 16) 16) (setq s t) (setq s nil))
  (setq otxts (getvar 'textsize))
  (initget 6)
  (setq a (getdist (strcat "\nSpecify height for text <" (rtos otxts) "> : ")))
  (if (null a) (setq a otxts))
  (setq b (/ a 2.0))
  (if (not (tblsearch "BLOCK" "ARROW"))
    (progn
      (setq l (entmakex (list '(0 . "LINE") (cons 10 (list 0.0 0.0 0.0)) (cons 11 (list (* a 2.0) 0.0 0.0)))))
      (setq s (entmakex (list '(0 . "SOLID") (cons 10 (polar (list (* a 2.0) 0.0 0.0) (+ pi (/ pi 12.0)) b)) (cons 11 (list (* a 2.0) 0.0 0.0)) (cons 12 (polar (list (* a 2.0) 0.0 0.0) (- pi (/ pi 12.0)) b)) (cons 13 (polar (list (* a 2.0) 0.0 0.0) (- pi (/ pi 12.0)) b)))))
      (command "_.block" "arrow" '(0.0 0.0 0.0) (ssadd s (ssadd l)) "")
    )
  )
  (initget 1)
  (setq txt (getstring "\nSpecify label symbol : "))
  (setq txt (substr txt 1 1))
  (initget 1)
  (setq pp (getpoint "\nPick point : "))
  (setvar 'textsize a)
  (command "_.insert" "arrow" pp "" "" 0.0)
  (setq arrowent (entlast))
  (command "_.text" "_j" "_mc" (polar pp pi a) "" 0.0 txt)
  (setq txtent (entlast))
  (while (/= 3 (car (setq gr (grread t 15 0))))
    (redraw)
    (if (listp (cadr gr))
      (progn
        (setq gp (cadr gr))
        (setq gpp (cadr gr))
        (if gps (setq ang (angle pp gps)) (setq ang (angle pp gp)))
        (entmod (subst (cons 50 ang) (assoc 50 (entget arrowent)) (entget arrowent)))
        (entupd arrowent)
        (entmod (subst (cons 11 (polar pp (+ pi ang) a)) (assoc 11 (entget txtent)) (entget txtent)))
        (entupd txtent)
      )
    )
    (cond 
      ( (eq (cadr gr) 15)
        (if (eq o t) (setq o nil) (setq o t))
      )
      ( (eq (cadr gr) 21)
        (if (eq p t) (setq p nil) (setq p t))
      )
      ( (eq (cadr gr) 6)
        (if (eq s t) (setq s nil) (setq s t))
      )
    )
    (cond
      ( (and o p s)
        (setq gps (_snap (_ortho pp gp t) (getvar 'osmode)))
      )
      ( (and o (not p) s)
        (setq gps (_snap (_ortho pp gp t) (getvar 'osmode)))
      )
      ( (and (not o) p s)
        (setq gps (_snap (_polar pp gp t (getvar 'polarang)) (getvar 'osmode)))
      )
      ( (and (not o) (not p) s)
        (setq gps (_snap gp (getvar 'osmode)))
      )
      ( (and o p (not s))
        (setq gps (_ortho pp gp t))
      )
      ( (and o (not p) (not s))
        (setq gps (_ortho pp gp t))
      )
      ( (and (not o) p (not s))
        (setq gps (_polar pp gp t (getvar 'polarang)))
      )
      ( (and (not o) (not p) (not s))
        (setq gps gp)
      )
    )
    (if (not (equal gps gpp 1e-6))
      (_grX gps (atoi (getenv "AutoSnapSize")) (_OLE->ACI (if (= 1 (getvar 'cvport)) (atoi (getenv "Layout AutoSnap Color")) (atoi (getenv "Model AutoSnap Color")))))
    )
  )
  (setvar 'textsize otxts)
  (*error* nil)
  (command "_.ucs" "_P")
  (princ)
)

 And for rotation label, I leave to someone else to do the job...

HTH, just a little...

 

M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)
0 Likes