[原创]：绘制铁路线程序

xyp1964

试试：
[php]

;;-----------------------------------------------------------------------------
;;;铁路线绘制
;;;把spline变成铁路线示图 ljc 2004.3
;;;加载通用函数
;;;下载：http://www.xdcad.net/forum/showthread.php?s=&threadid=325268
(load "xyp_lib.lsp")

(defun c:test060 (/ line n0 j linex q qd zd cdd ang qdz dqy)
  (cmdla0)
  (setvar "osmode" 0)
  (princ "\n请选择铁路线(SPLINE) : ")
  (setq        line (ssget '((0 . "SPLINE")))
        ds   (ureal 1 "" "\n请输入黑白段长度" ds)
        cd   (ureal 1 "" "\n请输入铁路线的宽度" cd)
  )
  (command "ucs" "")
  (command "erase" (ssget "x" '((0 . "point"))))
  (setq        n0 (sslength line)
        j  0
        n2 0
  )
  (repeat n0
    (setq linex        (ssname line j)
          cdd        (/ cd 2)
          q        (entget linex)
          Zd        (cdr (assoc 10 q))
          qd        (cdr (LAST q))
          ANG        (ANGLE QD ZD)
          qdz        (polar qd (+ ANG (/ PI 2)) (* 10 cd))
          qdy        (polar qd (- ANG (/ PI 2)) (* 10 cd))
    )
    (command "offset" cdd linex qdz linex qdy "")
    (command "measure" linex ds)
    (setq point        (ssget "x" '((0 . "point")))
          n        (sslength point)
          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)
            i  (+ i 1)
      )
    )
    (setq j (+ j 1))
    (if        (= 2 ii)
      (O1O linex cd)
      (command "erase" linex "")
    )
  )
  (command "zoom" "e")
  (cmdla1)
  (pxyp "TL      (铁路)")
)
(DEFUN O1O (name cd / cm tc os q zd qd ang qdz zdy w1 w2 w3 w4 p1p2 p3
            p4)
  (setvar "osmode" 0)
  (setq        cd  (/ cd 2)
        q   (entget name)
        Zd  (cdr (assoc 10 q))
        qd  (cdr (LAST q))
        ANG (ANGLE QD ZD)
        qdz (polar qd (+ ANG (/ PI 2)) cd)
        qdy (polar qd (- ANG (/ PI 2)) cd)
  )
  (command "offset" cd name qdz "")
  (setq        w1 (entlast)
        p1 (cdr (assoc 10 (entget w1)))
        p2 (cdr (last (entget w1)))
  )
  (command "offset" cd name qdy "")
  (setq        w2 (entlast)
        p4 (cdr (assoc 10 (entget w2)))
        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 "")
)
(defun c:tl () (c:test060))
[/php]

lingfengm

恩，不错，下了
期待楼主正式版

carnys

没有钱钱 不能下 好郁闷

gxls63

到目前为止，楼主还没修改程度啊，希望正式版早日出台

方脑壳

在CAD2005下,如果数值设置不合适,似乎叫做溢出,很容易导致CAD无响应,能不能有一个可供选择的范围呢?

冰斌

正式版早已在第一帖之时就生成，自己用着，由于想收回一点成本，自己防盗、注册编程技术不太精，经济上还可以维持一段时间，加之回帖不多，想必用到此技术的人不太多，罢了，罢了。

xzkyf

我无法下载，可以发给我吗？
xzkyf@163.com
谢谢！！！！！！！

lujian328

感谢呀~~~

lujian328

我是刚注册的呀,要画铁路线,谢谢可以给我传油箱吗
www.lujian328@eyou.com

zhangjp

好东西 支持一下 PHP 代码是LISP 源码吗 我用LISP 加载后 CAD 自动退出

qiaofeng

我下了,很好用.

lishaojun

不错，谢谢分享！！

时光流动

d

czad

不错不错，可以节省很多画屋面保温层的工作量了^_^还希望楼主照顾一下偶们这等穷人啊:)

heroeric

想法是什么？