[LISP程序]：AUTOCADR14线型宽度批量修改工具

思达克 · 发表于 2004-8-5 18:31:08

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

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

×

很适用，我一直在用

lsjjm · 发表于 2004-8-6 04:01:45

文件只有0.76KB大, 直接贴出多好, 省得下载!

coolzhb · 发表于 2004-8-6 08:00:36

最初由 lsjjm 发布
[B]文件只有0.76KB大, 直接贴出多好, 省得下载! [/B]

我贴出了，大家看看如何！
[PHP]
(defun chgterr (s)
  (if (/= s "Function cancelled") ; if an error (such as ctrl-c) occurs
(princ (strcat "\nError: " s)) ; while this command is active...
  )
  (setq p nil)                   ; free selection set
  (setq *error* olderr)          ; restore old *error* handler
  (princ)
)
(defun c:edl (/ loop lw l s e n sl en ss)
  (setq olderr *error*          ; initialize variables
      *error* chgterr
      chm 0
  )
  (setvar "cmdecho" 0)
  (setq lw (getreal "\n给出线宽值："))
  (if (not lw)
(setq lw (getvar "tracewid"))
(setvar "tracewid" lw)
  )
  (princ (list '"当前线宽是： " lw))
  (setq e 1)
  (setq s (ssget))
  (if s
(progn
   (setq sl (sslength s))
   (setq n sl)
   (princ sl)
   (repeat sl
      (setq n (- n 1))
      (setq ss (ssname s n)) ;(princ (list 'ss '= ss))
      (if ss
      (progn
         (setq en (cdr (assoc '0 (entget ss))))    ;(princ (list 'en '= en))
         (if (or
               (= en "POLYLINE")
               (= en "LWPOLYLINE")
               (= en "DOUNT")
            )
            (command "pedit" ss "w" lw "")
         )
         (if (= en "CIRCLE")
            (progn
            (setq cp (cdr (assoc '10 (entget ss))))
            (setq cr (* 2 (cdr (assoc '40 (entget ss)))))       ;(princ (list 'cr '= cr))
            (command "erase" ss "")
            (command "donut" cr cr cp "")
            (command "pedit" (entlast) "w" lw "")
            )
         )
         (if (or
               (= en "LINE")
               (= en "ARC")
            )
            (command "pedit" ss "y" "w" lw "")
         )
      );end of progn
      )
   )
)
  )
  (if (not sl)
(princ "未选到任何项!")
  )
)
[/PHP]

lhj743 · 发表于 2004-8-6 12:16:33

多谢楼主！
R14和R2004都可用，
方便极了！
建议斑竹加分！

DW525 · 发表于 2004-8-6 15:15:25

比较好用.
谢谢楼主.

lsjjm · 发表于 2004-8-6 16:40:20

最初由 coolzhb 发布
[B]我贴出了，大家看看如何！ [/B]

不行呀, 你把原来的线都变成多义线拉? 我的圆那? 我的椭圆那?

netbee · 发表于 2004-8-6 20:36:28

最初由 lsjjm 发布
[B]
不行呀, 你把原来的线都变成多义线拉? 我的圆那? 我的椭圆那? [/B]

只有多义线，才能固定有自已的线宽。
若不想转成多义线，则可以直接定义其线宽属性，但这样，在R2000以后的打印样式中，打印线宽定义只能是用默认的对象自定义线宽。

一只鱼 · 发表于 2004-8-31 11:05:58

很好，谢谢！

hmh888888 · 发表于 2004-8-31 15:28:43

很好用啊

lsjjm · 发表于 2004-9-1 05:29:30

最初由 netbee 发布
[B]只有多义线，才能固定有自已的线宽.. [/B]

要知道, 许多情况下是不准许改变实体类型的!

shisj · 发表于 2004-9-2 11:05:48

不改变实体类型的线段，用层不是很方便。
很好的软件，支持

ruansh · 发表于 2004-9-3 08:55:30

我在2004和2005上都加载使用了,非常方便!

zyzzmh · 发表于 2008-8-14 09:53:27

为什么要钱啊？我们穷人阿！

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

[LISP程序]：AUTOCADR14线型宽度批量修改工具

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

相关帖子