设为首页收藏本站转
发帖领奖家园QQ群申请版主版主评价切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › 晓东工具箱、编程申请 › [求助]：求根据颜色将线加粗的LISP程序
返回列表 发新帖
查看: 925|回复: 10

[求助]：求根据颜色将线加粗的LISP程序

[复制链接]
kaishuibaihn
发表于 2005-10-17 08:24:03 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

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

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

×
将颜色为红色的线或者扩展为选择图层中得颜色得线，（包括多义线）线宽都加粗为某一个值，窗选和全部选择两种形式。(可以实现吗？）

信箱已满需删除。by xyp1964[/COLOR]
颜色, 多义, 选择

相关帖子

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

xyp1964
发表于 2005-10-17 09:21:04 | 显示全部楼层
  2. [FONT=courier new](load "xyp_lib")
  3. ;|加载通用函数(可在签名栏直接下载)
  4. 如果已经下载xyp_lib并放到搜索路径下可以不再下载!
  5. 利用以下任何一种方式即可加载和运行通用函数内的所有子程序：
  6. 1.在acad.lsp中增加(load"xyp_lib")
  7. 2.在每个程序内增加(load"xyp_lib")
  8. 3.在command下，输入(load"xyp_lib")
  9. 4.在菜单.mnl中增加(load"xyp_lib")
  10. 5.将xyp_lib.vlx文件直接拽到cad屏幕
  11. [COLOR=red] ★通用函数下载地址：[/COLOR][url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]|;

  13. ;;;红线改线宽
  14. (defun c:test ()
  15.   (CMDLA0)
  16.   (setq        ss (ssget '((62 . 1)))
  17.         wt (UREAL 7 "" "\n线宽" wt)
  18.         i  -1
  19.   )
  20.                                         ;(mkla "TEST" 2)
  21.   (while (setq s1 (ssname ss (setq i (1+ i))))
  22.     (setq e (entget s1))
  23.                                         ;(sub_upd s1 8 "TEST")
  24.                                         ;(sub_upd s1 62 2)
  25.     (cond ((or (= (dxf 0 e) "POLYLINE")
  26.                (= (dxf 0 e) "LWPOLYLINE")
  27.            )
  28.            (command "pedit" s1 "w" wt "")
  29.           )
  30.           ((= (dxf 0 e) "LINE")
  31.            (command "pedit" s1 "y" "w" wt "")
  32.           )
  33.           (t (princ))
  34.     )
  35.   )
  36.   (CMDLA1)
  37. )[/FONT]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

kaishuibaihn
 楼主| 发表于 2005-10-17 10:07:12 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
这样得线不能加粗，有办法没有
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

xyp1964
发表于 2005-10-17 11:17:46 | 显示全部楼层
最初由 kaishuibaihn 发布
[B]这样得线不能加粗，有办法没有 [/B]

发个dwg图。
(defun X-putweight (ename weight)
  (cond        ((or (= (dxf 0 (entget ename)) "POLYLINE")
             (= (dxf 0 (entget ename)) "LWPOLYLINE")
         )
         (command "pedit" ename "w" weight "")
        )
        ((= (dxf 0 (entget ename)) "LINE")
         (command "pedit" ename "y" "w" weight "")
        )
        (t (princ))
  )
)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

kaishuibaihn
 楼主| 发表于 2005-10-17 11:44:38 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
图纸如下（所有颜色随层（注意是层颜色是红色）得线都要求加粗）
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

xyp1964
发表于 2005-10-19 13:37:51 | 显示全部楼层
  2. [FONT=courier new](load "xyp_lib")
  3. ;|加载通用函数(可在签名栏直接下载)
  4. 如果已经下载xyp_lib并放到搜索路径下可以不再下载!
  5. 利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：
  6. ★1·在acad.lsp中增加(load"xyp_lib")
  7. ■2·在每个程序内增加(load"xyp_lib")
  8. ■3·在command下，输入(load"xyp_lib")
  9. ■4·在菜单.mnl中增加(load"xyp_lib")
  10. ■5·将xyp_lib.vlx文件直接拽到cad屏幕
  11. ★通用函数下载地址：
  12. [url]http://www.xdcad.net/forum/attachme...&postid=1606661[/url]
  13. [url]http://www.mjtd.com/bbs/dispbbs.asp...ID=37554&page=1[/url]|;

  15. ;;;加粗红色或层颜色是红色的线
  16. (defun c:test (/ la co ln ss)
  17.   (cmdla0)
  18.   (if (null no1)
  19.     (setq no1 100)
  20.   )
  21.   (setq        no1 (UREAL 7 "" "\n线宽" no1)
  22.         la  (tblnext "layer" t)
  23.   )
  24.   (while la
  25.     (setq co (dxf 62 la)
  26.           LN (dxf 2 la)
  27.     )
  28.     (if        (= co 1)
  29.       (progn
  30.         (if (setq ss (ssget "X" (list '(0 . "LINE,ARC") (cons 8 LN))))
  31.           (command "Pedit" "m" ss "" "y" "w" no1 "")
  32.         )
  33.         (if (setq ss (ssget "X" (list '(0 . "*POLYLINE") (cons 8 LN))))
  34.           (command "Pedit" "m" ss "" "w" no1 "")
  35.         )
  36.       )
  37.     )
  38.     (setq la (tblnext "layer" nil))
  39.   )
  40.   (if (setq ss (ssget "X" '((0 . "LINE,ARC") (62 . 1))))
  41.     (command "Pedit" "m" ss "" "y" "w" no1 "")
  42.   )
  43.   (if (setq ss (ssget "X" '((0 . "*POLYLINE") (62 . 1))))
  44.     (command "Pedit" "m" ss "" "w" no1 "")
  45.   )
  46.   (cmdla1)
  47. )[/FONT]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

kaishuibaihn
 楼主| 发表于 2005-10-27 11:08:29 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
xyp1964 兄
可否将此LISP再扩展一下，先要求选择颜色，然后根据颜色加粗（包括随层的同颜色的线）还有可否最后处理时增加一个窗选图形和全部选择图形控制键。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

xyp1964
发表于 2005-10-27 14:29:26 | 显示全部楼层
  2. [FONT=courier new]
  3. ;;;加粗红色或层颜色是红色的线
  4. (defun c:test (/ la co ln ss)
  5.   (cmdla0)
  6.   (if (null no1)
  7.     (setq no1 100)
  8.   )
  9.   (if (null num)
  10.     (setq num 1)
  11.   )
  12.   (setq        num  (UINT 1 "" "\n颜色号" num)
  13.         no1  (UREAL 7 "" "\n线宽" no1)
  14.         mode (UKWORD 1 "1 2" "\n选择方式 : 1-全部/2-窗选" mode)
  15.         la   (tblnext "layer" t)
  16.   )
  17.   (if (= mode "1")
  18.     (progn
  19.       (while la
  20.         (setq co (dxf 62 la)
  21.               LN (dxf 2 la)
  22.         )
  23.         (if (= co num)
  24.           (progn
  25.             (if
  26.               (setq ss (ssget "X" (list '(0 . "LINE,ARC") (cons 8 LN))))
  27.                (command "Pedit" "m" ss "" "y" "w" no1 "")
  28.             )
  29.             (if        (setq
  30.                   ss (ssget "X" (list '(0 . "*POLYLINE") (cons 8 LN)))
  31.                 )
  32.               (command "Pedit" "m" ss "" "w" no1 "")
  33.             )
  34.           )
  35.         )
  36.         (setq la (tblnext "layer" nil))
  37.       )
  38.       (if (setq ss (ssget "X" (list '(0 . "LINE,ARC") (cons 62 num))))
  39.         (command "Pedit" "m" ss "" "y" "w" no1 "")
  40.       )
  41.       (if (setq ss (ssget "X" (list '(0 . "*POLYLINE") (cons 62 num))))
  42.         (command "Pedit" "m" ss "" "w" no1 "")
  43.       )
  44.     )
  45.     (progn
  46.       (while la
  47.         (setq co (dxf 62 la)
  48.               LN (dxf 2 la)
  49.         )
  50.         (if (= co num)
  51.           (progn
  52.             (if
  53.               (setq ss (ssget (list '(0 . "LINE,ARC") (cons 8 LN))))
  54.                (command "Pedit" "m" ss "" "y" "w" no1 "")
  55.             )
  56.             (if        (setq
  57.                   ss (ssget (list '(0 . "*POLYLINE") (cons 8 LN)))
  58.                 )
  59.               (command "Pedit" "m" ss "" "w" no1 "")
  60.             )
  61.           )
  62.         )
  63.         (setq la (tblnext "layer" nil))
  64.       )
  65.       (if (setq ss (ssget (list '(0 . "LINE,ARC") (cons 62 num))))
  66.         (command "Pedit" "m" ss "" "y" "w" no1 "")
  67.       )
  68.       (if (setq ss (ssget (list '(0 . "*POLYLINE") (cons 62 num))))
  69.         (command "Pedit" "m" ss "" "w" no1 "")
  70.       )
  71.     )
  72.   )
  73.   (cmdla1)
  74. )[/FONT]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

kaishuibaihn
 楼主| 发表于 2006-3-20 10:00:57 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
xyp1964兄，还得麻烦你帮我看一下，如果是全选所有得红线都可以加粗，可是窗选却选不到对象，这是图形文件，
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

北纬91
发表于 2006-3-20 10:12:08 | 显示全部楼层
线宽值为零不行啊！请斑竹再完善一下。
有时出现提示 “错误: AutoCAD 变量设置被拒绝: "clayer" nil”
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

xyp1964
发表于 2006-3-20 19:58:34 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
  2. [FONT=courier new];;;加粗特定颜色(或层颜色)的线
  3. (defun c:test (/ la co ln ss)
  4.   (cmdla0)
  5.   (if (null int)
  6.     (setq int 1)
  7.   )
  8.   (if (null no1)
  9.     (setq no1 100)
  10.   )
  11.   (setq        int (UINT 7 "" "\n颜色号" int)
  12.         no1 (UREAL 1 "" "\n线宽" no1)
  13.         ukw (UKWORD 7 "1 2" "\n选择方式 : 1-全部/2-窗选" ukw)
  14.         i   -1
  15.   )
  16.   (if (= ukw "1")
  17.     (setq ss (ssget "X"))
  18.     (setq ss (ssget))
  19.   )
  20.   (while (setq s1 (ssname ss (setq i (1+ i))))
  21.     (setq etype (xyp-get-dxf 0 s1))
  22.     (if        (= (xyp-get-Color s1) int)
  23.       (xyp-put-CurveWeight s1 no1)
  24.     )
  25.     (if        (or (= etype "CIRCLE")
  26.             (= etype "ELLIPSE")
  27.         )
  28.       (command "chprop" (entlast) "" "c" int "")
  29.     )
  30.   )
  31.   (cmdla1)
  32. )[/FONT]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2025-9-21 18:27 , Processed in 0.196351 second(s), 53 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2025 Discuz! Team.

快速回复 返回顶部 返回列表