设为首页收藏本站转
发帖领奖家园QQ群申请版主版主评价切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › [编程申请]：请高手帮忙修改程序
返回列表 发新帖
查看: 1674|回复: 4

[编程申请]：请高手帮忙修改程序

[复制链接]
lsy

已领礼包: 39个

财富等级: 招财进宝
发表于 2002-11-12 13:15:44 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

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

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

×

  3. [FONT=courier new]
  4. (defun c:pm(/ x0 y0 x y p0 n m x1 y1 p1 g high i)
  5.   (setq y0 4000)
  6.   (setq x0 3000)
  7.   (setq g 1000)
  8.   (setq y1 (- y0 2))
  9.   (setq p1 (list x0 y1))
  10.   (setq high (strcat (rtos x0) "," (rtos y0)))
  11.   (setq x x0)
  12.   (setq y y0)
  13.   (setq p0 (list x0 y0))
  14.   (setq n 5)
  15.   (setq m 5)
  16.   (setq x1 x0)
  17.   (setq y1 (+ y0 (* m 100)))
  18.   (setq p1 (list x1 y1))
  19. ;--------vertical line---------------
  20.   (repeat n
  21.         (setq x (+ x 100))
  22.         (setq p0 (list x y0))
  23.         (setq p1 (list x y1))
  24.    )   
  25. ;-------------hor-line----------------
  26.   (setq p0 (list x0 y0))
  27.   (setq x1 (+ x0 (* n 100)))
  28.   (setq p1 (list x1 y0))
  29.   (repeat m
  30.         (setq y (+ y 100))
  31.         (setq p0 (list x0 y))
  32.         (setq p1 (list x1 y))
  33.   )   
  34. ;-----------Post of [xmy]------------------
  35.   (setq i 1)
  36.   (while i
  37.     (setq x(getreal "\nEnter[x,y]:"))
  38.     (setq y(getreal "\nEnter[x,y]:"))
  39.     (setq x1 (+ x0 (/ (* 1000.0 (- y x0)) g)))
  40.     (setq y1 (+ y0 (/ (* 1000.0 (- x y0)) g)))
  41.     (setq p0 (list x1 y1))
  42.     (setq p1 (list (+ x1 1) y1))
  43.     (setq high (getstring "High:"))
  44.     (if (= high "-1")
  45.       (setq i NIL)
  46.       (progn
  47.          (command "donut" 0 0.3 p0 "")
  48.          (command "text" "j" "ML" p1 1.5 0 high)
  49.       ))
  50.   )      ;while
  51. )


  54. 最后一段能不能从手工输入改为以文件形式输入，如文件为：
  55. 1000,2000,1678.23
  56. 1050,2080,1656.78
  57. ...........
  58. x,y,high[/FONT]
setq, list, high

相关帖子

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

使用道具 举报

Qlin
发表于 2002-11-14 03:31:46 | 显示全部楼层
读数据文件的代码
说明：
1、一时偷懒，字符串分隔引用了晓东API函数
2、省略对数据文件格式进行完整性校验的代码


  3. (defun Read_File (/ f_nam f_id lst_pt str_line x y high)
  4.   (setq f_nam (getfiled "选择数据文件" "" "" 12)
  5.   (if f_nam (progn
  6.     (setq f_id (open f_nam "r"))
  7.     (while (setq str_line (read-line f_id))
  8.       (setq lst_pt (xdrx_string_split str_line ","))
  9.       (setq x (atof (car lst_pt))
  10.             y (atof (cadr lst_pt))
  11.             high (atof (caddr lst_pt))
  12.       );setq

  14.       ;;;这里可以加入你的代码
  15.       
  16.     );while
  17.     (close f_id)
  18.   ));if
  19. );end
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

lsy

已领礼包: 39个

财富等级: 招财进宝
 楼主| 发表于 2002-11-14 13:00:28 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
上边那段程序怎样才能完整地加入到我的程序里
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

梦断江南
发表于 2002-11-14 13:38:08 | 显示全部楼层
(setq x (atof (car lst_pt))
            y (atof (cadr lst_pt))
            high (atof (cadr lst_pt))
      );setq
>>> high (atof (last lst_pt))
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

Qlin
发表于 2002-11-17 14:12:24 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
谢谢梦断江南的修改

帮人帮到底：
加入文件读取功能后的代码：
(需要先加载晓东API)

  3. (defun c:pm (/ x0 y0 x y p0 n m x1 y1 p1 g high i)
  4.   (setq y0 4000)
  5.   (setq x0 3000)
  6.   (setq g 1000)
  7.   (setq y1 (- y0 2))
  8.   (setq p1 (list x0 y1))
  9.   (setq high (strcat (rtos x0) "," (rtos y0)))
  10.   (setq x x0)
  11.   (setq y y0)
  12.   (setq p0 (list x0 y0))
  13.   (setq n 5)
  14.   (setq m 5)
  15.   (setq x1 x0)
  16.   (setq y1 (+ y0 (* m 100)))
  17.   (setq p1 (list x1 y1))
  18. ;--------vertical line---------------
  19.   (repeat n
  20.         (setq x (+ x 100))
  21.         (setq p0 (list x y0))
  22.         (setq p1 (list x y1))
  23.    )   
  24. ;-------------hor-line----------------
  25.   (setq p0 (list x0 y0))
  26.   (setq x1 (+ x0 (* n 100)))
  27.   (setq p1 (list x1 y0))
  28.   (repeat m
  29.         (setq y (+ y 100))
  30.         (setq p0 (list x0 y))
  31.         (setq p1 (list x1 y))
  32.   )   
  33. ;-----------Post of [xmy]------------------
  34.   (Read_dataFile)
  35. );end

  37. (defun Read_dataFile (/ f_nam f_id lst_pt str_line cmd)
  38.   (setq f_nam (getfiled "选择数据文件" "" "" 12))
  39.   (if f_nam (progn
  40.     (setq f_id (open f_nam "r"))

  42.     (setq cmd (getvar "cmdecho"))
  43.     (setvar "cmdecho" 0)
  44.    
  45.     (while (setq str_line (read-line f_id))
  46.       (setq lst_pt (xdrx_string_split str_line ","))
  47.       (setq x (atof (car lst_pt))
  48.             y (atof (cadr lst_pt))
  49.             high (caddr lst_pt)
  50.       );setq
  51.       
  52.       ;;;以下加入你的代码
  53.       (setq x1 (+ x0 (/ (* 1000.0 (- y x0)) g)))
  54.       (setq y1 (+ y0 (/ (* 1000.0 (- x y0)) g)))
  55.       (setq p0 (list x1 y1))
  56.       (setq p1 (list (+ x1 1) y1))
  57.       (command "donut" 0 0.3 p0 "")
  58.       (command "text" "j" "ML" p1 1.5 0 high)
  59.     );while
  60.     (close f_id)
  61.     (setvar "cmdecho" cmd)
  62.   ));if
  63. );end
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

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

GMT+8, 2025-9-26 09:30 , Processed in 0.368534 second(s), 40 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2025 Discuz! Team.

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