[分享]：铁路线型

daziran

我猜想单纯用“线型”无法实现 铁路线形。那就用线型+Lisp函数吧。哪位有没有简洁的方法？

1. 线型文件中定义一个线型
;以下画虚线（用于铁路线）
*RAILWAY,railway — — — —
A,3,-2

2. 定义一个画线函数c:RAILWAY
其基本的思路是：先用虚线画线；然后绘两个OFFSET线，再将OFFSET线改为continuous 线型和0宽度。

2. 
   
3. (print "画铁路线命令：RAILWAY")
   
4. (DEFUN C:RAILWAY (/ s pt)
   
5.   (setq oldltype (getvar "CELTYPE"))
   
6.   (setq oldosnap (getvar "OSMODE"))
   
7.   (setq oldpinegen (getvar "PLINEGEN"))
   
8.   (setq oldpinewid (getvar "PLINEWID"))
   
9.   (setq oldceltscale (getvar "CELTSCALE"))
   
10.   (setq oldltscale (getvar "LTSCALE"))
    
11. 
    
12.   (if (null $linewid)
    
13.     (setq $linewid (* oldltscale oldceltscale))
    
14.   )
    
15. 
    
16.   (initget 6)
    
17.   (setq wid (getdist (strcat "线宽<" (rtos $linewid) ">")))
    
18.   (if wid
    
19.     (setq $linewid wid)
    
20.   )
    
21. 
    
22.   (setvar "CELTYPE" "railway")
    
23.   (setvar "PLINEGEN" 1)
    
24.   (setvar "PLINEWID" $linewid)
    
25.   (setvar "CELTSCALE" (/ $linewid (getvar "LTSCALE")))
    
26.   (command
    
27.     "_pline"
    
28.     (while (= 1 (getvar "CMDACTIVE")) (command PAUSE))
    
29.   )
    
30. 
    
31.   (setq ent (entlast))                ;找到刚才画的这个线
    
32.   (setq pt (getvar "lastpoint"))        ;最后点
    
33.   (setq ang (* (/ pi 180) (getvar "lastangle")));最后线段的角度(弧度)
    
34.   (setvar "OSMODE" 0)
    
35.   (command "_offset"
    
36.            (/ $linewid 2.0)
    
37.            ent
    
38.            (polar pt (+ ang 1.7 0.2) $linewid)
    
39.            ""
    
40.   )
    
41.   (command "chprop" "last" "" "lt" "continuous" "")
    
42.   (command "pedit" "last" "w" 0 "")
    
43.   (command "_offset"
    
44.            (/ $linewid 2.0)
    
45.            ent
    
46.            (polar pt (+ ang 1.7 pi) $linewid)
    
47.            ""
    
48.   )
    
49. 
    
50.   (command "chprop" "last" "" "lt" "continuous" "")
    
51.   (command "pedit" "last" "w" 0 "")
    
52.   (setvar "OSMODE" oldosnap)
    
53.   (setvar "CELTYPE" oldltype)
    
54.   (setvar "PLINEGEN" oldpinegen)
    
55.   (setvar "PLINEWID" oldpinewid)
    
56.   (setvar "CELTSCALE" oldceltscale)
    
57.   (command "regen")
    
58.   (princ)
    
59. )
    

<br /> (print "画铁路线命令：RAILWAY")<br /> (DEFUN C:RAILWAY (/ s pt)<br />   (setq oldltype (getvar "CELTYPE"))<br />   (setq oldosnap (getvar "OSMODE"))<br />   (setq oldpinegen (getvar "PLINEGEN"))<br />   (setq oldpinewid (getvar "PLINEWID"))<br />   (setq oldceltscale (getvar "CELTSCALE"))<br />   (setq oldltscale (getvar "LTSCALE"))<br /> <br />   (if (null $linewid)<br />     (setq $linewid (* oldltscale oldceltscale))<br />   )<br /> <br />   (initget 6)<br />   (setq wid (getdist (strcat "线宽<" (rtos $linewid) ">")))<br />   (if wid<br />     (setq $linewid wid)<br />   )<br /> <br />   (setvar "CELTYPE" "railway")<br />   (setvar "PLINEGEN" 1)<br />   (setvar "PLINEWID" $linewid)<br />   (setvar "CELTSCALE" (/ $linewid (getvar "LTSCALE")))<br />   (command<br />     "_pline"<br />     (while (= 1 (getvar "CMDACTIVE")) (command PAUSE))<br />   )<br /> <br />   (setq ent (entlast))                ;找到刚才画的这个线<br />   (setq pt (getvar "lastpoint"))        ;最后点<br />   (setq ang (* (/ pi 180) (getvar "lastangle")));最后线段的角度(弧度)<br />   (setvar "OSMODE" 0)<br />   (command "_offset"<br />            (/ $linewid 2.0)<br />            ent<br />            (polar pt (+ ang 1.7 0.2) $linewid)<br />            ""<br />   )<br />   (command "chprop" "last" "" "lt" "continuous" "")<br />   (command "pedit" "last" "w" 0 "")<br />   (command "_offset"<br />            (/ $linewid 2.0)<br />            ent<br />            (polar pt (+ ang 1.7 pi) $linewid)<br />            ""<br />   )<br /> <br />   (command "chprop" "last" "" "lt" "continuous" "")<br />   (command "pedit" "last" "w" 0 "")<br />   (setvar "OSMODE" oldosnap)<br />   (setvar "CELTYPE" oldltype)<br />   (setvar "PLINEGEN" oldpinegen)<br />   (setvar "PLINEWID" oldpinewid)<br />   (setvar "CELTSCALE" oldceltscale)<br />   (command "regen")<br />   (princ)<br /> )<br />

