求助各位大侠，请zzxxqq一定进来看看。

andyding · 发表于 2006-4-23 13:46:00

各位大侠，帮帮忙。

以下程序为zzxxqq大侠为本人写的，我想再加些功能。就是在执行中程序能记住上次输入的数值，如果不输入就用默认值来运行。谢谢！！！

(DEFUN C:GTT ()
(SETvar "CMDECHO" 0)
(vl-cmdf "_.undo" "_group")
(SETQ OLDOS (GETvar "OSMODE"))
(SETvar "OSMODE" 0)
(command "ucs" "w")
(setq LANGLST '(("CHS"      "\n输入挂台距离<17.95>:"
     "\n输入挂台宽<3.05>:"    "\n输入挂台深<1.0>:"
     "\n选择一条边:"     "\n起始点:"
     "\n哪一边?:"
    )
    ("CHT"
     "\n块珽禯瞒 <17.95> :"
     "\n块珽糴 <3.05> :"
     "\n块珽瞏 <1.0> :"
     "\n匡拒兵娩 :"
     "\n癣﹍翴:"
     "\n娩?:"
    )
   )
)
(setq LST (cdr (assoc (getvar "LOCALE") LANGLST)))
(SETQ AL1 (/ PI 2)
GTL (GETDIST (nth 0 LST))
GTL (IF (= GTL nil)
       17.95
       GTL
     )
GTW (GETDIST (nth 1 LST))
GTW (IF (= GTW nil)
       3.05
       GTW
     )
GTD (GETDIST (nth 2 LST))
GTD (IF (= GTD nil)
       1.0
       GTD
     )
)
(SETvar "BLIPMODE" 0)
(WHILE (SETQ S1 (ENTSEL (nth 3 LST)))
    (SETvar "OSMODE" 1)
    (IF (SETQ P1 (GETPOINT (nth 4 LST)))
      (PROGN
(SETvar "OSMODE" 0)
(SETQ DL (ENTGET (CAR S1))
       PT1 (CDR (ASSOC 10 DL))
       PT2 (CDR (ASSOC 11 DL))
       P2 (IF (> (DISTANCE PT1 P1) (DISTANCE PT2 P1))
      PT1
      PT2
    )
       ANG (ANGLE P1 P2)
       PT (GETPOINT P1 (nth 5 LST))
       AN1 (ANGLE P1 PT)
       A1 (- AN1 ANG)
       A1 (IF (AND (> A1 0) (> A1 PI))
      (- A1 PI PI)
      A1
    )
       A1 (IF (AND (< A1 0) (< A1 (- PI)))
      (+ A1 PI PI)
      A1
    )
       A1 (IF (> A1 0)
      (+ ANG AL1)
      (- ANG AL1)
    )
       P3 (POLAR P1 ANG GTL)
       P4 (POLAR P3 A1 GTD)
       P5 (POLAR P3 ANG GTW)
       P6 (POLAR P5 A1 GTD)
)
(COMMAND "ERASE" (CAR S1) "")
(COMMAND "LINE" P1 P3 P4 P6 P5 P2 "")
      )
    )
)
(command "ucs" "p")
(SETvar "OSMODE" OLDOS)
(vl-cmdf "_.undo" "_end")
(SETvar "CMDECHO" 1)
(PRINC)
)

xyp1964 · 发表于 2006-4-23 16:29:00

命令: GTT (挂台)

andyding · 发表于 2006-4-23 18:10:00

谢谢XYP1964大侠！！！

能否给小弟份源码学习学习？请不吝赐教。

ZZXXQQ · 发表于 2006-4-23 18:23:00

程序

andyding · 发表于 2006-4-23 20:06:00

多谢ZZXXQQ大侠！！

运行时：命令: gtt ; 错误: 参数类型错误: stringp 17.95

xyp1964 · 发表于 2006-4-23 22:41:00

