请问用lisp能不能画这样的图？

sibelle_hu

我知道像这样的情况可以用块做出来，不知道用lisp能不能行？有没有高手愿意帮我写个？

弧的半径可以设定，根据设定的半径绘制，拾取点为圆弧的中心，箭头的长度等于圆弧半径的一半，箭头的宽度等于三分之一的箭头长，箭头角度为20度左右


该贴已经同步到 sibelle_hu的微博

Q1241274614

你可以参考一下大师的程序 http://lee-mac.com/arrowarc.html

sibelle_hu

谢谢，lisp我不会，刚学会怎么使用lisp程序，这个程序可以画弧形的箭头，可是与我的要求有很多差别的

edata

1. ;; Arc to Bulge  -  Lee Mac
   
2. ;; c     - center
   
3. ;; a1,a2 - start, end angle
   
4. ;; r     - radius
   
5. ;; Returns: (<vertex> <bulge> <vertex>)
   
6. 
   
7. (defun LM:Arc->Bulge ( c a1 a2 r )
   
8.     (list
   
9.         (polar c a1 r)
   
10.         (   (lambda ( a ) (/ (sin a) (cos a)))
    
11.             (/ (rem (+ pi pi (- a2 a1)) (+ pi pi)) 4.0)
    
12.         )
    
13.         (polar c a2 r)
    
14.     )
    
15. )
    
16. ;;绘制圆弧 pt 圆心  r 半径 ang1 起始弧度 ang2 结束弧度 l_lay 图层 l_col 颜色 l_lt 线型 l_lts 线型比例 l_lw 线宽
    
17. ;;(sk_mk_arc01 pt r ang1 ang2 l_lay l_col l_lt l_lts l_lw)
    
