[编程交流] 查看方向（帮助）

;; Arc to Bulge  -  Lee Mac
;; c     - center
;; a1,a2 - start, end angle
;; r     - radius
;; Returns: (<vertex> <bulge> <vertex>)
(defun LM:Arc->Bulge ( c a1 a2 r )
   (list
       (polar c a1 r)
       (   (lambda ( a ) (/ (sin a) (cos a)))
           (/ (rem (+ pi pi (- a2 a1)) (+ pi pi)) 4.0)
       )
       (polar c a2 r)
   )
)
;;(sk_mk_arc01 pt r ang1 ang2 l_lay l_col l_lt l_lts l_lw)
(defun sk_mk_arc01(pt r ang1 ang2 l_lay l_col l_lt l_lts l_lw)
 (if(and pt r ang1 ang2)
   (entmakex (list '(0 . "ARC")
                   (cons 8 (if l_lay l_lay (getvar 'clayer)))
                   (if l_col (cons 62 l_col)(cons 62 256))
                   (if l_lt (cons 6 l_lt)(cons 6 "bylayer"))
                   (cons 48 (if l_lts l_lts (getvar 'celtscale)))
                   (if l_lw (cons 370 l_lw)(cons 370 0))
                   (cons 10 pt)
                   (cons 40 r)
                   (cons 50 ang1)
                   (cons 51 ang2)
                   )
                 )
   )
 )
(vl-load-com) 
(defun c:tt(/  ANG1 ARC_LEN EN L OBJ P1 P2 PT R W ANG2 BULGE P3)
 (if(and (setq r(getdist "\nRadius:"));; Radius = text height
         (setq pt(getpoint "\nCenter:"));;Placement point
         )
   (progn
     (setq l(* 0.5 r))
     (setq w(/ l 3.0))
     (setq en(sk_mk_arc01 pt r 0 pi nil nil nil nil nil))
     (setq obj(vlax-ename->vla-object en))
     (setq arc_len(vla-get-arclength obj))
     (setq p1(vlax-curve-getstartpoint obj))
     (setq p2(vlax-curve-getPointAtDist obj (- arc_len l)))
     (setq p3(vlax-curve-getEndpoint obj))      
     (setq ang1(angle pt p2 ))
     (setq ang2 0)
     (setq bulge(cadr(LM:Arc->Bulge pt ang2 ang1 r)))
     (vla-delete obj)      
     (entmakex (list '(0 . "LWPOLYLINE")
                     '(100 . "AcDbEntity")
                     '(100 . "AcDbPolyline")
                     (cons 90 3)
                     (cons 10 p1)
                     (cons 42 bulge)
                     (cons 10 p2)
                     (cons 40 w)
                     (cons 41 0)                      
                     (cons 10 p3)))
     )
   )
 (princ)
 )

;; Arc to Bulge  -  Lee Mac
;; c     - center
;; a1,a2 - start, end angle
;; r     - radius
;; Returns: (<vertex> <bulge> <vertex>)
(defun LM:Arc->Bulge ( c a1 a2 r )
   (list
       (polar c a1 r)
       (   (lambda ( a ) (/ (sin a) (cos a)))
           (/ (rem (+ pi pi (- a2 a1)) (+ pi pi)) 4.0)
       )
       (polar c a2 r)
   )
)
;;(sk_mk_arc01 pt r ang1 ang2 l_lay l_col l_lt l_lts l_lw)
(defun sk_mk_arc01(pt r ang1 ang2 l_lay l_col l_lt l_lts l_lw )
 (if(and pt r ang1 ang2)
   (entmakex (list '(0 . "ARC")
                   (cons 8 (if l_lay l_lay (getvar 'clayer)))
                   (if l_col (cons 62 l_col)(cons 62 256))
                   (if l_lt (cons 6 l_lt)(cons 6 "bylayer"))
                   (cons 48 (if l_lts l_lts (getvar 'celtscale)))
                   (if l_lw (cons 370 l_lw)(cons 370 0))
                   (cons 10 pt)
                   (cons 40 r)
                   (cons 50 ang1)
                   (cons 51 ang2)
                   )
                 )
   )
 )
(defun c:tt(/  ANG1 ARC_LEN EN L OBJ P1 P2 PT R W ANG2 BULGE P3 keys)
 (or *sk_rad_jt001* (setq *sk_rad_jt001* 10.0))
 (setq *sk_rad_jt001*(cond((getdist (strcat "\nRadius<" (rtos *sk_rad_jt001* 2 4) ">:")))(*sk_rad_jt001*)))
 (princ (strcat "\rCurrent Radius<" (rtos *sk_rad_jt001* 2 4) ">:"))
 (if(setq pt(getpoint "\nCenter:"))
   (progn
     (setq r *sk_rad_jt001*)
     (initget "L R _l r")      
     (setq keys(cond((getkword "\rDirection of arrow[L/R]<L>: "))("l")))
     (setq l(* 0.5 r))
     (setq w(/ l 3.0))
     (setq en(sk_mk_arc01 pt r 0 pi nil nil nil nil nil))
     (setq obj(vlax-ename->vla-object en))
     (setq arc_len(vla-get-arclength obj))
     (setq p1(if (= keys "l") (vlax-curve-getstartpoint obj) (vlax-curve-getEndpoint obj)))
     (setq p2(vlax-curve-getPointAtDist obj (if (= keys "l") (- arc_len l) l)))
     (setq p3(if (= keys "l") (vlax-curve-getEndpoint obj)(vlax-curve-getstartpoint obj) ))      
     (setq ang1(angle pt p2 ))
     (setq ang2 (if (= keys "l") 0 pi ))
     (setq bulge(cadr(LM:Arc->Bulge pt (if (= keys "l") ang2 ang1 ) (if (= keys "l") ang1 ang2 ) r)))
     (vla-delete obj)      
     (entmakex (list '(0 . "LWPOLYLINE")
                     '(100 . "AcDbEntity")
                     '(100 . "AcDbPolyline")
                     (cons 90 3)
                     (cons 10 p1)
                     (cons 42 (if (= keys "l") bulge (* -1.0 bulge) ))
                     (cons 10 p2)
                     (cons 40 w)
                     (cons 41 0)                      
                     (cons 10 p3)))
     )
   )
 (princ)
 )