天正lisp的源码。

wjl1014 · 发表于 2013-3-15 14:54:00

;;;(_@ld "int_face")
(defun C:C_AXIS (/ is_list init_dlg do_list axde erase ll tgt1 tgt2
od_hlight l0l l1l what_next
)
(defun is_list ()
(if (/= l0l "")
(progn (mode_tile "axde" 0) (mode_tile "a_erase" 0))
(progn (mode_tile "axde" 1) (mode_tile "a_erase" 1))
)
)
(defun init_dlg ()
(set_tile "ax_tget" tgt1)
(set_tile "axde" axde)
(set_tile "a_erase" erase)
(is_list)
)
(defun do_list ()
(rs_error)
(setq l0l $value
l1l (after_list l0l ll)
)
(is_list)
)
(setq ll (ai_table "LAYER" 6)
l0l ""
axde "0"
erase "0"
tgt1 (parea "轴线")
tgt2 (parea "轴标")
)
(setvar "highlight" 0)
(if (and (not _int_fc_id)
(< (setq _int_fc_id (load_dialog (strcat _prefix "int_face.dcl")))
0
)
)
(exit)
)
(setq what_next 7)
(while (< 2 what_next)
(if (not (new_dialog "c_axis" _int_fc_id))
(exit)
)
(init_dlg)
(#disp_list "ax_ly_l" ll)
(if (and l0l (> (strlen l0l) 0))
(set_tile "ax_ly_l" l0l)
)
(action_tile "ax_ly_l" "(do_list)")
(action_tile "ax_ly" "(done_dialog 3)")
(action_tile "axde" "(setq axde $value)")
(action_tile "a_erase" "(setq erase $value)")
(action_tile "help" "(do_help \"int_face:c_axis\")")
(setq what_next (start_dialog))
(cond ((= what_next 3) (find_layer "轴线")))
)
(if (and (= what_next 1) (/= l0l ""))
(progn
(change_layer l1l "轴线")
(if (= axde "1")
(progn (setq s2 (ssget "X" (list (cons 8 tgt1) '(0 . "*POLYLINE"))))
(transws s2 0)
(while (setq e1 (slb_slb 0)) (command ".EXPLODE" e1))
)
)
(if (= erase "1")
(erase_other "LINE,ARC,CIRCLE" tgt1)
)
(princ "\n 轴线转换已完成 ! ")
)
)
(setvar "highlight" 1)
(princ)
)

;;;(_@ld "int_face") 
(defun C:C_AXIS  (/ is_list init_dlg do_list axde erase ll tgt1 tgt2 
     od_hlight l0l l1l what_next 
     ) 
  (defun is_list () 
    (if  (/= l0l "") 
      (progn (mode_tile "axde" 0) (mode_tile "a_erase" 0)) 
      (progn (mode_tile "axde" 1) (mode_tile "a_erase" 1)) 
      ) 
    ) 
  (defun init_dlg () 
    (set_tile "ax_tget" tgt1) 
    (set_tile "axde" axde) 
    (set_tile "a_erase" erase) 
    (is_list) 
    ) 
  (defun do_list () 
    (rs_error) 
    (setq l0l $value 
    l1l (after_list l0l ll) 
    ) 
    (is_list) 
    ) 
  (setq  ll    (ai_table "LAYER" 6) 
  l0l   "" 
  axde  "0" 
  erase "0" 
  tgt1  (parea "轴线") 
  tgt2  (parea "轴标") 
  ) 
  (setvar "highlight" 0) 
  (if (and (not _int_fc_id) 
     (< (setq _int_fc_id (load_dialog (strcat _prefix "int_face.dcl"))) 
        0 
        ) 
     ) 
    (exit) 
    ) 
  (setq what_next 7) 
  (while (< 2 what_next) 
    (if  (not (new_dialog "c_axis" _int_fc_id)) 
      (exit) 
      ) 
    (init_dlg) 
    (#disp_list "ax_ly_l" ll) 
    (if  (and l0l (> (strlen l0l) 0)) 
      (set_tile "ax_ly_l" l0l) 
      ) 
    (action_tile "ax_ly_l" "(do_list)") 
    (action_tile "ax_ly" "(done_dialog 3)") 
    (action_tile "axde" "(setq axde $value)") 
    (action_tile "a_erase" "(setq erase $value)") 
    (action_tile "help" "(do_help \"int_face:c_axis\")") 
    (setq what_next (start_dialog)) 
    (cond ((= what_next 3) (find_layer "轴线"))) 
    ) 
  (if (and (= what_next 1) (/= l0l "")) 
    (progn 
      (change_layer l1l "轴线") 
      (if (= axde "1") 
  (progn (setq s2 (ssget "X" (list (cons 8 tgt1) '(0 . "*POLYLINE")))) 
         (transws s2 0) 
         (while (setq e1 (slb_slb 0)) (command ".EXPLODE" e1)) 
         ) 
  ) 
      (if (= erase "1") 
  (erase_other "LINE,ARC,CIRCLE" tgt1) 
  ) 
      (princ "\n 轴线转换已完成 ! ") 
      ) 
    ) 
  (setvar "highlight" 1) 
  (princ) 
  )

天正lisp的源码。

vladimirputin · 发表于 2019-8-29 10:00:27

非常不错的资料，谢谢楼主分享的。

zmzk · 发表于 2024-1-9 18:35:40

不好用，里面是莫名的后缀名

paulpipi · 发表于 2019-8-24 19:20:52

这个源码怎么搞？

xiaxiang · 发表于 2013-3-15 15:05:33

文件内容是什么？建议截图

hao3ren · 发表于 2013-3-15 15:30:28

木有用啊，主要函数都是封装的

CTC · 发表于 2013-3-15 21:26:07

楼主不知今天315？！？！

tianyi1230 · 发表于 2013-3-16 10:37:42

论坛上有这个源码

mycad · 发表于 2013-3-16 12:02:42

楼主可以介绍一下程序的作用吗？

ucuc2003 · 发表于 2013-7-5 12:42:57

干什么用的？什么功能？

linjian257 · 发表于 2013-9-3 22:27:08

这个源码怎么搞？

andyhua · 发表于 2013-9-4 08:30:01

都不知道是用来干什么的啊

Singular_Bo · 发表于 2013-11-11 22:24:45

怎么打不开??

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

[资源] 天正lisp的源码。

本帖子中包含更多资源