你看出来了，这哪是线型呀，完全是程序，有点笨。不过还是放在这里吧。也许有人感兴趣哪。

daziran

代码

msdg

不错，如果黑、白部分等长，还可以用来做水利水电的标尺，或纵断面的纵座标线。

daziran

谢谢msdg夸赞。不过斑竹如果也是老菜鸟，我们就没法活了 ；）

qqqf

我好象不能用，请教。出现如下提示：
错误: AutoCAD rejected function
((ST) (IF (AND (/= ST "Function cancelled") (/= ST "quit / exit abort")) (PRINC
(STRCAT "\n错误: " ST "\n"))) (XDRX_SYSVAR_POP) (XDRX_DRAWING_VIEWRES)
(XDRX_PBAREND) (XDRX_END) (SETQ *ERROR* $XDLSP_ERROR))*Cancel*
望指导一二。

萧山

可是现在线形的问题就是假如我在一张图上用几种线形，比例不一样，出不了效果呀，怎么办？

gp518

嘿嘿，这个不错啊，可以画防水层嘛

柔柔

虽然不错，但你是用新画的方法，在任意既有线上修改成轨道线不更方便？，你想，一条线已经有了，现在要把他画成轨道线，把这条线删掉重画麻烦不？
我这个程序也要设置轨道线线型，线型名取rail。另外我很不喜欢用宽线的Pline而是用颜色表示线宽，道理很简单，带宽度的Pline线当比例变更时很麻烦。至于用什么颜色表示宽线由用户决定，只要改变图层 RAIL_CEN 的定义就行。本程序很长时间没用了，不知有没有错，试试吧。
; RAIL.LSP  改直线,圆弧,多义线为轨道线
; 最近一次修改: 2003.7.29 （这是贴出后又修改过的版本）
;--------------------------------------------------------------------
(defun rail_err(s)
      (if (/= s "Function cancelled")     
        (princ (strcat "\nError: " s))   
      )
      (setvar "osmode" os)
      (setvar "clayer" clay)
      (command "_.UNDO" "_E")                             
)
;================================================

(defun c:rail(/ clay os temp xx sset nsset sslen lw dis ename
                elist  pename pelist pt_cen pt_side_a pt_side_b )
  (setq *error* rail_err)
  (setq clay (getvar "clayer")
          os (getvar "osmode")
  )  
  (if (= rail_rw nil) (setq rail_rw 0.6))
  (if (= dwg_scl nil) (setq dwg_scl (getvar "dimscale")))
  (setq temp T)
  (setvar "osmode" 0)
(while temp
    (prompt (strcat "\n轨道线宽 Width = "(rtos rail_rw)
                    " , 比例因子 Scale = "(rtos dwg_scl)))
    (initget "Width Scale")
    (setq xx (getpoint "\nWidth/ Scale <Select objects> "))
        (cond
           ((= xx "Width")
             (setq xx (getreal (strcat "\nWidth = <"(rtos rail_rw)">:")))
             (if xx (setq rail_rw xx))
           )
           ((= xx "Scale")
             (setq xx (getreal (strcat "\nScale = <"(rtos dwg_scl)">:")))
             (if xx (setq dwg_scl xx))
           )
           (T
             ;(setq temp nil)
             (setq sset (ssget)  temp nil)
           )
           
        )
)

  (setq lw (* dwg_scl rail_rw)  
       dis (/ lw 2.0))
  (if (null (tblsearch "layer" "RAIL_SIDE"))
    (command "_.layer" "_m" "RAIL_SIDE" "_c" "cyan" ""
             "_lt" "continuous" "" "")
  )
  (if (null (tblsearch "layer" "RAIL_CEN"))
    (command "_.layer" "_m" "RAIL_CEN" "_c" "red" ""
             "_lt" "rail" "" "")
  )

  (setq sslen (sslength sset)
        nsset (ssadd))
  (while (> sslen 0)
    (setq temp (ssname sset (setq sslen (1- sslen))))
    (if (or
         (= (cdr (assoc 0 (entget temp))) "LINE")
         (= (cdr (assoc 0 (entget temp))) "POLYLINE")
         (= (cdr (assoc 0 (entget temp))) "LWPOLYLINE")
         (= (cdr (assoc 0 (entget temp))) "SPLINE")
         (= (cdr (assoc 0 (entget temp))) "ARC")
         (= (cdr (assoc 0 (entget temp))) "CIRCLE")
         (= (cdr (assoc 0 (entget temp))) "ELLIPSE")
        )
      (ssadd temp nsset)
    )
  )
  (setq sslen (sslength nsset)
        sset nsset)

  (while (> sslen 0)
    (setq ename (ssname sset (setq sslen (1- sslen)))
          elist (entget ename)
    )
    (del_points)
    (command "_divide" ename 3)
    (setq pename (entlast)
          pelist (entget pename)
          pt_cen (cdr (assoc 10 pelist))
    )
    (del_points)
    (if (= (cdr (assoc 0 (entget ename))) "LWPOLYLINE")
        (command "pedit" ename "w" 0.0 "" )
    )
    (command "change" ename "" "p" "la" "RAIL_SIDE" "lt" "bylayer"
             "c" "bylayer" "")
    (setq pt_side_a (polar pt_cen 1.2 1.0))
    (setq pt_side_b (polar pt_cen (+ 1.2 pi) 1.0))
    (command "offset" dis pt_cen pt_side_a "")
    (command "erase" "l" "")
    (command "offset" dis pt_cen pt_side_b "")
    (command "oops" "")
    (command "change" ename "" "p" "la" "RAIL_CEN" "")
  )
  (setvar "osmode" os)
  (setvar "clayer" clay)
  (princ)
)
;======================= END =======================

