[LISP程序]：贴个小箭头玩玩,能undo,能标上下,能画弧线

aeo · 发表于 2002-6-2 03:42:57

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

;能undo
;能标上下
;能画弧线

(defun c:j (/ p40 ss p1 p2 p3 p4 p5 pa pb n li ss os ang ang1 ang2 ang3 p20 p30 swap1 rad plwid)
(setq p1 (getpoint "起点:")
p2 t
li '()
li (cons p1 li)
n 0
)
(setq os (getvar "osmode"))
(setvar "osmode" 0)(setq plwid(getvar "PLINEWID"))
(while p2
(initget "S-上 X-下 Arc Undo")
(setq p2 (getpoint p1 "\n下一点(S-上 X-下 Arc Undo):"))
(cond
((= p2 "S-上")
(setq ss "上")
)
((= p2 "X-下")
(setq ss "下")
)
((= p2 "Arc")
(setq p3 (getpoint "第二点"))
(command "undo" "g")
(command "arc" p1 p3 pause)
(command "undo" "E")
(setq p2 (getvar "lastpoint"))
(if p2
(progn
(setq n (1+ n))
(if (= n 1)
(setq p4 (polar p1 (angle p2 p1) 200))
)
(setq li (cons p2 li)
p1 p2
)
)
)
)
((= p2 "Undo")
(if li
(progn
(setq n (- n 1))
(command "undo" "")
(setq li (cdr li))
(if li
(setq p1 (car li))
)
)
)
)
(t
(command "UNDO" "g")
(command "LINE" p1 p2 "")
(command "UNDO" "E")
(if p2
(progn
(setq n (1+ n))
(if (= n 1)
(setq p4 (polar p1 (angle p2 p1) 200))
)
(setq p1 p2
li (cons p2 li)
)
)
)
)
)
) ; while
(if (> n 0)
(progn
(setq swap1 (entget (entlast)))
(cond
((= "LINE" (dxf 0 swap1))
(setq p1 (dxf 11 swap1)
p2 (dxf 10 swap1)
ang (angle p1 p2)
)
(setq pa (polar p1 (+ ang (/ pi 3)) 300)
pb (polar p1 (- ang (/ pi 3)) 300)
)
(command "PLINE" pa "w" "60" "60" p1 pb "")
)
((= "ARC" (dxf 0 swap1))
(setq p2 (car li))
(setq p1 (dxf 10 swap1)
rad (dxf 40 swap1)
ang1 (dxf 51 swap1)
ang2 (dxf 50 swap1)
ang (/ (+ ang1 ang2) 2)
)
(setq p20 (polar p1 ang1 rad)
p3 (polar p1 ang rad)
)
(setq p30 (polar p1 ang2 rad)
p40 (inters
p1
(polar p1 ang 100)
p20
p30
nil
)
)
(setq ang3 (+ (angle p2 p1) pi/2)
ang (angle p2 p40)
) ; (if (<(rem(abs (+ (- (* 2 pi)ang2) ang1))(* pi 2))pi )
(if (< (cos (- ang3 ang)) 0)
(setq ang3 (+ ang3 pi))
) ;
(if (< (rem (abs (+ (- (* 2 pi) ang2) ang1)) (* pi 2)) pi)
(if (> (cos (- ang3 ang)) 0)
(setq ang3 (+ ang3 pi))
)
)
(setq ang3 (+ ang3 pi))
(setq pa (polar p2 (+ ang3 (/ pi 3)) 300)
pb (polar p2 (- ang3 (/ pi 3)) 300)
)
(command "PLINE" pa "W" "60" "" p2 pb "")
)
) ; cond
(if ss
(progn
(if (not (tblsearch "STYLE" "fs6"))
(command "style" "fs6" "simplex,hztxt" "300" "0.7" "" "" "" "")
)
(if (/= "fs6" (getvar "textstyle"))
(setvar "textstyle" "fs6")
)
(command "text" p4 "0" ss)
)
)
(setvar "osmode" os)
(princ "ok!")(setvar "PLINEWID" plwid)
(princ)
)
)
)

(defun c:j (/ p40 ss p1 p2 p3 p4 p5 pa pb n li ss os ang ang1 ang2 ang3 p20 p30 swap1 rad plwid) 
  (setq p1 (getpoint "起点:") 
        p2 t 
        li '() 
        li (cons p1 li) 
        n 0 
  ) 
  (setq os (getvar "osmode")) 
  (setvar "osmode" 0)(setq plwid(getvar "PLINEWID")) 
  (while p2 
    (initget "S-上 X-下 Arc Undo") 
    (setq p2 (getpoint p1 "\n下一点(S-上 X-下 Arc Undo):")) 
    (cond 
      ((= p2 "S-上") 
        (setq ss "上") 
      ) 
      ((= p2 "X-下") 
        (setq ss "下") 
      ) 
      ((= p2 "Arc") 
        (setq p3 (getpoint "第二点")) 
 
        (command "undo" "g") 
        (command "arc" p1 p3 pause) 
        (command "undo" "E") 
        (setq p2 (getvar "lastpoint")) 
        (if p2 
          (progn 
            (setq n (1+ n)) 
            (if (= n 1) 
              (setq p4 (polar p1 (angle p2 p1) 200)) 
            ) 
            (setq li (cons p2 li) 
                  p1 p2 
            ) 
          ) 
        ) 
      ) 
 
      ((= p2 "Undo") 
        (if li 
          (progn 
            (setq n (- n 1)) 
            (command "undo" "") 
            (setq li (cdr li)) 
            (if li 
              (setq p1 (car li)) 
            ) 
          ) 
        ) 
      ) 
      (t 
        (command "UNDO" "g") 
        (command "LINE" p1 p2 "") 
        (command "UNDO" "E") 
        (if p2 
          (progn 
            (setq n (1+ n)) 
            (if (= n 1) 
              (setq p4 (polar p1 (angle p2 p1) 200)) 
            ) 
            (setq p1 p2 
                  li (cons p2 li) 
            ) 
          ) 
        ) 
      ) 
    ) 
  )                                       ; while 
  (if (> n 0) 
    (progn 
      (setq swap1 (entget (entlast))) 
      (cond 
        ((= "LINE" (dxf 0 swap1)) 
          (setq p1 (dxf 11 swap1) 
                p2 (dxf 10 swap1) 
                ang (angle p1 p2) 
          ) 
          (setq pa (polar p1 (+ ang (/ pi 3)) 300) 
                pb (polar p1 (- ang (/ pi 3)) 300) 
          ) 
          (command "PLINE" pa "w" "60" "60" p1 pb "") 
        ) 
        ((= "ARC" (dxf 0 swap1)) 
          (setq p2 (car li)) 
          (setq p1 (dxf 10 swap1) 
                rad (dxf 40 swap1) 
                ang1 (dxf 51 swap1) 
                ang2 (dxf 50 swap1) 
                ang (/ (+ ang1 ang2) 2) 
          ) 
          (setq p20 (polar p1 ang1 rad) 
                p3 (polar p1 ang rad) 
          ) 
          (setq p30 (polar p1 ang2 rad) 
                p40 (inters 
                      p1 
                      (polar p1 ang 100) 
                      p20 
                      p30 
                      nil 
                    ) 
          ) 
          (setq ang3 (+ (angle p2 p1) pi/2) 
                ang (angle p2 p40) 
          )                               ; (if (<(rem(abs (+ (- (* 2 pi)ang2) ang1))(* pi 2))pi ) 
          (if (< (cos (- ang3 ang)) 0) 
            (setq ang3 (+ ang3 pi)) 
          )                               ; 
          (if (< (rem (abs (+ (- (* 2 pi) ang2) ang1)) (* pi 2)) pi) 
            (if (> (cos (- ang3 ang)) 0) 
              (setq ang3 (+ ang3 pi)) 
            ) 
          ) 
          (setq ang3 (+ ang3 pi)) 
          (setq pa (polar p2 (+ ang3 (/ pi 3)) 300) 
                pb (polar p2 (- ang3 (/ pi 3)) 300) 
          ) 
          (command "PLINE" pa "W" "60" "" p2 pb "") 
        ) 
      )                                       ; cond 
      (if ss 
        (progn 
          (if (not (tblsearch "STYLE" "fs6")) 
            (command "style" "fs6" "simplex,hztxt" "300" "0.7" "" "" "" "") 
          ) 
          (if (/= "fs6" (getvar "textstyle")) 
            (setvar "textstyle" "fs6") 
          ) 
          (command "text" p4 "0" ss) 
        ) 
      ) 
      (setvar "osmode" os) 
      (princ "ok!")(setvar  "PLINEWID" plwid) 
      (princ) 
    ) 
  ) 
)

xianxl · 发表于 2003-5-24 23:33:30

斑竹：对程序我是菜鸟。能做个动画看看效果吗？还有怎么用这个程序，执行什么命令？请解释的浅显点。省得再有我这样的苯鸟来烦你：）

cy956 · 发表于 2003-5-25 00:15:04

aeo,推荐你用entmake画实体,更快更方便.

aeo · 发表于 2003-5-25 16:32:12

n年前写的啦,一直不想改,能用就行.(还是r12)

那是有一次,照老外的图,出图,时不时要一个箭头,老外的详图就是一个箭头带一个云朵.而且都是带弧的,搞的我很恼火.
后来加了个"上下",没那个软件会考虑到这的.但每个人都会为这痛苦.

li809 · 发表于 2005-2-17 23:36:35

能用在2005吗

zh_6531394 · 发表于 2005-2-18 12:58:07

键头太难看

山山黄叶飞 · 发表于 2005-6-30 10:54:49

怎么用的啊？请介绍，要不我们不知道，外行啊

海豚 · 发表于 2005-7-3 22:24:24

我运行后显示：
Command: j
起点:
下一点(S-上 X-下 Arc Undo):
下一点(S-上 X-下 Arc Undo):s

下一点(S-上 X-下 Arc Undo):
Unknown command "J". Press F1 for help.

错误: no function definition: DXF

运行环境cad2004,,，不知道是什么问题。

PFD8667 · 发表于 2005-7-5 11:18:24

不好用,没看到有什么箭头.

userzhluserzhl · 发表于 2005-7-7 13:10:37

楼上两位朋友，我用的是2005，一切都正常呀！

gysjy · 发表于 2005-11-26 09:32:39

r14的运行结果：
Command: j
起点:
下一点(S-上 X-下 Arc Undo):
下一点(S-上 X-下 Arc Undo):
Unknown command "J". Press F1 for help.
error: null function
(DXF 0 SWAP1)

没有dxf这个函数。

账号		自动登录	找回密码
密码			立即注册

[LISP程序]：贴个小箭头玩玩,能undo,能标上下,能画弧线

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子