18. (defun sk_mk_arc01(pt r ang1 ang2 l_lay l_col l_lt l_lts l_lw)
    
19.   (if(and pt r ang1 ang2)
    
20.     (entmakex (list '(0 . "ARC")
    
21.                     (cons 8 (if l_lay l_lay (getvar 'clayer)))
    
22.                     (if l_col (cons 62 l_col)(cons 62 256))
    
23.                     (if l_lt (cons 6 l_lt)(cons 6 "bylayer"))
    
24.                     (cons 48 (if l_lts l_lts (getvar 'celtscale)))
    
25.                     (if l_lw (cons 370 l_lw)(cons 370 0))
    
26.                     (cons 10 pt)
    
27.                     (cons 40 r)
    
28.                     (cons 50 ang1)
    
29.                     (cons 51 ang2)
    
30.                     )
    
31.                   )
    
32.     )
    
33.   )
    
34. 
    
35. (defun c:tt(/  ANG1 ARC_LEN EN L OBJ P1 P2 PT R W ANG2 BULGE P3)
    
36.   (if(and (setq r(getdist "\n半径:"))
    
37.           (setq pt(getpoint "\n圆心:"))
    
38.           )
    
39.     (progn
    
40.       (setq l(* 0.5 r))
    
41.       (setq w(/ l 3.0))
    
42.       (setq en(sk_mk_arc01 pt r 0 pi nil nil nil nil nil))
    
43.       (setq obj(vlax-ename->vla-object en))
    
44.       (setq arc_len(vla-get-arclength obj))
    
45.       (setq p1(vlax-curve-getstartpoint obj))
    
46.       (setq p2(vlax-curve-getPointAtDist obj (- arc_len l)))
    
47.       (setq p3(vlax-curve-getEndpoint obj))      
    
48.       (setq ang1(angle pt p2 ))
    
49.       (setq ang2 0)
    
50.       (setq bulge(cadr(LM:Arc->Bulge pt ang2 ang1 r)))
    
51.       (vla-delete obj)      
    
52.       (entmakex (list '(0 . "LWPOLYLINE")
    
53.                       '(100 . "AcDbEntity")
    
54.                       '(100 . "AcDbPolyline")
    
55.                       (cons 90 3)
    
56.                       (cons 10 p1)
    
57.                       (cons 42 bulge)
    
58.                       (cons 10 p2)
    
59.                       (cons 40 w)
    
60.                       (cons 41 0)                     
    
61.                       (cons 10 p3)))
    
62.       )
    
63.     )
    
64.   (princ)
    
65.   )
    

;; Arc to Bulge  -  Lee Mac<br /> ;; c     - center<br /> ;; a1,a2 - start, end angle<br /> ;; r     - radius<br /> ;; Returns: (<vertex> <bulge> <vertex>)<br /> <br /> (defun LM:Arc->Bulge ( c a1 a2 r )<br />     (list<br />         (polar c a1 r)<br />         (   (lambda ( a ) (/ (sin a) (cos a)))<br />             (/ (rem (+ pi pi (- a2 a1)) (+ pi pi)) 4.0)<br />         )<br />         (polar c a2 r)<br />     )<br /> )<br /> ;;绘制圆弧 pt 圆心  r 半径 ang1 起始弧度 ang2 结束弧度 l_lay 图层 l_col 颜色 l_lt 线型 l_lts 线型比例 l_lw 线宽<br /> ;;(sk_mk_arc01 pt r ang1 ang2 l_lay l_col l_lt l_lts l_lw)<br /> (defun sk_mk_arc01(pt r ang1 ang2 l_lay l_col l_lt l_lts l_lw)<br />   (if(and pt r ang1 ang2)<br />     (entmakex (list '(0 . "ARC")<br />                     (cons 8 (if l_lay l_lay (getvar 'clayer)))<br />                     (if l_col (cons 62 l_col)(cons 62 256))<br />                     (if l_lt (cons 6 l_lt)(cons 6 "bylayer"))<br />                     (cons 48 (if l_lts l_lts (getvar 'celtscale)))<br />                     (if l_lw (cons 370 l_lw)(cons 370 0))<br />                     (cons 10 pt)<br />                     (cons 40 r)<br />                     (cons 50 ang1)<br />                     (cons 51 ang2)<br />                     )<br />                   )<br />     )<br />   )<br /> <br /> (defun c:tt(/  ANG1 ARC_LEN EN L OBJ P1 P2 PT R W ANG2 BULGE P3)<br />   (if(and (setq r(getdist "\n半径:"))<br />           (setq pt(getpoint "\n圆心:"))<br />           )<br />     (progn<br />       (setq l(* 0.5 r))<br />       (setq w(/ l 3.0))<br />       (setq en(sk_mk_arc01 pt r 0 pi nil nil nil nil nil))<br />       (setq obj(vlax-ename->vla-object en))<br />       (setq arc_len(vla-get-arclength obj))<br />       (setq p1(vlax-curve-getstartpoint obj))<br />       (setq p2(vlax-curve-getPointAtDist obj (- arc_len l)))<br />       (setq p3(vlax-curve-getEndpoint obj))      <br />       (setq ang1(angle pt p2 ))<br />       (setq ang2 0)<br />       (setq bulge(cadr(LM:Arc->Bulge pt ang2 ang1 r)))<br />       (vla-delete obj)      <br />       (entmakex (list '(0 . "LWPOLYLINE")<br />                       '(100 . "AcDbEntity")<br />                       '(100 . "AcDbPolyline")<br />                       (cons 90 3)<br />                       (cons 10 p1)<br />                       (cons 42 bulge)<br />                       (cons 10 p2)<br />                       (cons 40 w)<br />                       (cons 41 0)                      <br />                       (cons 10 p3)))<br />       )<br />     )<br />   (princ)<br />   )<br />

lucas_3333

edata 发表于 2014-8-8 17:30

Ｅ大，厉害！乐于助人！明经的活雷锋！

sibelle_hu

谢谢大师，请问能不能再帮忙加个选项？即输入Ｌ，箭头就在左侧，输入Ｒ箭头就在右侧？

sibelle_hu

edata 发表于 2014-8-8 17:30

大师，能不能也帮帮我这个问题？
http://bbs.mjtd.com/thread-111031-1-1.html

edata

1. ;; Arc to Bulge  -  Lee Mac
   
2. ;; c     - center
   
3. ;; a1,a2 - start, end angle
   
4. ;; r     - radius
   
5. ;; Returns: (<vertex> <bulge> <vertex>)
   
6. 
   
7. (defun LM:Arc->Bulge ( c a1 a2 r )
   
8.     (list
   
9.         (polar c a1 r)
   
10.         (   (lambda ( a ) (/ (sin a) (cos a)))
    
11.             (/ (rem (+ pi pi (- a2 a1)) (+ pi pi)) 4.0)
    
12.         )
    
13.         (polar c a2 r)
    
14.     )
    
15. )
    
16. ;;绘制圆弧 pt 圆心  r 半径 ang1 起始弧度 ang2 结束弧度 l_lay 图层 l_col 颜色 l_lt 线型 l_lts 线型比例 l_lw 线宽
    
17. ;;(sk_mk_arc01 pt r ang1 ang2 l_lay l_col l_lt l_lts l_lw)
    
18. (defun sk_mk_arc01(pt r ang1 ang2 l_lay l_col l_lt l_lts l_lw )
    
19.   (if(and pt r ang1 ang2)
    
20.     (entmakex (list '(0 . "ARC")
    
21.                     (cons 8 (if l_lay l_lay (getvar 'clayer)))
    
22.                     (if l_col (cons 62 l_col)(cons 62 256))
    
23.                     (if l_lt (cons 6 l_lt)(cons 6 "bylayer"))
    
24.                     (cons 48 (if l_lts l_lts (getvar 'celtscale)))
    
25.                     (if l_lw (cons 370 l_lw)(cons 370 0))
    
26.                     (cons 10 pt)
    
27.                     (cons 40 r)
    
28.                     (cons 50 ang1)
    
29.                     (cons 51 ang2)
    
30.                     )
    
31.                   )
    
32.     )
    
33.   )
    
34. 
    
35. (defun c:tt(/  ANG1 ARC_LEN EN L OBJ P1 P2 PT R W ANG2 BULGE P3 keys)
    
36.   (or *sk_rad_jt001* (setq *sk_rad_jt001* 10.0))
    
37.   (setq *sk_rad_jt001*(cond((getdist (strcat "\n输入半径<" (rtos *sk_rad_jt001* 2 4) ">:")))(*sk_rad_jt001*)))
    
38.   (princ (strcat "\r当前半径<" (rtos *sk_rad_jt001* 2 4) ">:"))
    
39.   (if(setq pt(getpoint "\n圆心:"))
    
40.     (progn
    
41.       (setq r *sk_rad_jt001*)
    
42.       (initget "L R _l r")      
    
43.       (setq keys(cond((getkword "\r输入左右方向[L/R]<L>: "))("l")))
    
44.       (setq l(* 0.5 r))
    
45.       (setq w(/ l 3.0))
    
46.       (setq en(sk_mk_arc01 pt r 0 pi nil nil nil nil nil))
    
47.       (setq obj(vlax-ename->vla-object en))
    
48.       (setq arc_len(vla-get-arclength obj))
    
49.       (setq p1(if (= keys "l") (vlax-curve-getstartpoint obj) (vlax-curve-getEndpoint obj)))
    
50.       (setq p2(vlax-curve-getPointAtDist obj (if (= keys "l") (- arc_len l) l)))
    
51.       (setq p3(if (= keys "l") (vlax-curve-getEndpoint obj)(vlax-curve-getstartpoint obj) ))      
    
52.       (setq ang1(angle pt p2 ))
    
53.       (setq ang2 (if (= keys "l") 0 pi ))
    
54.       (setq bulge(cadr(LM:Arc->Bulge pt (if (= keys "l") ang2 ang1 ) (if (= keys "l") ang1 ang2 ) r)))
    
55.       (vla-delete obj)      
    
56.       (entmakex (list '(0 . "LWPOLYLINE")
    
57.                       '(100 . "AcDbEntity")
    
58.                       '(100 . "AcDbPolyline")
    
59.                       (cons 90 3)
    
60.                       (cons 10 p1)
    
61.                       (cons 42 (if (= keys "l") bulge (* -1.0 bulge) ))
    
62.                       (cons 10 p2)
    
63.                       (cons 40 w)
    
64.                       (cons 41 0)                     
    
65.                       (cons 10 p3)))
    
66.       )
    
67.     )
    
68.   (princ)
    
69.   )

;; Arc to Bulge  -  Lee Mac<br /> ;; c     - center<br /> ;; a1,a2 - start, end angle<br /> ;; r     - radius<br /> ;; Returns: (<vertex> <bulge> <vertex>)<br /> <br /> (defun LM:Arc->Bulge ( c a1 a2 r )<br />     (list<br />         (polar c a1 r)<br />         (   (lambda ( a ) (/ (sin a) (cos a)))<br />             (/ (rem (+ pi pi (- a2 a1)) (+ pi pi)) 4.0)<br />         )<br />         (polar c a2 r)<br />     )<br /> )<br /> ;;绘制圆弧 pt 圆心  r 半径 ang1 起始弧度 ang2 结束弧度 l_lay 图层 l_col 颜色 l_lt 线型 l_lts 线型比例 l_lw 线宽<br /> ;;(sk_mk_arc01 pt r ang1 ang2 l_lay l_col l_lt l_lts l_lw)<br /> (defun sk_mk_arc01(pt r ang1 ang2 l_lay l_col l_lt l_lts l_lw )<br />   (if(and pt r ang1 ang2)<br />     (entmakex (list '(0 . "ARC")<br />                     (cons 8 (if l_lay l_lay (getvar 'clayer)))<br />                     (if l_col (cons 62 l_col)(cons 62 256))<br />                     (if l_lt (cons 6 l_lt)(cons 6 "bylayer"))<br />                     (cons 48 (if l_lts l_lts (getvar 'celtscale)))<br />                     (if l_lw (cons 370 l_lw)(cons 370 0))<br />                     (cons 10 pt)<br />                     (cons 40 r)<br />                     (cons 50 ang1)<br />                     (cons 51 ang2)<br />                     )<br />                   )<br />     )<br />   )<br /> <br /> (defun c:tt(/  ANG1 ARC_LEN EN L OBJ P1 P2 PT R W ANG2 BULGE P3 keys)<br />   (or *sk_rad_jt001* (setq *sk_rad_jt001* 10.0))<br />   (setq *sk_rad_jt001*(cond((getdist (strcat "\n输入半径<" (rtos *sk_rad_jt001* 2 4) ">:")))(*sk_rad_jt001*)))<br />   (princ (strcat "\r当前半径<" (rtos *sk_rad_jt001* 2 4) ">:"))<br />   (if(setq pt(getpoint "\n圆心:"))<br />     (progn<br />       (setq r *sk_rad_jt001*)<br />       (initget "L R _l r")      <br />       (setq keys(cond((getkword "\r输入左右方向[L/R]<L>: "))("l")))<br />       (setq l(* 0.5 r))<br />       (setq w(/ l 3.0))<br />       (setq en(sk_mk_arc01 pt r 0 pi nil nil nil nil nil))<br />       (setq obj(vlax-ename->vla-object en))<br />       (setq arc_len(vla-get-arclength obj))<br />       (setq p1(if (= keys "l") (vlax-curve-getstartpoint obj) (vlax-curve-getEndpoint obj)))<br />       (setq p2(vlax-curve-getPointAtDist obj (if (= keys "l") (- arc_len l) l)))<br />       (setq p3(if (= keys "l") (vlax-curve-getEndpoint obj)(vlax-curve-getstartpoint obj) ))      <br />       (setq ang1(angle pt p2 ))<br />       (setq ang2 (if (= keys "l") 0 pi ))<br />       (setq bulge(cadr(LM:Arc->Bulge pt (if (= keys "l") ang2 ang1 ) (if (= keys "l") ang1 ang2 ) r)))<br />       (vla-delete obj)      <br />       (entmakex (list '(0 . "LWPOLYLINE")<br />                       '(100 . "AcDbEntity")<br />                       '(100 . "AcDbPolyline")<br />                       (cons 90 3)<br />                       (cons 10 p1)<br />                       (cons 42 (if (= keys "l") bulge (* -1.0 bulge) ))<br />                       (cons 10 p2)<br />                       (cons 40 w)<br />                       (cons 41 0)                      <br />                       (cons 10 p3)))<br />       )<br />     )<br />   (princ)<br />   )

sibelle_hu

edata 发表于 2014-8-8 20:35

大师，非常好！谢谢了！

ysq101

Z版主直接给了鱼
我来点思路，楼主想学LIPS还是自己动手来吧
说说我的思路：
2段多线段   修改剪头部分的线宽即可
自己研究一下吧

其它箭头可以做成动态的好点吧