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

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › [LISP程序]：求教;如何画铁路线
返回列表 发新帖
查看: 953|回复: 5

[LISP程序]：求教;如何画铁路线

[复制链接]
陈西
发表于 2005-10-13 23:04:50 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

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

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

×
求各位大侠帮忙!
我LISP画铁路程序如下:
;把spline变成铁路线示图
;ljc 2004.3
(DEFUN O1O( name cd / cm tc os q zd qd ang qdz zdy w1 w2 w3 w4 p1p2 p3 p4 ) ;name--spline的图元名 cd铁路线的宽度
          (setq cm(getvar "cmdecho") tc(getvar "clayer") os(getvar "osmode"))
          (command "osnap" "off")
          (setq cd(/ cd 2))
          (setq q(entget name))
          (setq Zd (cdr(assoc 10 q)))
          (setq qd (cdr(LAST q)))
          (SETQ ANG (ANGLE QD ZD))
          (SETQ  qdz (polar qd (+ ANG ( / PI 2)) cd))
          (setq  qdy (polar qd (- ANG ( / PI 2)) cd))
          (command "offset"  cd name qdz  "")
          (setq w1(entlast))
          (setq p1 (cdr(assoc 10 (entget w1))))
          (setq p2 (cdr(last (entget w1))))
          (command "offset"  cd name qdy  "")
          (setq w2(entlast))         
          (setq p4 (cdr(assoc 10 (entget w2))))
          (setq p3 (cdr(last (entget w2))))
          (command "line" p1 p4 "")    (setq w3(entlast))     
          (command "line" p2 p3 "")    (setq w4(entlast))
          (command "-bhatch" "p" "solid" "s" w1 w2 w3 w4 "" "")
          (command "erase" w1 w2 w3 w4 name "")
          (setvar "cmdecho" cm)
          (setvar "osmode" os)
          (setvar "clayer"  tc)
)
(defun c:tl( / line n0 j linex q qd zd cdd ang qdz dqy)
   (setq cm(getvar "cmdecho") tc(getvar "clayer") os(getvar "osmode"))
   (command "osnap" "off")
   (print "请选择铁路线:") (print)
   (setq line (ssget '((0 . "SPLINE"))))
   (setq ds(getint "请输黑白段长度:"))
   (setq cd(getreal "请输入绘制铁路线的宽度:"))
   (command "ucs" "" "")
   (command "erase" (ssget "x" '((0 . "point"))) "")
   (setq n0 (sslength line))
   (setq j 0  n2 0)
  (repeat n0
   (setq linex (ssname line j))  
   (setq cdd(/ cd 2))
   (setq q(entget linex))
   (setq Zd (cdr(assoc 10 q)))
   (setq qd (cdr(LAST q)))
   (SETQ ANG (ANGLE QD ZD))
   (SETQ  qdz (polar qd (+ ANG ( / PI 2)) (* 10 cd)))
   (setq  qdy (polar qd (- ANG ( / PI 2)) (* 10 cd)))
   (command "offset"  cdd linex qdz linex qdy "")
   (command "measure" linex ds "")
   (command)
   (setq point (ssget "x" '((0 . "point"))))
   (setq n (sslength point))
   (setq i 0 ii 0)
   (repeat n
   (setq p1 (cdr(assoc 10 (entget(ssname point i)))))
   (command "erase" (ssname point i) "")
   (command "zoom" "w" (polar p1 (* pi 0.75) ds )  (polar p1 (* pi -0.25) ds ) )
   (command "break"  (list (car p1) (cadr p1)  (caddr p1))  "@" )
   (if (= 2 ii) (setq ii 0))
   (if (= 0 ii) (o1o (entlast) cd) (command "erase" (entlast) ""))
   (setq ii (1+ ii))  
   (setq i (+ i 1))
   )
   (setq j (+ j 1))
   (if (= 2 ii) (o1o linex cd) (command "erase" linex ""))
  )
   (command "zoom" "e" "")
(setvar "cmdecho" cm)
          (setvar "osmode" os)
          (setvar "clayer"  tc)
  
(print "敲入tL运行程序---LJC") (PRINT)
加载后不能画铁路线,请指导或提供新程序.谢谢!
setq, command, 铁路线

相关帖子

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

使用道具 举报

ashan
发表于 2005-10-13 23:24:39 | 显示全部楼层
其实最简单的方法是加载一种特殊的“铁路线”线型，直接使用这种线型画线就可以了，剪切修改起来也很方便
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

xyp1964
发表于 2005-10-13 23:47:57 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

Re: [LISP程序]：求教;如何画铁路线

最初由 陈西 发布
[B]求各位大侠帮忙!
我LISP画铁路程序如下:
;把spline变成铁路线示图
;ljc 2004.3
(DEFUN O1O( name cd / cm tc os q zd qd ang qdz zdy w1 w2 w3 w4 p1p2 p3 p4 ) ;name--spline的图元名 cd铁路线的宽度
        ... [/B]


试试：
  2. [FONT=courier new](defun c:tl (/ line n0 j linex q qd zd cdd ang qdz dqy)
  3.   (setq        cm (getvar "cmdecho")
  4.         tc (getvar "clayer")
  5.         os (getvar "osmode")
  6.   )
  7.   (command "osnap" "off")
  8.   (print "\n请选择铁路线 : ")
  9.   (setq        line (ssget '((0 . "SPLINE")))
  10.         ds   (getint "\n请输黑白段长度 : ")
  11.         cd   (getreal "\n请输入绘制铁路线的宽度 : ")
  12.   )
  13.   (command "ucs" "" "")
  14.   (command "erase" (ssget "x" '((0 . "point"))) "")
  15.   (setq        n0 (sslength line)
  16.         j  0
  17.         n2 0
  18.   )
  19.   (repeat n0
  20.     (setq linex        (ssname line j)
  21.           cdd        (/ cd 2)
  22.           q        (entget linex)
  23.           Zd        (cdr (assoc 10 q))
  24.           qd        (cdr (LAST q))
  25.           ANG        (ANGLE QD ZD)
  26.           qdz        (polar qd (+ ANG (/ PI 2)) (* 10 cd))
  27.           qdy        (polar qd (- ANG (/ PI 2)) (* 10 cd))
  28.     )
  29.     (command "offset" cdd linex qdz linex qdy "")
  30.     (command "measure" linex ds "")
  31.     (command)
  32.     (setq point        (ssget "x" '((0 . "point")))
  33.           n        (sslength point)
  34.           i        0
  35.           ii        0
  36.     )
  37.     (repeat n
  38.       (setq p1 (cdr (assoc 10 (entget (ssname point i)))))
  39.       (command "erase" (ssname point i) "")
  40.       (command "zoom"
  41.                "w"
  42.                (polar p1 (* pi 0.75) ds)
  43.                (polar p1 (* pi -0.25) ds)
  44.       )
  45.       (command "break" (list (car p1) (cadr p1) (caddr p1)) "@")
  46.       (if (= 2 ii)
  47.         (setq ii 0)
  48.       )
  49.       (if (= 0 ii)
  50.         (o1o (entlast) cd)
  51.         (command "erase" (entlast) "")
  52.       )
  53.       (setq ii (1+ ii)
  54.             i  (+ i 1)
  55.       )
  56.     )
  57.     (setq j (+ j 1))
  58.     (if        (= 2 ii)
  59.       (o1o linex cd)
  60.       (command "erase" linex "")
  61.     )
  62.   )
  63.   (command "zoom" "e" "")
  64.   (setvar "cmdecho" cm)
  65.   (setvar "osmode" os)
  66.   (setvar "clayer" tc)
  67. )
  68. (print "敲入tL运行程序---LJC")
  69. (PRINT)


  72. (DEFUN O1O (name cd / cm tc os q zd qd ang qdz zdy w1 w2 w3 w4 p1p2 p3
  73.             p4)
  74.   (setq        cm (getvar "cmdecho")
  75.         tc (getvar "clayer")
  76.         os (getvar "osmode")
  77.   )
  78.   (command "osnap" "off")
  79.   (setq        cd  (/ cd 2)
  80.         q   (entget name)
  81.         Zd  (cdr (assoc 10 q))
  82.         qd  (cdr (LAST q))
  83.         ANG (ANGLE QD ZD)
  84.         qdz (polar qd (+ ANG (/ PI 2)) cd)
  85.         qdy (polar qd (- ANG (/ PI 2)) cd)
  86.   )
  87.   (command "offset" cd name qdz "")
  88.   (setq        w1 (entlast)
  89.         p1 (cdr (assoc 10 (entget w1)))
  90.         p2 (cdr (last (entget w1)))
  91.   )
  92.   (command "offset" cd name qdy "")
  93.   (setq        w2 (entlast)
  94.         p4 (cdr (assoc 10 (entget w2)))
  95.         p3 (cdr (last (entget w2)))
  96.   )
  97.   (command "line" p1 p4 "")
  98.   (setq w3 (entlast))
  99.   (command "line" p2 p3 "")
  100.   (setq w4 (entlast))
  101.   (command "-bhatch" "p" "solid" "s" w1 w2 w3 w4 "" "")
  102.   (command "erase" w1 w2 w3 w4 name "")
  103.   (setvar "cmdecho" cm)
  104.   (setvar "osmode" os)
  105.   (setvar "clayer" tc)
  106. )[/FONT]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

狂刀
发表于 2005-10-14 00:34:11 | 显示全部楼层
关于画铁路线，我认为两种方法最可取
1.用线形
2.3条曲线组成，中间一条为有宽度虚线
两种方法都不用将spline改成多义线
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

WHGF
发表于 2005-10-14 06:34:14 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
如果用三条线,属性如何给
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

陈西
 楼主| 发表于 2005-10-15 08:33:45 | 显示全部楼层
请问能否适用2006,我加载运行告诉我函数错误,不知如何解决?谢谢!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2025-9-28 17:07 , Processed in 0.182504 second(s), 41 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2025 Discuz! Team.

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