找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 1936|回复: 12

[求助] [求助]:我这程序有问题,哪位帮调一下

[复制链接]
发表于 2005-8-25 09:24:20 | 显示全部楼层 |阅读模式

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

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

×
(defun c:cb()
  (setq s1 (getpoint "n/输入第一点"))
  (setq s2 (list(+(car s1)2440)(cadr s1)))
  (setq s3 (list(+(car s1)2440)(+(cadr s1)1220)))
  (setq s4 (list(car s1)(+(cadr s1)1220)))
  (command "line" s1 s2 s3 s4 "c")
  (setq v1 (getpoint "n/输入1长宽"))          
  (setq        s5 (list(+(car s1) 5) (+(cadr s1) 5)))
  (setq        s6 (list(+(car s1) 5 (car v1)) (+(cadr s1) 5)))
  (setq        s7 (list(+(car s1) 5 (car v1)) (+(cadr s1) 5 (cadr v1))))
  (setq        s8 (list(+(car s1) 5) (+(cadr s1) 5 (cadr b1))))           
  (setq z1 (distance s1 s2))
  (setq z2 (distance s1 s4))         
  (setq l1(distance s5 s6))
  (setq l2(distance s5 s8))
  (while (>= z1 l1)
  (setq z1 (- z1 (+ l1 5)))
  (command "line" s5 s6 s7 s8 "c")
  (setq s9 s5)
  (setq s10 s6)
  (setq s11 s7)
  (setq s12 s8)
  (while (>= z2 l2)
  (setq z2 (- z2 (+ l2 5)))
  (setq s9 (list(car s9) (+(cadr s9) l2 5))
  (setq s10 (list(car s10) (+(cadr s10) l2 5))
  (setq s11 (list(car s11) (+(cadr s11) l2 5))
  (setq s12 (list(car s12) (+(cadr s12) l2 5))
  (command "line" s9 s10 s11 s12 "c")
  (setq s5 (list(+(car s5) 5 l1)(cadr s5)))
  (setq s6 (list(+(car s6) 5 l1)(cadr s6)))
  (setq s7 (list(+(car s7) 5 l1)(cadr s7)))
  (setq s8 (list(+(car s8) 5 l1)(cadr s8)))  
  )
  )
  )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
发表于 2005-8-25 09:43:36 | 显示全部楼层
快被你害死了,变量名你也写错
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2005-8-25 10:14:38 | 显示全部楼层
也不说清楚问题之所在或要达到的效果!
错误太多,括号不匹配!
[php](defun c:test ()
  ;(cmdla0)
  (setvar"osmode"0)
  (setq        s1 (getpoint "\n输入第一点 : ")
        s2 (list (+ (car s1) 2440) (cadr s1))
        s3 (list (+ (car s1) 2440) (+ (cadr s1) 1220))
        s4 (list (car s1) (+ (cadr s1) 1220))
  )
  (command "Pline" s1 s2 s3 s4 "c")
  (setq        v1 (getpoint s1 "\n输入长宽 : ")
        s5 (list (+ (car s1) 5) (+ (cadr s1) 5))
        s6 (list (+ (car s1) 5 (car v1)) (+ (cadr s1) 5))
        s7 (list (+ (car s1) 5 (car v1)) (+ (cadr s1) 5 (cadr v1)))
        s8 (list (+ (car s1) 5) (+ (cadr s1) 5 (cadr v1)))
        z1 (distance s1 s2)
        z2 (distance s1 s4)
        l1 (distance s5 s6)
        l2 (distance s5 s8)
  )
  (princ"ok")
  (while (>= z1 l1)
    (setq z1 (- z1 (+ l1 5)))
    (command "Pline" s5 s6 s7 s8 "c")
    (setq s9  s5
          s10 s6
          s11 s7
          s12 s8
    )
    (while (>= z2 l2)
      (setq z2        (- z2 (+ l2 5))
            s9        (list (car s9) (+ (cadr s9) l2 5))
            s10        (list (car s10) (+ (cadr s10) l2 5))
            s11        (list (car s11) (+ (cadr s11) l2 5))
            s12        (list (car s12) (+ (cadr s12) l2 5))
      )
      (command "Pline" s9 s10 s11 s12 "c")
      (setq s5 (list (+ (car s5) 5 l1) (cadr s5))
            s6 (list (+ (car s6) 5 l1) (cadr s6))
            s7 (list (+ (car s7) 5 l1) (cadr s7))
            s8 (list (+ (car s8) 5 l1) (cadr s8))
      )
    )
  )
  ;(cmdla1)
  (princ)
)
[/php]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2005-8-25 14:59:00 | 显示全部楼层
谢谢两位,我改后还达不到结果,改后程序如下


(defun c:cb()
  (setq OldOs (getvar "OsMode"))
  (setvar "OsMode" 0)
  (setq s1 (getpoint "n/输入第一点")
        s2 (list(+ (car s1)2440)(cadr s1))
        s3 (list(+ (car s1)2440)(+ (cadr s1)1220))
        s4 (list(car s1)(+ (cadr s1)1220))
               )
(command "line" s1 s2 s3 s4 "c")
(setq v1 (getpoint "n/输入1长宽"))
(setq s5 (list(+ (car s1) 5) (+ (cadr s1) 5)))
(setq s6 (list(+ (car s1) 5 (car v1)) (+ (cadr s1) 5)))
(setq s7 (list(+ (car s1) 5 (car v1)) (+ (cadr s1) 5 (cadr v1))))
(setq s8 (list(+ (car s1) 5) (+ (cadr s1) 5 (cadr v1))))
(setq z1 (distance s1 s2))
(setq z2 (distance s1 s4))
(setq l1(distance s5 s6))
(setq l2(distance s5 s8))
(setq z2 (- z2 (+ l2 5)))
  (while (>= z1 l1)
  (setq z1 (- z1 (+ l1 5)))
  (command "line" s5 s6 s7 s8 "c")
  (setq s9 s5
        s10 s6
        s11 s7
        s12 s8)  
  (while (>= z2 l2)
  (setq z2 (- z2 (+ l2 5)))
  (setq s9 (list(car s9) (+(cadr s9) l2 5))
       s10 (list(car s10) (+(cadr s10) l2 5))
       s11 (list(car s11) (+(cadr s11) l2 5))
       s12 (list(car s12) (+(cadr s12) l2 5)))
  (command "line" s9 s10 s11 s12 "c")
    )
  (setq s5 (list(+ (car s5) 5 l1)(cadr s5))
       s6 (list(+ (car s6) 5 l1)(cadr s6))
       s7 (list(+ (car s7) 5 l1)(cadr s7))
       s8 (list(+ (car s8) 5 l1)(cadr s8)))   
      
    )
  (setvar "OsMode" OldOs)
  )


我要的结果如附件
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 10418个

财富等级: 富甲天下

发表于 2005-8-25 16:01:14 | 显示全部楼层
[php]
(defun c:cb()
(setq OldOs (getvar "OsMode"))
(setvar "OsMode" 0)
(setq S1 (LIST 0.0 0.0 0.0) S2 (POLAR S1 (/ PI 2) 1220)
       S3 (POLAR S2 0 2440)  S4 (POLAR S1 0 2440))
(command "line" s1 s2 s3 s4 "c")
(setq v1 (getpoint "\n输入1长宽 "))
(setq S5 (list 5.0 5.0 0.0))
(setq S6 (list (+ (CAR S5) (CAR V1)) (+ (CADR S5) (CADR V1))))
(COMMAND "RECTANG" S5 S6)
(SETQ SS (ENTLAST))
(setq Z1 2440.0 Z2 1220.0)
(setq L1 (CAR V1) L2 (CADR V1))
(setq H2 (FIX (/ Z2 (+ L2 5))))
(SETQ W2 (FIX (/ Z1 (+ L1 5))))
(COMMAND "ARRAY" SS "" "R" H2 W2 (+ L2 5) (+ L1 5))
(IF (> (- Z1 (* W2 (+ L1 5))) (+ L2 5)) (PROGN
  (SETQ PT (LIST (+ (* W2 (+ L1 5)) L2 5) 5.0 0.0))
  (COMMAND "COPY" SS "" "5,5" PT "ROTATE" "L" "" PT "90")
))
(setvar "OsMode" OldOs)
)
[/php]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2005-8-25 17:48:17 | 显示全部楼层
高手,命令用得如此熟练,谢谢了,但能不能回答我,我的程序用循环相套为什么不行,能指点一下吗
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2005-8-25 19:58:47 | 显示全部楼层
这是啥语言:(setq v1 (getpoint "n/输入1长宽"))!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2005-8-25 20:13:06 | 显示全部楼层
好东东,厉害,如果v1有多个呢,并且它们的数量不一样多,怎么排列才使剩空间最小
(defun c:cb()
(setq OldOs (getvar "OsMode"))
(setvar "OsMode" 0)
(setq S1 (LIST 0.0 0.0 0.0) S2 (POLAR S1 (/ PI 2) 1220)
       S3 (POLAR S2 0 2440)  S4 (POLAR S1 0 2440))
(command "line" s1 s2 s3 s4 "c")
(setq v1 (getpoint "\n输入1长宽 "))
(setq v2 (getpoint "\n输入2长宽 "))
(setq v3(getpoint "\n输入3长宽 "))
.......



(setq S5 (list 5.0 5.0 0.0))
(setq S6 (list (+ (CAR S5) (CAR V1)) (+ (CADR S5) (CADR V1))))
(COMMAND "RECTANG" S5 S6)
(SETQ SS (ENTLAST))
(setq Z1 2440.0 Z2 1220.0)
(setq L1 (CAR V1) L2 (CADR V1))
(setq H2 (FIX (/ Z2 (+ L2 5))))
(SETQ W2 (FIX (/ Z1 (+ L1 5))))
(COMMAND "ARRAY" SS "" "R" H2 W2 (+ L2 5) (+ L1 5))
(IF (> (- Z1 (* W2 (+ L1 5))) (+ L2 5)) (PROGN
  (SETQ PT (LIST (+ (* W2 (+ L1 5)) L2 5) 5.0 0.0))
  (COMMAND "COPY" SS "" "5,5" PT "ROTATE" "L" "" PT "90")
))
(setvar "OsMode" OldOs)
)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2005-8-25 20:22:18 | 显示全部楼层
7楼楼主说:   9pt 10pt 11pt 12pt 13pt 15pt  

这是啥语言:(setq v1 (getpoint "n/输入1长宽"))!  



不好意思,我本来是要输入多个矩形的长宽,想到点就有3个参数,并且它们是一组,就用点代替了,这位大哥,有什么好的方法输入多个数据,并且能把数据分组吗,谢谢
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2005-8-25 23:50:40 | 显示全部楼层
试试下面这个:
  1. [FONT=courier new](load "xyp_lib")
  2. ;|加载通用函数(可在签名栏直接下载)
  3. 如果已经下载xyp_lib并放到搜索路径下可以不再下载!
  4. 利用以下任何一种方式即可加载和运行通用函数内的所有子程序:
  5. 1.在acad.lsp中增加(load"xyp_lib")
  6. 2.在每个程序内增加(load"xyp_lib")
  7. 3.在command下,输入(load"xyp_lib")
  8. 4.在菜单.mnl中增加(load"xyp_lib")
  9. 5.将xyp_lib.vlx文件直接拽到cad屏幕
  10. [COLOR=red] ★通用函数下载地址:[/COLOR]
  11. [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]
  12. [url]http://www.mjtd.com/bbs/dispbbs.asp?boardID=3&ID=37554&page=1[/url]|;

  13. ;;;板材分割
  14. (defun c:test ()
  15.   (cmdla0)
  16.   (setq        s1 (getpoint "\n输入第一点 : ")
  17.         s3 (list (+ (car s1) 2440) (+ (cadr s1) 1220))
  18.   )
  19.   (setvar "osmode" 0)
  20.   (command "rectang" s1 s3)
  21.   (mkla "单块板材" 1)
  22.   (setq        leng (UREAL 7 "" "\n输入单块板材宽" leng)
  23.         wide (UREAL 7 "" "\n输入单块板材高" wide)
  24.         l1   (+ leng 5)
  25.         w1   (+ wide 5)
  26.   )
  27.   (if (and (< l1 2440)
  28.            (< w1 1220)
  29.       )
  30.     (progn
  31.       (setq h1        (fix (/ 2435 l1))
  32.             v1        (fix (/ 1215 w1))
  33.             pt        (list (+ (car s1) 5) (+ (cadr s1) 5))
  34.             pt1        (list (+ (car pt) leng) (+ (cadr pt) wide))
  35.       )
  36.       (command "rectang" pt pt1)
  37.       (cond ((and (> h1 1) (> v1 1))
  38.              (command "array" "l" "" "R" v1 h1 w1 l1)
  39.             )
  40.             ((and (> h1 1) (= v1 1))
  41.              (command "array" "l" "" "R" v1 h1 l1)
  42.             )
  43.             ((and (= h1 1) (> v1 1))
  44.              (command "array" "l" "" "R" v1 h1 w1)
  45.             )
  46.             (T (princ))
  47.       )
  48.     )
  49.   )
  50.   (if (> (- 2440 (* l1 h1)) w1)
  51.     (progn
  52.       (setq v2        (fix (/ 1215 l1 1.0))
  53.             h2        (fix (/ (- 2440 (* l1 h1)) w1 1.0))
  54.             pt        (list (+ (car s1) 5 (* l1 h1)) (+ (cadr s1) 5))
  55.             pt1        (list (+ (car pt) wide) (+ (cadr pt) leng))
  56.       )
  57.       (command "rectang" pt pt1)
  58.       (cond ((and (> h2 1) (> v2 1))
  59.              (command "array" "l" "" "R" v2 h2 l1 w1)
  60.             )
  61.             ((and (> h2 1) (= v2 1))
  62.              (command "array" "l" "" "R" v2 h2 w1)
  63.             )
  64.             ((and (= h2 1) (> v2 1))
  65.              (command "array" "l" "" "R" v2 h2 l1)
  66.             )
  67.             (T (princ))
  68.       )
  69.     )
  70.   )
  71.   (if (and (> (* v1 h1) 1) (> (* v2 h2) 1))
  72.     (progn
  73.       (princ "\n共裁剪单块板材 ")
  74.       (princ (+ (* v1 h1) (* v2 h2)))
  75.       (princ " 块")
  76.     )
  77.   )
  78.   (if (and (> (* v1 h1) 1) (= (* v2 h2) 1))
  79.     (progn
  80.       (princ "\n共裁剪单块板材 ")
  81.       (princ (* v1 h1))
  82.       (princ " 块")
  83.     )
  84.   )
  85.   (cmdla1)
  86. )[/FONT]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2005-8-26 11:36:39 | 显示全部楼层
最初由 xyp1964 发布
[B]试试下面这个:
[CODE](load "xyp_lib")
;|加载通用函数(可在签名栏直接下载)
如果已经下载xyp_lib并放到搜索路径下可以不再下载!
利用以下任何一种方式即可加载和运行通用函数内的所有子程序... [/B]







斑竹,我刚用你的程序试了一下,加载后打test命令怎么没反应呢,是不是其它命令呀
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2005-8-26 12:01:41 | 显示全部楼层
最初由 wxl1981807 发布
[B][QUOTE]最初由 xyp1964 发布
[B]试试下面这个:
[CODE](load "xyp_lib")
;|加载通用函数(可在签名栏直接下载)
如果已经下载xyp_lib并放到搜索路径下可以不再下载!
利用以下任何一种方... [/B]

是否下载并加载xyp_lib通用程序?
你的信箱已满请删除清空!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2005-8-26 17:01:18 | 显示全部楼层
谢谢,斑竹
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-11-22 13:39 , Processed in 0.212622 second(s), 56 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表