[分享]：漂亮的大箭头

841594

前一阵看到老外作的分析图，箭头特别漂亮，于是琢磨着自己编了一个画此箭头的程序，大家分享：
(defun c:tar (/ pt1 pt2 pt3 len oplw)
  (setq oplw (getvar "plinewid"))
  (and
    (setq pt1 (getpoint "尖点: "))
    (setq pt2 (getpoint pt1 "脖点: "))
    (progn
      (setq len (distance pt1 pt2))
      (command "pline" pt1 "w" 0 (* 1.8 len) pt2)
      (command "w" (* 0.4 len) (* 1.3 len) "a")
      (princ "\n结束点: ")
      (command pause "")
    )
  )
  (setvar "plinewid" oplw)
)

cccfly

很好 可是怎么用呢？？

陌生人

最初由 cccfly 发布
[B]很好 可是怎么用呢？？ [/B]

真是没治了....

Qlin

简单，不过有用。
帮你稍稍整理了一下：
[php]
(defun c:tar (/ pt1 pt2 pt3 len oplw os)
  (setq oplw (getvar "plinewid")
        os (getvar "osmode"))
  (setvar "osmode" 0)
  (setvar "cmdecho" 0)
  (if (and (setq pt1 (getpoint "\n尖点: "))
           (setq pt2 (getpoint pt1 "脖点: ")))
    (progn
      (setq len (distance pt1 pt2))
      (command "_.pline" pt1 "w" 0 (* 1.8 len) pt2)
      (command "w" (* 0.4 len) (* 1.3 len) "a")
      (princ "\n结束点: ")
      (command pause)
      (if (= (getvar "cmdnames") "PLINE")
        (command "")
        (entdel (entlast))
      );if
    )
  )
  (setvar "plinewid" oplw)
  (setvar "osmode" os)
  (setvar "cmdecho" 1)
  (princ)
)
[/php]

cxzr8

不错，指示很清楚；
谢过

talkershadows

试过了！！
好用！！！省分析图不少事情哦～～～

andyhua5240

我来个附件！
用APPLOAD加载到CAD，命令是TAR

talkershadows

呵呵，谢谢各位大大，
这几天画分析图正好用上^_^

aeo

[php]
(defun c:jjj (/ pt1 pt2 pt3 len oplw os getpt2)
(defun getpt2(pt1 / ang dis pt2 pt3 pt4)
   (while (not pt2)
      (setq pt2(grread t))
      (cond((= (car pt2)3)(setq pt2(cadr pt2)))
           ((=(car pt2)5)
             (setq pt2(cadr pt2)
                   ang (angle pt1 pt2)
                   dis(* 0.9(distance pt1 pt2))
                   pt3(polar pt2(+ ang (* 0.5 pi))dis)
                   pt4(polar pt2(- ang(* 0.5 pi))dis)
              )
             (redraw)
             (grvecs (list 256 pt1 pt3 256 pt1 pt4 256 pt3 pt4))
             (setq pt2 nil)
            )
           (t(setq pt2 nil))
   )))
  (setq oplw (getvar "plinewid")
        os (getvar "osmode"))
  (setvar "osmode" 0)
  (setvar "cmdecho" 0)
  (if (and (setq pt1 (getpoint "\n尖点: "))
           (princ "脖点: ")
           (setq pt2 (getpt2 pt1)))
    (progn
      (setq len (distance pt1 pt2))
      (command "_.pline" pt1 "w" 0 (* 1.8 len) pt2)
      (command "w" (* 0.4 len) (* 1.3 len) "a")
      (princ "\n结束点: ")
      (command pause)
      (if (= (getvar "cmdnames") "PLINE")
        (command "")
        (entdel (entlast))
      )
    )
  )
  (setvar "plinewid" oplw)
  (setvar "osmode" os)
  (setvar "cmdecho" 1)
  (princ)
)
[/php]

脖点的时候加入预览，但不是很好，不好控制方向了.
如果用理正的"dragx"写就好了.

晓东看见此贴，我要求的函数，就是(getpt2)里要求实现的.
要求:可以输入尺寸,字母，F8  F10.

wyq7811

能解释一下getpt2函数的过程吗？看不太懂

陌生人

aeo：
加入预览不好控制方向了.－－－指什么？我用起来觉得方向没问题啊
(getpt2) 要求:可以输入尺寸,字母，F8 F10. －－－这个F8,F10是干什么的？控制正交和极轴么？

aeo

1. 
   
2. (有pt2时while结束,不然while
   
3.   (cond
   
4.       (＝3 ，按了左键，就有pt2了)
   
5.       (＝ 5 ，拖动，预演一下，最后pt2=nil,还要while下去)
   
6.       (按其他键pt2=nil  while下去)
   
7.   )
   
8. )

复制代码

没加入按确认的情况，不周全.


陌生人 :
有的时候，就要画一个很精确的尺寸，和很精确的方向，grread是没办法，（可以，但太土了)

陌生人

呵呵，你真认真。一般画箭头是指示性的，要用到精确角度的还没见过，也许是我专业局限所至吧。不过作为程序倒可以研究一下：）

舍我其谁

这个玩意儿好用！在分析风向的时候蛮管用的！谢谢呀

841594

保持箭头头部长度的功能是重要的，不增加操作步骤也很重要。
修改如下：
程序能够记忆上次的箭头长度，按任意键重定长度：

