(XD::Pnt:DrawArrow)绘制一个方向箭头

Free-Lancer

1. (defun XD::Pnt:DrawArrow (p v / an p1 p2 p3)
   
2.   (setq        an (angle '(0. 0. 0.) v)
   
3.         p1 (polar p an (* 0.25 (getvar "viewsize")))
   
4.         p2 (polar p1 (+ an (* 0.833333 pi)) (/ (distance p p1) 6.))
   
5.         p3 (polar p1 (- an (* 0.833333 pi)) (/ (distance p p1) 6.))
   
6.   )
   
7.   (grvecs (list 1 p p1 1 p1 p2 1 p1 p3))
   
8.   t
   
9. )

(defun XD::Pnt:DrawArrow (p v / an p1 p2 p3)<br />   (setq        an (angle '(0. 0. 0.) v)<br />         p1 (polar p an (* 0.25 (getvar "viewsize")))<br />         p2 (polar p1 (+ an (* 0.833333 pi)) (/ (distance p p1) 6.))<br />         p3 (polar p1 (- an (* 0.833333 pi)) (/ (distance p p1) 6.))<br />   )<br />   (grvecs (list 1 p p1 1 p1 p2 1 p1 p3))<br />   t<br /> )

/db_自贡黄明儒_

我是用leader实现的，简单。无需编程。{:soso_e113:}
你这个实用性怎么样？

st788796

/db_自贡黄明儒_ 发表于 2014-9-22 10:39
我是用leader实现的，简单。无需编程。
你这个实用性怎么样？

楼主是在这用的

                               
登录/注册后可看大图

Lisphk

能不能形状在酷点{:soso_e104:}

st788796

Lisphk 发表于 2014-9-22 11:00
能不能形状在酷点

试试这个

1. (defun XD::Pnt:DrawArrow
   
2.        (p v col / an an1 h h1 d1 d2 p1 p2 p3 p4 p5 p6 p7)
   
3.   (setq        an  (angle '(0. 0. 0.) v)
   
4.         an1 (+ an (/ pi 2))
   
5.         h   (getvar "viewsize")
   
6.         h1  (/ h 80.)
   
7.         d1  (* 0.25 (getvar "viewsize"))
   
8.         d2  (* d1 0.7)
   
9. 
   
10.         p1  (polar p an1 h1)
    
11.         p2  (polar p1 an d2)
    
12.         p3  (polar p2 an1 h1)
    
13. 
    
14.         p4  (polar p an d1)
    
15. 
    
16.         p5  (polar p (+ an1 pi) h1)
    
17.         p6  (polar p5 an d2)
    
18.         p7  (polar p6 (+ an1 pi) h1)
    
19. 
    
20.   )
    
21.   (grvecs (list        col p5 p1 col p1 p2 col        p2 p3 col p3 p4        col p4 p7 col p7
    
22.                 p6 col p6 p5)
    
23.   )
    
24.   t
    
25. )
    
26. (defun c:tt (/ i e p pam vec)
    
27.   (setq i -1)
    
28.   (while (setq e (entsel "\nPick curve: "))
    
29.     (setq i   (1+ i)
    
30.           p   (apply 'vlax-curve-getclosestpointto e)
    
31.           pam (vlax-curve-getparamatpoint (car e) p)
    
32.           vec (vlax-curve-getfirstderiv (car e) pam)
    
33.     )
    
34.     (xd::pnt:drawarrow p vec i)
    
35.   )
    
36.   (redraw)
    
37.   (princ)
    
38. )

(defun XD::Pnt:DrawArrow<br />        (p v col / an an1 h h1 d1 d2 p1 p2 p3 p4 p5 p6 p7)<br />   (setq        an  (angle '(0. 0. 0.) v)<br />         an1 (+ an (/ pi 2))<br />         h   (getvar "viewsize")<br />         h1  (/ h 80.)<br />         d1  (* 0.25 (getvar "viewsize"))<br />         d2  (* d1 0.7)<br /> <br />         p1  (polar p an1 h1)<br />         p2  (polar p1 an d2)<br />         p3  (polar p2 an1 h1)<br /> <br />         p4  (polar p an d1)<br /> <br />         p5  (polar p (+ an1 pi) h1)<br />         p6  (polar p5 an d2)<br />         p7  (polar p6 (+ an1 pi) h1)<br /> <br />   )<br />   (grvecs (list        col p5 p1 col p1 p2 col        p2 p3 col p3 p4        col p4 p7 col p7<br />                 p6 col p6 p5)<br />   )<br />   t<br /> )<br /> (defun c:tt (/ i e p pam vec)<br />   (setq i -1)<br />   (while (setq e (entsel "\nPick curve: "))<br />     (setq i   (1+ i)<br />           p   (apply 'vlax-curve-getclosestpointto e)<br />           pam (vlax-curve-getparamatpoint (car e) p)<br />           vec (vlax-curve-getfirstderiv (car e) pam)<br />     )<br />     (xd::pnt:drawarrow p vec i)<br />   )<br />   (redraw)<br />   (princ)<br /> )

winerfjy

(defun XD::Pnt:DrawArrow (p v / an p1 p2 p3 ys ss)
  (setq        an (angle '(0. 0. 0.) v)
        p1 (polar p an (* 0.25 (getvar "viewsize")))
        p2 (polar p1 (+ an (* 0.833333 pi)) (/ (distance p p1) 6.))
        p3 (polar p1 (- an (* 0.833333 pi)) (/ (distance p p1) 6.))
  )
  (grvecs (list 1 p p1 1 p1 p2 1 p1 p3))
  t
)


;程序2
(defun XD::Pnt:DrawArrow
       (p v col / an an1 h h1 d1 d2 p1 p2 p3 p4 p5 p6 p7)
  (setq        an  (angle '(0. 0. 0.) v)
        an1 (+ an (/ pi 2))
        h   (getvar "viewsize")
        h1  (/ h 80.)
        d1  (* 0.25 (getvar "viewsize"))
        d2  (* d1 0.7)

        p1  (polar p an1 h1)
        p2  (polar p1 an d2)
        p3  (polar p2 an1 h1)

        p4  (polar p an d1)

        p5  (polar p (+ an1 pi) h1)
        p6  (polar p5 an d2)
        p7  (polar p6 (+ an1 pi) h1)

  )
;;;  (grvecs (list        col p5 p1 col p1 p2 col        p2 p3 col p3 p4        col p4 p7 col p7
;;;                p6 col p6 p5)
;;;  )
(command "pline" p5 p1 p2 p3 p4 p7 p6 p5 "")
  t
(setq ys(getint "\n颜色改为:1红-2黄-3绿-4青-5蓝-6紫-7白<1>:"))
(if (not ys)(setq ys 1))
(setq ss (ssget"L"))
(command "change" ss "" "p" "c" ys "")
)
(defun c:jit (/ i e p pam vec)
  (setq i -1)
  (while
  (setq e (entsel "\n选择线对象 "))
  (setq i   (1+ i)
          p (apply 'vlax-curve-getclosestpointto e)
          pam (vlax-curve-getparamatpoint (car e) p))
    (setq a(getpoint"\n正向左键反向(空格)右键"))
    (if(null a)
    (setq vec (vlax-curve-getfirstderiv (car e) pam))
    (progn
    (setq vec(mapcar  '(lambda (x)(* x -1))vec))))
    (xd::pnt:drawarrow p vec i)
  )
  (redraw)
  (princ)
)
改了一下