Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Some one can help me ?

1 REPLY 1
Reply
Message 1 of 2
AIberto
276 Views, 1 Reply

Some one can help me ?

 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

1 REPLY 1
Message 2 of 2
marko_ribar
in reply to: AIberto

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)

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost