[求助]：lisp有问题

ewenhui · 发表于 2005-11-16 21:13:34

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

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

×

刚开始学习lisp，写了一个，第一次运行可以，第二次就出错。请帮忙检查修改。是不是全局变量和局部变量应用问题？

[FONT=courier new]
(defun c:jpg(/ l w h ew pa pb pc pd ma mb mc md me mf mg na ne e1 e2 e3 e4 ss ss1 )
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
;;以下需要输入
(setq pa (getpoint "\n起点:"))
(setq l (getdist "\n长:"))
(setq w (getdist "\n宽:"))
(setq h (getdist "\n高:"))
(setq ew (getdist "\n贴位宽:"))
;;以下需要求出
(setq pb (polar pa 0 l))
(setq pc (polar pb (* pi 0.5) w))
(setq pd (polar pc pi l))
(setq ma (polar pb 0 h))
(setq mb (polar ma pi (- h 1.5)))
(setq mc (polar mb (* pi 1.5) 3))
(setq md (polar mc 0 (- ew 1.5)))
(setq me (polar md (* pi 1.5) (- h 3)))
(setq mf (polar me pi ew))
(setq mg (polar mf (* pi 0.5) (- h 1.5)))
(setq na (polar ma (* pi 0.5) w))
(setq ne (polar me pi (+ (* ew 2) l)))
;;以下依据pa、pb、pc、pd点画矩形
(command "pline" pa pb pc pd "c")
;;以下依据ma、pb、mb、mc、md点画线并命名图元
(command "pline" ma mb "a" mc "l" md me "")
(setq e1 (entlast))
;;以下依据mb、me点画线并命名图元
(command "line" mf mg "")
(setq e2 (entlast))
;;建立选择集
(setq ss (ssadd e1))
(ssadd e2 ss)
;;画其它三个角
(command "mirror" ss "" "m2p" pa pb "m2p" pc pd "n")
(command "mirror" ss "" "m2p" pa pd "m2p" pb pc "n")
(command "rotate" ss "" "m2p" pa pc "c" "180")
;;画ma－na线 me－ne并镜像
(command "line" ma na "")
(setq e3 (entlast))
(command "line" me ne "")
(setq e4 (entlast))
(setq ss1 (ssadd e3))
(ssadd e4 ss1)
(command "rotate" ss1 "" "m2p" pa pc "c" "180")
(command "pedit" "m" "all" "" "j" "" "")
(command "zoom" "e" "")
(prin1)
)
[/FONT]

[FONT=courier new] 
(defun c:jpg(/ l w h ew pa pb pc pd ma mb mc md me mf mg na ne e1 e2 e3 e4 ss ss1 ) 
        (setvar "cmdecho" 0) 
        (setvar "blipmode" 0) 
        ;;以下需要输入 
        (setq pa (getpoint "\n起点:")) 
        (setq l (getdist "\n长:")) 
        (setq w (getdist "\n宽:")) 
        (setq h (getdist "\n高:")) 
        (setq ew (getdist "\n贴位宽:")) 
        ;;以下需要求出 
        (setq pb (polar pa 0 l)) 
        (setq pc (polar pb (* pi 0.5) w)) 
        (setq pd (polar pc pi l)) 
        (setq ma (polar pb 0 h)) 
        (setq mb (polar ma pi (- h 1.5))) 
        (setq mc (polar mb (* pi 1.5) 3)) 
        (setq md (polar mc 0 (- ew 1.5))) 
        (setq me (polar md (* pi 1.5) (- h 3))) 
        (setq mf (polar me pi ew)) 
        (setq mg (polar mf (* pi 0.5) (- h 1.5))) 
        (setq na (polar ma (* pi 0.5) w)) 
        (setq ne (polar me pi (+ (* ew 2) l))) 
        ;;以下依据pa、pb、pc、pd点画矩形 
        (command "pline" pa pb pc pd "c") 
        ;;以下依据ma、pb、mb、mc、md点画线并命名图元 
        (command "pline" ma mb "a" mc "l" md me "") 
        (setq e1 (entlast)) 
        ;;以下依据mb、me点画线并命名图元 
        (command "line" mf mg "") 
        (setq e2 (entlast)) 
        ;;建立选择集 
        (setq ss (ssadd e1)) 
        (ssadd e2 ss) 
        ;;画其它三个角 
        (command "mirror" ss "" "m2p" pa pb "m2p" pc pd "n") 
        (command "mirror" ss "" "m2p" pa pd "m2p" pb pc "n") 
        (command "rotate" ss "" "m2p" pa pc "c" "180") 
        ;;画ma－na线 me－ne并镜像 
        (command "line" ma na "") 
        (setq e3 (entlast)) 
        (command "line" me ne "") 
        (setq e4 (entlast)) 
        (setq ss1 (ssadd e3)) 
        (ssadd e4 ss1) 
        (command "rotate" ss1 "" "m2p" pa pc "c" "180") 
        (command "pedit" "m" "all" "" "j" "" "") 
        (command "zoom" "e" "") 
        (prin1) 
) 
  [/FONT]

xyp1964 · 发表于 2005-11-16 21:54:32

"m2p"是什么选项?

ewenhui · 发表于 2005-11-17 12:04:59

最初由 xyp1964 发布
[B]"m2p"是什么选项? [/B]

“m2p”或“mtp”是两点之间的中点。

xyp1964 · 发表于 2005-11-17 12:58:44

最初由 ewenhui 发布
[B]

“m2p”或“mtp”是两点之间的中点。 [/B]

哪儿有mtp？m2p未赋值！

ewenhui · 发表于 2005-11-17 13:20:28

定位两点的中点

命令行: 在定位点的提示下，输入 mtp

两点的中点 (MTP) 命令修饰符可以在运行对象捕捉或对象捕捉替代时使用。（OSNAP 命令）

在定位点的任何命令提示下，输入 mtp 或 m2p。

类似于“cen”、“qua”、“tan”等等。初学者不是很懂，不能这样用吗？

xyp1964 · 发表于 2005-11-17 13:38:07

[FONT=courier new](defun c:jpg (/ pa pb pc pd ma mb mc md me mf mg na ne e1 e2 e3 e4 ss
ss1)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
;;以下需要输入
(setq pa (getpoint "\n起点:")
l (UREAL 7 "" "\n长" l)
w (UREAL 7 "" "\n宽" w)
h (UREAL 7 "" "\n高" h)
ew (UREAL 7 "" "\n贴位宽" ew)
)
;;以下需要求出
(setq pb (polar pa 0 l))
(setq pc (polar pb (* pi 0.5) w))
(setq pd (polar pc pi l))
(setq ma (polar pb 0 h))
(setq mb (polar ma pi (- h 1.5)))
(setq mc (polar mb (* pi 1.5) 3))
(setq md (polar mc 0 (- ew 1.5)))
(setq me (polar md (* pi 1.5) (- h 3)))
(setq mf (polar me pi ew))
(setq mg (polar mf (* pi 0.5) (- h 1.5)))
(setq na (polar ma (* pi 0.5) w))
(setq ne (polar me pi (+ (* ew 2) l)))
;;以下依据pa、pb、pc、pd点画矩形
(command "pline" pa pb pc pd "c")
;;以下依据ma、pb、mb、mc、md点画线并命名图元
(command "pline" ma mb "a" mc "l" md me "")
(setq e1 (entlast))
;;以下依据mb、me点画线并命名图元
(command "line" mf mg "")
(setq e2 (entlast))
;;建立选择集
(setq ss (ssadd e1))
(ssadd e2 ss)
;;画其它三个角
(command "mirror" ss "" (_midp pa pb) (_midp pc pd) "n")
(command "mirror" ss "" (_midp pa pb) (_midp pb pc) "n")
(command "rotate" ss "" (_midp pa pc) "180")
;;画ma－na线 me－ne并镜像
(command "line" ma na "")
(setq e3 (entlast))
(command "line" me ne "")
(setq e4 (entlast))
(setq ss1 (ssadd e3))
(ssadd e4 ss1)
(command "rotate" ss1 "" (_midp pa pc) "180")
(command "pedit" "m" "all" "" "Y" "j" "" "")
(command "zoom" "e")
(princ)
)
(defun _midp (p1 p2)
(list (/ (+ (car p1) (car p2)) 2)
(/ (+ (cadr p1) (cadr p2)) 2)
)
)[/FONT]

[FONT=courier new](defun c:jpg (/        pa pb pc pd ma mb mc md        me mf mg na ne e1 e2 e3        e4 ss 
              ss1) 
  (setvar "cmdecho" 0) 
  (setvar "blipmode" 0) 
  ;;以下需要输入 
  (setq        pa (getpoint "\n起点:") 
        l  (UREAL 7 "" "\n长" l) 
        w  (UREAL 7 "" "\n宽" w) 
        h  (UREAL 7 "" "\n高" h) 
        ew (UREAL 7 "" "\n贴位宽" ew) 
  ) 
  ;;以下需要求出 
  (setq pb (polar pa 0 l)) 
  (setq pc (polar pb (* pi 0.5) w)) 
  (setq pd (polar pc pi l)) 
  (setq ma (polar pb 0 h)) 
  (setq mb (polar ma pi (- h 1.5))) 
  (setq mc (polar mb (* pi 1.5) 3)) 
  (setq md (polar mc 0 (- ew 1.5))) 
  (setq me (polar md (* pi 1.5) (- h 3))) 
  (setq mf (polar me pi ew)) 
  (setq mg (polar mf (* pi 0.5) (- h 1.5))) 
  (setq na (polar ma (* pi 0.5) w)) 
  (setq ne (polar me pi (+ (* ew 2) l))) 
  ;;以下依据pa、pb、pc、pd点画矩形 
  (command "pline" pa pb pc pd "c") 
  ;;以下依据ma、pb、mb、mc、md点画线并命名图元 
  (command "pline" ma mb "a" mc "l" md me "") 
  (setq e1 (entlast)) 
  ;;以下依据mb、me点画线并命名图元 
  (command "line" mf mg "") 
  (setq e2 (entlast)) 
  ;;建立选择集 
  (setq ss (ssadd e1)) 
  (ssadd e2 ss) 
  ;;画其它三个角 
  (command "mirror" ss "" (_midp pa pb) (_midp pc pd) "n") 
  (command "mirror" ss "" (_midp pa pb) (_midp pb pc) "n") 
  (command "rotate" ss "" (_midp pa pc) "180") 
  ;;画ma－na线 me－ne并镜像 
  (command "line" ma na "") 
  (setq e3 (entlast)) 
  (command "line" me ne "") 
  (setq e4 (entlast)) 
  (setq ss1 (ssadd e3)) 
  (ssadd e4 ss1) 
  (command "rotate" ss1 "" (_midp pa pc) "180") 
  (command "pedit" "m" "all" "" "Y" "j" "" "") 
  (command "zoom" "e") 
  (princ) 
) 
(defun _midp (p1 p2) 
  (list        (/ (+ (car p1) (car p2)) 2) 
        (/ (+ (cadr p1) (cadr p2)) 2) 
  ) 
)[/FONT]

ewenhui · 发表于 2005-11-17 15:42:47

还是老问题：
①第一次正常，第二次如果输入的数字比第一次大，通过，第三次失败。
②第一次正常，第二次如果输入的数字比第一次小，失败。

xyp1964 · 发表于 2005-11-17 18:05:41

最初由 ewenhui 发布
[B]还是老问题：
①第一次正常，第二次如果输入的数字比第一次大，通过，第三次失败。
②第一次正常，第二次如果输入的数字比第一次小，失败。 [/B]

把最终要生成的图发上来！
试试修改过的程序。

ewenhui · 发表于 2005-11-17 20:16:43

我要的图形一个款式多种尺寸，用此lisp的结果如附件，出错的地方是第二次或第三次画ma－mb线时mb点错误，而变成画ma－pb。

xyp1964 · 发表于 2005-11-17 21:40:05

按图重新编程：

[FONT=courier new]
(load "xyp_lib")
;|加载通用函数(可在签名栏直接下载)
如果已经下载xyp_lib并放到搜索路径下可以不再下载!
利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：
★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://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]
|;
(defun c:test ()
(CMDLA0)
(setvar "osmode" 0)
(setq pt0 (getpoint "\n起点:")
l (UREAL 7 "" "\n长" l)
w (UREAL 7 "" "\n宽" w)
h (UREAL 7 "" "\n高" h)
ew (UREAL 7 "" "\n贴位宽" ew)
pt1 (list (+ (car pt0) l) (+ (cadr pt0) w))
pt00 (xyp-get-MidPoint pt0 pt1)
pt2 (list (- (car pt0) h) (cadr pt0))
pt3 (list (car pt2) (+ (cadr pt2) (/ w 2.0)))
pt4 (list (- (car pt0) 1.5) (cadr pt0))
pt5 (list (car pt4) (- (cadr pt4) 3.0))
pt6 (list (- (car pt5) (- ew 1.5)) (cadr pt5))
pt7 (list (car pt6) (- (cadr pt6) (- h 3)))
pt8 (list (+ (car pt7) ew (/ l 2.0)) (cadr pt7))
pt9 (list (car pt0) (- (cadr pt0) 1.5))
pt10 (list (car pt0) (- (cadr pt0) h))
)
(mkla "test1" 1)
(command "rectang" pt0 pt1)
(mkla "test2" 2)
(command "pline" pt3 pt2 pt4 "a" pt5 "l" pt6 pt7 pt8 "")
(setq s1 (entlast))
(command "mirror" s1 "" pt00 pt3 "")
(setq s2 (entlast))
(command "mirror" s1 "" pt00 pt8 "")
(setq s3 (entlast))
(command "mirror" s3 "" pt00 pt3 "")
(setq s4 (entlast))
(command "pedit" "m" s1 s2 s3 s4 "" "j" "" "")
(mkla "test3" 3)
(command "line" pt9 pt10 "")
(setq s1 (entlast))
(command "array" s1 "" "p" pt00 2 360 "")
(setq s2 (entlast))
(command "mirror" s1 s2 "" pt00 pt8 "")
(CMDLA1)
)[/FONT]

[FONT=courier new] 
(load "xyp_lib") 
 ;|加载通用函数(可在签名栏直接下载) 
如果已经下载xyp_lib并放到搜索路径下可以不再下载! 
利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序： 
★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://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url] 
|; 
 
(defun c:test () 
  (CMDLA0) 
  (setvar "osmode" 0) 
  (setq        pt0  (getpoint "\n起点:") 
        l    (UREAL 7 "" "\n长" l) 
        w    (UREAL 7 "" "\n宽" w) 
        h    (UREAL 7 "" "\n高" h) 
        ew   (UREAL 7 "" "\n贴位宽" ew) 
        pt1  (list (+ (car pt0) l) (+ (cadr pt0) w)) 
        pt00 (xyp-get-MidPoint pt0 pt1) 
        pt2  (list (- (car pt0) h) (cadr pt0)) 
        pt3  (list (car pt2) (+ (cadr pt2) (/ w 2.0))) 
        pt4  (list (- (car pt0) 1.5) (cadr pt0)) 
        pt5  (list (car pt4) (- (cadr pt4) 3.0)) 
        pt6  (list (- (car pt5) (- ew 1.5)) (cadr pt5)) 
        pt7  (list (car pt6) (- (cadr pt6) (- h 3))) 
        pt8  (list (+ (car pt7) ew (/ l 2.0)) (cadr pt7)) 
        pt9  (list (car pt0) (- (cadr pt0) 1.5)) 
        pt10 (list (car pt0) (- (cadr pt0) h)) 
  ) 
  (mkla "test1" 1) 
  (command "rectang" pt0 pt1) 
  (mkla "test2" 2) 
  (command "pline" pt3 pt2 pt4 "a" pt5 "l" pt6 pt7 pt8 "") 
  (setq s1 (entlast)) 
  (command "mirror" s1 "" pt00 pt3 "") 
  (setq s2 (entlast)) 
  (command "mirror" s1 "" pt00 pt8 "") 
  (setq s3 (entlast)) 
  (command "mirror" s3 "" pt00 pt3 "") 
  (setq s4 (entlast)) 
  (command "pedit" "m" s1 s2 s3 s4 "" "j" "" "") 
  (mkla "test3" 3) 
  (command "line" pt9 pt10 "") 
  (setq s1 (entlast)) 
  (command "array" s1 "" "p" pt00 2 360 "") 
  (setq s2 (entlast)) 
  (command "mirror" s1 s2 "" pt00 pt8 "") 
  (CMDLA1) 
)[/FONT]