(load "xyp_lib.vlx") ;版本 V.20060314
;|下载和加载通用函数(可在签名栏直接下载后放到搜索路径下)
利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：
★1·在acad.lsp中增加(load"xyp_lib")
■2·在每个程序内增加(load"xyp_lib")
■3·在command下，输入(load"xyp_lib")
■4·在菜单.mnl中增加(load"xyp_lib")
■5·将xyp_lib.vlx文件直接拽到cad屏幕
[COLOR=red] ★通用函数下载地址：[/COLOR]
[url]http://bbs.mjtd.com/forum.php?mod=viewthread&tid=37554[/url]
|;
;;; gtt(挂台)
(DEFUN C:GTT ()
(cmdla0)
(SETvar "OSMODE" 0)
(if (null gtl)
(setq gtl 17.95)
)
(if (null GTW)
(setq GTW 3.05)
)
(if (null GTD)
(setq GTD 1.0)
)
(SETQ AL1 (/ PI 2)
GTL (UDIST 7 "" "\n输入挂台距离<直接输入或鼠标点取>" GTL nil)
GTW (UDIST 7 "" "\n输入挂台宽<直接输入或鼠标点取>" GTW nil)
GTD (UDIST 7 "" "\n输入挂台深<直接输入或鼠标点取>" GTD nil)
)
(WHILE (SETQ S1 (ENTSEL "\n选择一条边: "))
(SETvar "OSMODE" 1)
(IF (SETQ P1 (GETPOINT "\n起始点: "))
(PROGN
(SETvar "OSMODE" 0)
(SETQ DL (ENTGET (CAR S1))
PT1 (CDR (ASSOC 10 DL))
PT2 (CDR (ASSOC 11 DL))
P2 (IF (> (DISTANCE PT1 P1) (DISTANCE PT2 P1))
PT1
PT2
)
ANG (ANGLE P1 P2)
PT (GETPOINT P1 "\n哪一边?: ")
AN1 (ANGLE P1 PT)
A1 (- AN1 ANG)
A1 (IF (AND (> A1 0) (> A1 PI))
(- A1 PI PI)
A1
)
A1 (IF (AND (< A1 0) (< A1 (- PI)))
(+ A1 PI PI)
A1
)
A1 (IF (> A1 0)
(+ ANG AL1)
(- ANG AL1)
)
P3 (POLAR P1 ANG GTL)
P4 (POLAR P3 A1 GTD)
P5 (POLAR P3 ANG GTW)
P6 (POLAR P5 A1 GTD)
)
(COMMAND "ERASE" (CAR S1) "")
(xyp-mklaco "挂台" 4)
(COMMAND "LINE" P1 P3 P4 P6 P5 P2 "")
)
)
)
(command "ucs" "p")
(cmdla1)
)
(princ"命令: GTT (挂台)")
(princ)

(load "xyp_lib.vlx") ;版本 V.20060314
;|下载和加载通用函数(可在签名栏直接下载后放到搜索路径下)
利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：
★1·在acad.lsp中增加(load"xyp_lib")
■2·在每个程序内增加(load"xyp_lib")
■3·在command下，输入(load"xyp_lib")
■4·在菜单.mnl中增加(load"xyp_lib")
■5·将xyp_lib.vlx文件直接拽到cad屏幕
[COLOR=red] ★通用函数下载地址：[/COLOR]
[url]http://bbs.mjtd.com/forum.php?mod=viewthread&tid=37554[/url]
|;
;;; gtt(挂台)
(DEFUN C:GTT ()
  (cmdla0)
  (SETvar "OSMODE" 0)
  (if (null gtl)
    (setq gtl 17.95)
  )
  (if (null GTW)
    (setq GTW 3.05)
  )
  (if (null GTD)
    (setq GTD 1.0)
  )
  (SETQ AL1 (/ PI 2)
 GTL (UDIST 7 "" "\n输入挂台距离<直接输入或鼠标点取>" GTL nil)
 GTW (UDIST 7 "" "\n输入挂台宽<直接输入或鼠标点取>" GTW nil)
 GTD (UDIST 7 "" "\n输入挂台深<直接输入或鼠标点取>" GTD nil)
  )
  (WHILE (SETQ S1 (ENTSEL "\n选择一条边: "))
    (SETvar "OSMODE" 1)
    (IF (SETQ P1 (GETPOINT "\n起始点: "))
      (PROGN
 (SETvar "OSMODE" 0)
 (SETQ DL  (ENTGET (CAR S1))
       PT1 (CDR (ASSOC 10 DL))
       PT2 (CDR (ASSOC 11 DL))
       P2  (IF (> (DISTANCE PT1 P1) (DISTANCE PT2 P1))
      PT1
      PT2
    )
       ANG (ANGLE P1 P2)
       PT  (GETPOINT P1 "\n哪一边?: ")
       AN1 (ANGLE P1 PT)
       A1  (- AN1 ANG)
       A1  (IF (AND (> A1 0) (> A1 PI))
      (- A1 PI PI)
      A1
    )
       A1  (IF (AND (< A1 0) (< A1 (- PI)))
      (+ A1 PI PI)
      A1
    )
       A1  (IF (> A1 0)
      (+ ANG AL1)
      (- ANG AL1)
    )
       P3  (POLAR P1 ANG GTL)
       P4  (POLAR P3 A1 GTD)
       P5  (POLAR P3 ANG GTW)
       P6  (POLAR P5 A1 GTD)
 )
 (COMMAND "ERASE" (CAR S1) "")
 (xyp-mklaco "挂台" 4)
 (COMMAND "LINE" P1 P3 P4 P6 P5 P2 "")
      )
    )
  )
  (command "ucs" "p")
  (cmdla1)
)
(princ"命令: GTT  (挂台)")
(princ)

ZZXXQQ · 发表于 2006-4-23 23:15:00

andyding发表于2006-4-23 20:06:00 多谢ZZXXQQ大侠！！运行时：命令: gtt ; 错误: 参数类型错误: stringp 17.95

改过的程序：

andyding · 发表于 2006-4-24 23:46:00

多谢两位大侠！！！

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

求助各位大侠，请zzxxqq一定进来看看。

本帖子中包含更多资源

本帖子中包含更多资源

本帖子中包含更多资源

浏览过的版块