[LISP程序]：一个小LISP程序

haojia

一个小程序，但是非常好用，我是新来的，所以就拿些自己觉得是好的东西出来跟大家分享，顺便赚点小钱！我现在才3块钱啊，钱好难赚啊！！这个命令是一个同时把多跟LINE线或则PLINE线又或者ARC先同时变成同一宽度的命令，听说晓东工具箱里已经有这个命令了，但是我没找到……这里拿出来献丑了！对用CAD建摸的人来说是如虎添翼啊。就按命令，框选，输入数值。搞定！命令如下

2. [php]
   
3. (defun c:ww (/ plines newWidth k vis entd entn)
   
4.    (command "_.undo" "_begin")
   
5.    (setq vis (getvar "cmdecho"))(setvar "cmdecho" 0)
   
6.    (setq plines (ssget '(
   
7.         (-4 . "<OR")
   
8.         (0 . "POLYLINE")
   
9.         (0 . "LWPOLYLINE")
   
10.         (0 . "ARC")
    
11.         (0 . "LINE")
    
12.         (-4 . "OR>")
    
13.                   )
    
14.               )
    
15.    )
    
16.    (if plines (setq newWidth (getdist "Enter new width for all segments: ")))
    
17.    (if (and plines newWidth)
    
18.       (progn         (setq k 0)
    
19.          (while (< k (sslength plines))
    
20.             (setq entd (entget (setq entn (ssname plines k))))
    
21.             (if (member (cdr (assoc 0 entd)) '("ARC" "LINE"))
    
22.                   (command "pedit" entn "Y" "w" newWidth "")
    
23.                   (command "pedit" entn  "w" newWidth "")
    
24.             )
    
25.             (setq k (+ k 1))
    
26.          )
    
27.       )
    
28.    )
    
29.    (setvar "cmdecho" vis)
    
30.    (command "_.undo" "_end")
    
31.    (princ)
    
32. )[/php]
    

[php]<br /> (defun c:ww (/ plines newWidth k vis entd entn)<br />    (command "_.undo" "_begin")<br />    (setq vis (getvar "cmdecho"))(setvar "cmdecho" 0)<br />    (setq plines (ssget '(<br />         (-4 . "<OR")<br />         (0 . "POLYLINE")<br />         (0 . "LWPOLYLINE")<br />         (0 . "ARC")<br />         (0 . "LINE")<br />         (-4 . "OR>")<br />                   )<br />               )<br />    )<br />    (if plines (setq newWidth (getdist "Enter new width for all segments: ")))<br />    (if (and plines newWidth)<br />       (progn         (setq k 0)<br />          (while (< k (sslength plines))<br />             (setq entd (entget (setq entn (ssname plines k))))<br />             (if (member (cdr (assoc 0 entd)) '("ARC" "LINE"))<br />                   (command "pedit" entn "Y" "w" newWidth "")<br />                   (command "pedit" entn  "w" newWidth "")<br />             )<br />             (setq k (+ k 1))<br />          )<br />       )<br />    )<br />    (setvar "cmdecho" vis)<br />    (command "_.undo" "_end")<br />    (princ)<br /> )[/php]<br />

不做附件，也不用大家下载那么麻烦了！！！我没钱，想下载别人的东西都受限制，我可没这么坏，我同情这里跟我一样没钱就没有下载资格的小蟹们…………

njsabc

写的挺好的，继续努力！

ykklms

写得不错,谢谢.

Qlin

程序过滤表语句有点错误，下面是改过的：
[PHP]
(-4 . "<OR")
(0 . "POLYLINE")
(0 . "LWPOLYLINE")
(0 . "ARC")
(0 . "LINE")
(-4 . "OR>")
[/PHP]

另外，要是拿来建模可能有些问题：
不支持不同ucs下的实体；
不支持两端点不同高度的line

eachy

过滤表还可以写成

1. [php]
   
2. (0 . "*polyline,line,arc")[/php]

复制代码