2. 
   
3.   [FONT=courier new]
   
4. (defun c:jjj (/ pt1 pt2 pt3 len oplw os getpt2)
   
5. 
   
6.   (defun getpt2        (pt1 / ang dis pt2 pt3 pt4)
   
7.     (while (not pt2)
   
8.       (setq pt2 (grread t))
   
9.       (cond ((= (car pt2) 3)
   
10.              (setq pt2 (cadr pt2))
    
11.              (if $tar_dist
    
12.                (setq pt2 (polar pt1 (angle pt1 pt2) $tar_dist))
    
13.              )
    
14.             )
    
15.             ((= (car pt2) 5)
    
16.              (setq pt2 (cadr pt2)
    
17.                    ang (angle pt1 pt2)
    
18.              )
    
19.              (if $tar_dist
    
20.                (setq pt2 (polar pt1 ang $tar_dist))
    
21.              )
    
22.              (setq dis (* 0.9 (distance pt1 pt2))
    
23.                    pt3 (polar pt2 (+ ang (* 0.5 pi)) dis)
    
24.                    pt4 (polar pt2 (- ang (* 0.5 pi)) dis)
    
25.              )
    
26.              (redraw)
    
27.              (grvecs (list 256 pt1 pt3 256 pt1 pt4 256 pt3 pt4))
    
28.              (setq pt2 nil)
    
29.             )
    
30.             ((= (car pt2) 2)
    
31.              (setq $tar_dist nil
    
32.                    pt2 nil
    
33.              )
    
34.             )
    
35.             (t (setq pt2 nil))
    
36.       )
    
37.     )
    
38.     pt2
    
39.   )
    
40. 
    
41. 
    
42.   (setq        oplw (getvar "plinewid")
    
43.         os   (getvar "osmode")
    
44.   )
    
45.   (setvar "osmode" 0)
    
46.   (setvar "cmdecho" 0)
    
47.   (if (and (setq pt1 (getpoint "\n尖点: "))
    
48.            (princ "脖点: ")
    
49.            (setq pt2 (getpt2 pt1))
    
50.       )
    
51.     (progn
    
52.       (setq len              (distance pt1 pt2)
    
53.             $tar_dist len
    
54.       )
    
55.       (command "_.pline" pt1 "w" 0 (* 1.8 len) pt2)
    
56.       (command "w" (* 0.4 len) (* 1.3 len) "a")
    
57.       (princ "\n结束点: ")
    
58.       (command pause)
    
59.       (if (= (getvar "cmdnames") "PLINE")
    
60.         (command "")
    
61.         (entdel (entlast))
    
62.       )
    
63.     )
    
64.   )
    
65.   (setvar "plinewid" oplw)
    
66.   (setvar "osmode" os)
    
67.   (setvar "cmdecho" 1)
    
68.   (princ)
    
69. )
    
70. 
    
71.   [/FONT]
    

<br />   [FONT=courier new]<br /> (defun c:jjj (/ pt1 pt2 pt3 len oplw os getpt2)<br /> <br />   (defun getpt2        (pt1 / ang dis pt2 pt3 pt4)<br />     (while (not pt2)<br />       (setq pt2 (grread t))<br />       (cond ((= (car pt2) 3)<br />              (setq pt2 (cadr pt2))<br />              (if $tar_dist<br />                (setq pt2 (polar pt1 (angle pt1 pt2) $tar_dist))<br />              )<br />             )<br />             ((= (car pt2) 5)<br />              (setq pt2 (cadr pt2)<br />                    ang (angle pt1 pt2)<br />              )<br />              (if $tar_dist<br />                (setq pt2 (polar pt1 ang $tar_dist))<br />              )<br />              (setq dis (* 0.9 (distance pt1 pt2))<br />                    pt3 (polar pt2 (+ ang (* 0.5 pi)) dis)<br />                    pt4 (polar pt2 (- ang (* 0.5 pi)) dis)<br />              )<br />              (redraw)<br />              (grvecs (list 256 pt1 pt3 256 pt1 pt4 256 pt3 pt4))<br />              (setq pt2 nil)<br />             )<br />             ((= (car pt2) 2)<br />              (setq $tar_dist nil<br />                    pt2 nil<br />              )<br />             )<br />             (t (setq pt2 nil))<br />       )<br />     )<br />     pt2<br />   )<br /> <br /> <br />   (setq        oplw (getvar "plinewid")<br />         os   (getvar "osmode")<br />   )<br />   (setvar "osmode" 0)<br />   (setvar "cmdecho" 0)<br />   (if (and (setq pt1 (getpoint "\n尖点: "))<br />            (princ "脖点: ")<br />            (setq pt2 (getpt2 pt1))<br />       )<br />     (progn<br />       (setq len              (distance pt1 pt2)<br />             $tar_dist len<br />       )<br />       (command "_.pline" pt1 "w" 0 (* 1.8 len) pt2)<br />       (command "w" (* 0.4 len) (* 1.3 len) "a")<br />       (princ "\n结束点: ")<br />       (command pause)<br />       (if (= (getvar "cmdnames") "PLINE")<br />         (command "")<br />         (entdel (entlast))<br />       )<br />     )<br />   )<br />   (setvar "plinewid" oplw)<br />   (setvar "osmode" os)<br />   (setvar "cmdecho" 1)<br />   (princ)<br /> )<br /> <br />   [/FONT]<br />