编译程序：

zxq0220 · 发表于 2005-11-17 22:57:52

[php]
(defun c:jpg(/ l w h ew pa pb pc pd ma mb mc md me mf mg na ne e1 e2)
      (setvar "cmdecho" 0)
      (setvar "blipmode" 0)
      (setvar "osmode" 0)
      ;;以下需要输入
(setq pa (getpoint "\n起点:"))
(setq l (getdist "\n长:"))
(setq w (getdist "\n宽:"))
      (setq h (getdist "\n高:"))
(setq ew (getdist "\n贴位宽:"))
      ;;以下需要求出
      (setq pb (polar pa 0 l))
      (setq pc (polar pb (* pi 0.5) w))
      (setq pd (polar pc pi l))
      (setq ma (polar pb 0 h))
      (setq mb (polar ma pi (- h 1.5)))
      (setq mc (polar mb (* pi 1.5) 3))
      (setq md (polar mc 0 (- ew 1.5)))
      (setq me (polar md (* pi 1.5) (- h 3)))
      (setq mf (polar me pi ew))
      (setq mg (polar mf (* pi 0.5) (- h 1.5)))
      (setq na (polar ma (* pi 0.5) w))
      (setq ne (polar me pi (+ (* ew 2) l)))
      ;;以下依据pa、pb、pc、pd点画矩形
      (command "pline" pa pb pc pd "c")
      ;;以下依据ma、pb、mb、mc、md点画线并命名图元
      (command "pline" ma mb "a" mc "l" md me "")
      (setq e1 (entlast))
      ;;以下依据mb、me点画线并命名图元
      (command "line" mf mg "")
      (setq e2 (entlast))
      ;;画其它三个角
      (command "mirror" e1 e2 ""
      (polar pa (angle pa pb) (/ (distance pa pb) 2))
      (polar pc (angle pc pd) (/ (distance pc pd) 2)) "n")
      (command "mirror" e1 e2 ""
      (polar pa (angle pa pd) (/ (distance pa pd) 2))
      (polar pb (angle pb pc) (/ (distance pb pc) 2)) "n")
      (command "copy" e1 e2 "" pa pa)
      (command "rotate" e1 e2 ""
      (polar pa (angle pa pc) (/ (distance pa pc) 2)) "180")
      ;;画ma－na线 me－ne并镜像
      (command "line" ma na "")
      (setq e1 (entlast))
      (command "line" me ne "")
      (setq e2 (entlast))
      (command "copy" e1 e2 "" pa pa)
      (command "rotate" e1 e2 ""
      (polar pa (angle pa pc) (/ (distance pa pc) 2)) "180")
      (command "pedit" "m" "all" "" "j" "" "")
      (command "zoom" "e" "")
      (prin1)
)
[/php]

ewenhui · 发表于 2005-11-18 13:39:10

多谢二位的支持！二位的lisp都可以正常运行，而且连我写的（一楼）也正常运行（今天）！！！非常非常郁闷！请问是什么原因？病毒？
刚开始学，不知我的思路健康吗？因为只熟悉cad的命令，所以用command多些。请指点！

xyp1964 · 发表于 2005-11-18 13:48:18

最初由 ewenhui 发布
[B]多谢二位的支持！二位的lisp都可以正常运行，而且连我写的（一楼）也正常运行（今天）！！！非常非常郁闷！请问是什么原因？病毒？
刚开始学，不知我的思路健康吗？因为只熟悉cad的命令，所以用command多些。请指点... [/B]

你的肯定有问题！

ewenhui · 发表于 2005-11-18 19:03:38

我终于找到问题所在：“osmode”

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

[求助]：lisp有问题

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

相关帖子

浏览过的版块