; 删除所有点

(defun del_points(/ psset psslen pelist pename)
   (setq psset (ssget "X" (List (cons 0 "POINT" ))))
   (if (/= psset nil)
     (progn
       (setq psslen (sslength psset))
       (while (> psslen 0)
         (command "_erase" (ssname psset (setq psslen (1- psslen))) "")
       )
     )
   )
)
;---------------------------------------------------------------------

liuzqyh

柔柔：我下了你的程序，也做成了RAIL.LSP ，加载运行，输入命令RAIL，出现以下文字：
Command: rail
轨道线宽 Width = 0.6 , 比例因子 Scale = 1
Error: no function definition: AI_ASELECT_.UNDO Enter the number of operations
to undo or [Auto/Control/BEgin/End/Mark/Back] <1>: _E
Command:
命令没执行完，铁路线形也没有形成，为什么？我哪里错了？？？

柔柔

我用的选择对象的那个语句可能你现在的ACAD版本已没有，改用最基本的 ssget 吧。
把    (setq sset (ai_aselect))
改成   (setq sset (ssget))
不过，我在2004上用原来的 (ai_aselect) 也没问题呀。另外，本程序也要有相应的线型。
*RAIL, Rail Linetype, __  __  __  __  __  __  __  __  __  __  _  
A,7,-7
*RAIL1, Rail Linetype1,__  __  __  __  __  __  __  __  __  __  _
A,5,-5
如果你暂时不想设这二个线型也可以，增加二个图层：RAIL_SIDE和RAIL_CEN，RAIL_SIDE 的线型为实线，RAIL_CEN 的线型为一般虚线。程序内是这么设的，如果没有这二个图层则程序创建，有了程序就不管了。

daziran

柔柔不柔，挺厉害呀
To qqqf ：你出现问题的代码不是我的程序中的。
To 萧山：我的本意是想保证图线的填充部分（黑段）与线宽比例为固定（这里是3：1），这样符合视觉习惯。因此线型比例根据线宽自动确定。如果你有特殊需要，可以在画完后修改这条线的线型比例，当然也可以修改程序代码加上比例输入。

柔柔

对不起，我那程序有缺陷：轨道线宽和比例因子无法由用户设置。我已修改上面贴出的程序，怎么不能全显啊？作为附件吧。

liuzqyh

柔柔：我下了你的程序，运行后有以下几个问题向你请教：
1.为什么运行后不能绘出daziran 那样的图，你只有三条线而已；2.如果不用图层行不行？
daziran ：运行后出现如下错误：
Command:RAILWAY
线宽<1>
Error: AutoCAD 变量设置被拒绝: "CELTYPE" "railway"; 错误: *error*
函数中发生错误AutoCAD 变量设置被拒绝: "osmode" nil

柔柔

是三条线，轨道线不就是二细一粗三根线组成的吗？我在上面帖子里强调：“我很不喜欢用宽线的Pline而是用颜色表示线宽”，你把中间那条线定义为粗线打印不就行啦。2000以后的版本，把粗线线宽在图层内设置好，让它显示，效果就有了。

daziran

最初由 liuzqyh 发布
daziran ：运行后出现如下错误：
Command:RAILWAY
线宽<1>
Error... [/B]

您是否事先定义并装入了RAILWAY ？