求助各位大侠，请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屏幕
★通用函数下载地址：
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=37554
|;
;;; 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:00static/image/common/back.gif
多谢ZZXXQQ大侠！！
运行时：命令: gtt ; 错误: 参数类型错误: stringp 17.95

改过的程序：

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

多谢两位大侠！！！

页: [1]

明经CAD社区's Archiver

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