[分享]：修改后的铁路绘制。

eachy · 发表于 2002-9-20 01:34:18

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

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

×

更新：
1 不再使用线型
2 可以窗选曲线（Line、Arc、未拟合的Pline)

($xdrx_load "xdlsp.lsp")
(defun c:xdtb_tlx (/ ss e tf1 sp plst lp0 lp1 ang e1 e2 ep len num num1 p1 p2)
(if (not $XDTB_GLOBAL_SCALE)
(setq $XDTB_GLOBAL_SCALE 100.0)
)
(xdrx_begin "铁路")
(xdrx_SysVar_Push "cmdecho" "osmode" "offsetdist")
(setvar "osmode" 0)
(setq ss (ssget '((0 . "LINE,ARC,*POLYLINE"))))
(if ss
(progn
(xdrx_setsstodb ss 0)
(if (setq tf1 (apply 'xdrx_isptoffscr (xdrx_entity_box ss)))
(progn
(xdrx_drawing_viewsave)
(xdrx_drawing_zoomw
(car (xdrx_entity_box ss))
(nth 3 (xdrx_entity_box ss))
)
)
)
(while (setq e (xdrx_getentdata 0))
(if (> (setq len (last (xdrx_getarea e)))
(* $XDTB_GLOBAL_SCALE 20.0)
)
(progn
(xdrx_modent 8 "TLX")
(setq sp (car (xdrx_curve_getpoint e))
ep (last (xdrx_curve_getpoint e))
num (fix (/ len (* $XDTB_GLOBAL_SCALE 20.0)))
num1 (/ (rem len (* $XDTB_GLOBAL_SCALE 20.0)) 2)
ang (last
(xdrx_getperpline
e
(list (car sp) (cadr sp) '0)
)
)
lp0 (polar sp ang 1)
lp1 (polar sp (+ ang pi) 1)
)
(cond
((= num1 0)
(setq p1 (xdrx_getpointatdist
e
ep
(- (* $XDTB_GLOBAL_SCALE
(if (= (rem num 2) 0)
10.0
20.0
)
)
)
)
p2 (xdrx_getpointatdist
e
p1
(- (* $XDTB_GLOBAL_SCALE 20.0))
)
)
)
((/= num1 0)
(setq p1 (xdrx_getpointatdist
e
ep
(- num1)
)
p2
(xdrx_getpointatdist
e
p1
(- (* $XDTB_GLOBAL_SCALE 20.0))
)
)
)
(T)
)
(mapcar 'setvar
'("offsetdist" "osmode")
(list (* $XDTB_GLOBAL_SCALE 0.500) 0)
)
(c:xdrx_setmark)
(command ".offset" "" (cons e (list sp)) lp0 "")
(setq e1 (entlast))
(redraw e1 2)
(command ".offset" "" (cons e (list sp)) lp1 "")
(setq e2 (entlast))
(redraw e2 2)
(while (and (xdrx_ison p1 e) p2)
(command ".break"
(cons e (list sp))
"f"
p1
(if (xdrx_ison p2 e)
p2
sp
)
)
(if (wcmatch (xdrx_getentdxf 0) "*POLYLINE")
(command ".pedit" (entlast) "w" $XDTB_GLOBAL_SCALE "")
(command ".pedit"
(entlast)
"y"
"w"
$XDTB_GLOBAL_SCALE
""
)
)
(setq p1 (xdrx_getpointatdist
e
p2
(- (* $XDTB_GLOBAL_SCALE 20.0))
)
p2
(xdrx_getpointatdist
e
p1
(- (* $XDTB_GLOBAL_SCALE 20.0))
)
)
)
(redraw e1 1)
(redraw e2 1)
(xdrx_setenttodb e)
(if (wcmatch (xdrx_getentdxf 0) "*POLYLINE")
(command ".pedit"
(cons e (list sp))
"w"
$XDTB_GLOBAL_SCALE
""
)
(command ".pedit"
(cons e (list sp))
"y"
"w"
$XDTB_GLOBAL_SCALE
""
)
)
(xdrx_block_make (ssadd e (c:xdrx_getss)) sp T)
(xdrx_setenttodb (entlast))
(xdrx_modent 8 "TLX")
)
)
)
)
)
(if tf1
(xdrx_drawing_viewres)
)
(xdrx_end)
(xdrx_SysVar_Pop)
(princ)
)

($xdrx_load "xdlsp.lsp") 
(defun c:xdtb_tlx (/ ss e tf1 sp plst lp0 lp1 ang e1 e2 ep len num num1 p1 p2) 
  (if (not $XDTB_GLOBAL_SCALE) 
    (setq $XDTB_GLOBAL_SCALE 100.0) 
  ) 
  (xdrx_begin "铁路") 
  (xdrx_SysVar_Push "cmdecho" "osmode" "offsetdist") 
  (setvar "osmode" 0) 
  (setq ss (ssget '((0 . "LINE,ARC,*POLYLINE")))) 
  (if ss 
    (progn 
      (xdrx_setsstodb ss 0) 
      (if (setq tf1 (apply 'xdrx_isptoffscr (xdrx_entity_box ss))) 
        (progn 
          (xdrx_drawing_viewsave) 
          (xdrx_drawing_zoomw 
            (car (xdrx_entity_box ss)) 
            (nth 3 (xdrx_entity_box ss)) 
          ) 
        ) 
      ) 
      (while (setq e (xdrx_getentdata 0)) 
        (if (> (setq len (last (xdrx_getarea e))) 
               (* $XDTB_GLOBAL_SCALE 20.0) 
            ) 
          (progn 
            (xdrx_modent 8 "TLX") 
            (setq sp   (car (xdrx_curve_getpoint e)) 
                  ep   (last (xdrx_curve_getpoint e)) 
                  num  (fix (/ len (* $XDTB_GLOBAL_SCALE 20.0))) 
                  num1 (/ (rem len (* $XDTB_GLOBAL_SCALE 20.0)) 2) 
                  ang  (last 
                         (xdrx_getperpline 
                           e 
                           (list (car sp) (cadr sp) '0) 
                         ) 
                       ) 
                  lp0  (polar sp ang 1) 
                  lp1  (polar sp (+ ang pi) 1) 
            ) 
            (cond 
              ((= num1 0) 
               (setq p1        (xdrx_getpointatdist 
                          e 
                          ep 
                          (- (*        $XDTB_GLOBAL_SCALE 
                                (if (= (rem num 2) 0) 
                                  10.0 
                                  20.0 
                                ) 
                             ) 
                          ) 
                        ) 
                     p2        (xdrx_getpointatdist 
                          e 
                          p1 
                          (- (* $XDTB_GLOBAL_SCALE 20.0)) 
                        ) 
               ) 
              ) 
              ((/= num1 0) 
               (setq p1        (xdrx_getpointatdist 
                          e 
                          ep 
                          (- num1) 
                        ) 
                     p2 
                        (xdrx_getpointatdist 
                          e 
                          p1 
                          (- (* $XDTB_GLOBAL_SCALE 20.0)) 
                        ) 
               ) 
              ) 
              (T) 
            ) 
            (mapcar 'setvar 
                    '("offsetdist" "osmode") 
                    (list (* $XDTB_GLOBAL_SCALE 0.500) 0) 
            ) 
            (c:xdrx_setmark) 
            (command ".offset" "" (cons e (list sp)) lp0 "") 
            (setq e1 (entlast)) 
            (redraw e1 2) 
            (command ".offset" "" (cons e (list sp)) lp1 "") 
            (setq e2 (entlast)) 
            (redraw e2 2) 
            (while (and (xdrx_ison p1 e) p2) 
              (command ".break" 
                       (cons e (list sp)) 
                       "f" 
                       p1 
                       (if (xdrx_ison p2 e) 
                         p2 
                         sp 
                       ) 
              ) 
              (if (wcmatch (xdrx_getentdxf 0) "*POLYLINE") 
                (command ".pedit" (entlast) "w" $XDTB_GLOBAL_SCALE "") 
                (command ".pedit" 
                         (entlast) 
                         "y" 
                         "w" 
                         $XDTB_GLOBAL_SCALE 
                         "" 
                ) 
              ) 
              (setq p1 (xdrx_getpointatdist 
                         e 
                         p2 
                         (- (* $XDTB_GLOBAL_SCALE 20.0)) 
                       ) 
                    p2 
                       (xdrx_getpointatdist 
                         e 
                         p1 
                         (- (* $XDTB_GLOBAL_SCALE 20.0)) 
                       ) 
              ) 
            ) 
            (redraw e1 1) 
            (redraw e2 1) 
            (xdrx_setenttodb e) 
            (if        (wcmatch (xdrx_getentdxf 0) "*POLYLINE") 
              (command ".pedit" 
                       (cons e (list sp)) 
                       "w" 
                       $XDTB_GLOBAL_SCALE 
                       "" 
              ) 
              (command ".pedit" 
                       (cons e (list sp)) 
                       "y" 
                       "w" 
                       $XDTB_GLOBAL_SCALE 
                       "" 
              ) 
            ) 
            (xdrx_block_make (ssadd e (c:xdrx_getss)) sp T) 
            (xdrx_setenttodb (entlast)) 
            (xdrx_modent 8 "TLX") 
          ) 
        ) 
      ) 
    ) 
  ) 
  (if tf1 
    (xdrx_drawing_viewres) 
  ) 
  (xdrx_end) 
  (xdrx_SysVar_Pop) 
  (princ) 
)

mrbean13 · 发表于 2002-9-20 14:42:15

怎么用？如何替换原程序

eachy · 发表于 2002-9-20 19:38:36

最初由 mrbean13 发布
[B]怎么用？如何替换原程序 [/B]

工具箱升级时会加进去的。

无痕 · 发表于 2002-9-20 22:26:02

ea，贴一个绘制的图上来，大家方便看效果：）

LIJUN4858 · 发表于 2002-9-23 21:02:04

我的晓东工具不好用
教我好吗

XDSoft · 发表于 2002-9-23 21:55:11

最初由 LIJUN4858 发布
[B]我的晓东工具不好用
教我好吗 [/B]

具体哪个，说出来才好帮你，如果你是ACAD2000，那么就升级到2002，2000晓东工具箱不支持。

LIJUN4858 · 发表于 2002-9-27 15:05:12

我的2002在装晓东工具箱时要不要加载函数表

XDSoft · 发表于 2002-9-27 17:02:19

最初由 LIJUN4858 发布
[B]我的2002在装晓东工具箱时要不要加载函数表 [/B]

没有听明白你的意思，如果你就使用“晓东工具箱”的话，安装后就可以正常使用了（在R14,2002）。

a100 · 发表于 2004-5-29 01:43:07

怎么用

ksblk · 发表于 2004-6-7 18:57:09

怎么用网格线？工具箱的说明在哪？

账号		自动登录	找回密码
密码			立即注册

[分享]：修改后的铁路绘制。

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

相关帖子

怎么用？如何替换原程序

Re: 怎么用？如何替换原程序