找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 1931|回复: 3

[LISP程序]:取道路中心线

[复制链接]
发表于 2007-1-18 23:28:37 | 显示全部楼层 |阅读模式

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

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

×
;;;;取道路中心线
(defun c:zdd()
   (command "osnap" "nea" "")
  ;;;(setq r (getint "\n输入确定中心线的组点数:"))
   (setq p1 (getpoint "\n选择线上点:"))
   (setq p2 (getpoint "\n选择线对面点:"))
   (setq rr 0)
   (setq jj 0)
   (setq pts'())
   ;;(repeat r
   (while p2
   (setq rr (+ rr 1))
   (setq srr (itoa rr))
   (setq jj (+ jj 1))
   (setq sjj (itoa jj))
   ;(setq pa (strcat "a" srr))
   ;(setq pb (strcat "b" sjj))
   ;(setq tsa (strcat "\n选择第" srr "组点:"))
   ;(setq tsb (strcat "\n选择第" sjj "组对面点:"))
   ;(setq pta (getpoint tsa))
   ;(setq ptb (getpoint tsb))
   (setq ptax (car p1)
         ptay (cadr p1)
   )
   (setq ptbx (car p2)
         ptby (cadr p2)
    )
   (setq ptcx (/ (+ ptax ptbx) 2))
   (setq ptcy (/ (+ ptay ptby) 2))
;;(setq ptc (strcat "pt" (itoa rr)))
(setq ptc (list ptcx ptcy));;;确定第一点
(setq pts (cons ptc pts))
(setq p1 (getpoint "\n选择线上点:"))
(setq p2 (getpoint "\n选择线对面点:"))
)
(command "layer" "m" "次干道中心线(yp)" "c" 50 "" "")
(command "linetype" "s" "lzx" "")
(command "pline")
(setq iii 0)
(setq len (length pts))
(while (< iii len)
  (command (nth iii pts) "w" 0 0)
  (setq iii (1+ iii))
  )
(command  "")
)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!

已领礼包: 1个

财富等级: 恭喜发财

发表于 2007-1-30 14:21:04 | 显示全部楼层
(command "linetype" "s" "lzx" "")
====>
(command "linetype" "s" "center" "")
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 2个

财富等级: 恭喜发财

发表于 2007-3-5 18:13:18 | 显示全部楼层
楼主的代码,根据我的理解将其改变后如下:

  1. ;;;;取道路中心线
  2. (defun c:zdd()
  3.         (command "osnap" "nea" "")
  4.         (command "layer" "m" "次干道中心线(yp)" "c" 50 "" "")
  5.         (command "linetype" "s" "lzx" "")
  6.         (command "pline")
  7.         (while        (if        (setq pt1 (getpoint "\n选择线上一点>:"))
  8.                         (if        (setq pt2 (getpoint pt1 "选择线对面点>:"))
  9.                         )
  10.                 )
  11.                 (setq        pt1x        (car pt1)
  12.                         pt1y        (cadr pt1)
  13.                         pt2x        (car pt2)
  14.                         pt2y        (cadr pt2)
  15.                         pt3x        (/ (+ pt1x pt2x) 2.0)
  16.                         pt3y        (/ (+ pt1y pt2y) 2.0)
  17.                         pt3        (list pt3x pt3y)
  18.                 )
  19.                 (command pt3 "w" 0 0)
  20.         )
  21.         (command "")
  22.         (princ)
  23. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

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

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-11-17 21:48 , Processed in 0.173211 second(s), 35 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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