设为首页收藏本站

晓东CAD家园-论坛

 找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 4261|回复: 23

[他山之石] SS:MAP & ModEnt

[复制链接]

签到天数: 369 天

连续签到: 2 天

[LV.9]以坛为家II

发表于 2013-5-15 09:17:45 | 显示全部楼层 |阅读模式

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

您需要 登录 才可以下载或查看,没有帐号?立即注册

x
  1. ;; Form www.xdcad.net  2005.9.21
  2. ;;对选择集执行某一函数操作
  3. ;; func 函数定义,参数为实体
  4. ;; ss   选择集
  5. (defun SS:MAP (func ss / n)
  6.   (if (eq 'PICKSET (type ss))
  7.     (repeat (setq n (fix (sslength ss))) ;_ fixed
  8.       (apply func (list (ssname ss (setq n (1- n)))))
  9.     )
  10.   )
  11. )
  12. ;;功    能:修改实体用(entmod)
  13. ;;调用格式:(xdrx_ModEnt <组码1> <修改后的值> [组码2] [修改后的值] ... [组码n] [修改后的值])
  14. ;;说    明:组码和修改的值必须配对出现,可以提供多个配对。
  15. (defun modent (el lst)
  16.   (while lst
  17.     (if (assoc (car lst) el)
  18.       (setq el (subst (cons (car lst) (cadr lst))
  19.         (assoc (car lst) el)
  20.         el
  21.         )
  22.       )
  23.       (setq el (append el (list (cons (car lst) (cadr lst)))));_没有的组码要附加到最后
  24.     )
  25.     (setq lst (cddr lst))
  26.   )
  27.   (entmod el)
  28. )
  29. ;;示    例:将选取的文字字高修改为400,图层修改为mytxt , 字符改为 dde ,颜色改为 1
  30. (defun c:tt ()
  31.   (if (setq ss (ssget '((0 . "text"))))
  32.     (ss:map '(lambda (x)
  33.         (modent (entget x) '(40 100 8 "mytxt" 1 "dde" 62 1))
  34.       )
  35.      ss
  36.     )
  37.   )
  38.   (princ)
  39. )

评分

参与人数 3D豆 +14 收起 理由
ll_j + 5 揭了xdapi的老底了^_^
xshrimp + 5 很给力!经验;技术要点;资料分享奖!
XDSoft + 4 很给力!经验;技术要点;资料分享奖!

查看全部评分

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

签到天数: 257 天

连续签到: 1 天

[LV.8]以坛为家I

点击这里给我发消息

已领礼包: 2个

财富等级: 恭喜发财

发表于 2013-5-26 15:32:40 | 显示全部楼层
  1. ;;;改LEEMAC的http://www.theswamp.org/index.php?topic=32743.0
  2. (defun _offset (ss pt dis / l obj)
  3.   ((lambda ()
  4.      (cond
  5.        ((not (and
  6.                (eq 'PICKSET (type ss))
  7.                (numberp dis)
  8.                (vl-consp pt)
  9.              )
  10.         )
  11.        )
  12.        ((SSMAP2 (LAMBDA (Ent)
  13.                     (if (vlax-method-applicable-p (setq obj
  14.                                                         (vlax-ename->vla-object ent)
  15.                                                   )
  16.                                                   'Offset
  17.                         )
  18.                       (mapcar
  19.                         (function vla-delete)
  20.                         (car (setq l (append
  21.                                        (vl-sort (mapcar
  22.                                                   (function (lambda
  23.                                                               (x)
  24.                                                               (vlax-invoke obj 'Offset x)
  25.                                                             )
  26.                                                   )
  27.                                                   (list dis (- dis))
  28.                                                 ) (function (lambda
  29.                                                               (a b)
  30.                                                               (>
  31.                                                                  (distance pt
  32.                                                                            (vlax-curve-getClosestPointto
  33.                                                                                                          (car a) pt
  34.                                                                            )
  35.                                                                  )
  36.                                                                  (distance pt
  37.                                                                            (vlax-curve-getClosestPointto
  38.                                                                                                          (car b) pt
  39.                                                                            )
  40.                                                                  )
  41.                                                               )
  42.                                                             )
  43.                                                   )
  44.                                        )
  45.                                        (cdr l)
  46.                                      )
  47.                              )
  48.                         )
  49.                       )
  50.                     )
  51.                   ) SS
  52.         )
  53.        )
  54.      )
  55.    )
  56.   )
  57.   (apply
  58.     (function append)
  59.     (cdr l)
  60.   )
  61. )

点评

这样用绝大多数人会看晕的!  发表于 2013-5-26 16:54

评分

参与人数 2D豆 +15 收起 理由
xshrimp + 5 技术引导讨论和指点奖!
XDSoft + 10 很给力!经验;技术要点;资料分享奖!

查看全部评分

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

使用道具 举报

签到天数: 1388 天

连续签到: 13 天

[LV.10]以坛为家III

已领礼包: 604个

财富等级: 财运亨通

发表于 2013-5-15 09:47:31 | 显示全部楼层
对于好贴,我们通常要吹毛求疵,(setq n (fix (sslength ss)))这里是不是可以不用fix?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 1373 天

连续签到: 2 天

[LV.10]以坛为家III

点击这里给我发消息

已领礼包: 144个

财富等级: 日进斗金

发表于 2013-5-15 10:02:40 | 显示全部楼层
函数很智能啊。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 190 天

连续签到: 1 天

[LV.7]常住居民III

点击这里给我发消息

已领礼包: 205个

财富等级: 日进斗金

发表于 2013-5-15 10:33:05 | 显示全部楼层
楼主试试能做到格式刷的效果吧?点一个,修改的效果马上能看见?

点评

那不就是加个WHILE处理下吗? 一有选择集就处理,处理完就又处于选择状态。另SSGET加 ":S"  发表于 2013-5-15 11:06
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 1991 天

连续签到: 89 天

[LV.Master]伴坛终老I

已领礼包: 5912个

财富等级: 富甲天下

发表于 2013-5-15 10:54:45 | 显示全部楼层
好贴,好程式。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 196 天

连续签到: 31 天

[LV.7]常住居民III

发表于 2013-5-15 11:12:27 | 显示全部楼层
xshrimp 发表于 2013-5-15 10:33
楼主试试能做到格式刷的效果吧?点一个,修改的效果马上能看见?

改造为格式刷一样,点一个修改一个,框一次修改一次,立竿见影
(defun c:t11 ()
  (while (setq ss (ssget ":S" '((0 . "text"))))
    (ss:map '(lambda (x)
        (modent (entget x) '(40 400 1 "dde" 62 1))
      )
     ss
    )
  )
  (princ)
)


11.gif

评分

参与人数 2D豆 +11 收起 理由
xshrimp + 5 技术引导讨论和指点奖!
XDSoft + 6 热心帮忙奖!

查看全部评分

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

使用道具 举报

签到天数: 190 天

连续签到: 1 天

[LV.7]常住居民III

点击这里给我发消息

已领礼包: 205个

财富等级: 日进斗金

发表于 2013-5-15 14:09:09 | 显示全部楼层
再来点要求,根据格式刷的使用习惯,没有选中是不退出程序,点击鼠标右键或ESC才退出.
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 196 天

连续签到: 31 天

[LV.7]常住居民III

发表于 2013-5-15 14:38:10 | 显示全部楼层
本帖最后由 wowan1314 于 2013-5-15 14:40 编辑
xshrimp 发表于 2013-5-15 14:09
再来点要求,根据格式刷的使用习惯,没有选中是不退出程序,点击鼠标右键或ESC才退出.

我再改!像格式刷一样,不停运行,即改即显,选不中也不退出,右键或ESC退出
(defun c:t11 ()
  (while (not (member (car (grread T 12 2)) '(11 12 25)))
   (setq ss (ssget ":S" '((0 . "text"))))
    (ss:map '(lambda (x)
        (modent (entget x) '(40 400 1 "dde" 62 1))
      )
     ss
    )
  )
  (princ)
)

点评

葛老,我这右键也没有退出  发表于 2013-5-31 08:30
经测试右键没有退出.  发表于 2013-5-15 15:01

评分

参与人数 2D豆 +9 收起 理由
Lispboy + 5 很给力!经验;技术要点;资料分享奖!
xshrimp + 4 热心帮忙奖!

查看全部评分

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

使用道具 举报

签到天数: 407 天

连续签到: 1 天

[LV.9]以坛为家II

已领礼包: 51个

财富等级: 招财进宝

发表于 2013-5-15 15:02:09 | 显示全部楼层
wowan1314 发表于 2013-5-15 14:38
我再改!像格式刷一样,不停运行,即改即显,选不中也不退出,右键或ESC退出
(defun c:t11 ()
  (while ...

:lol 打死也不退,刷死你。

点评

我这里可以退出呀! 搞不清楚。11.12.25三个都不正确?!。  发表于 2013-5-15 15:05
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 407 天

连续签到: 1 天

[LV.9]以坛为家II

已领礼包: 51个

财富等级: 招财进宝

发表于 2013-5-15 15:07:36 | 显示全部楼层
wowan1314 发表于 2013-5-15 14:38
我再改!像格式刷一样,不停运行,即改即显,选不中也不退出,右键或ESC退出
(defun c:t11 ()
  (while ...
即改即显,选不中也不退出


我是对你这句话开句玩笑尼,程序很好。:D
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 257 天

连续签到: 1 天

[LV.8]以坛为家I

点击这里给我发消息

已领礼包: 2个

财富等级: 恭喜发财

发表于 2013-5-25 16:23:16 | 显示全部楼层
  1. ;;;收集了好久的
  2. (DEFUN SSMAP1 (FUNC SS / N)
  3.   (if (eq 'PICKSET (type ss))
  4.     (REPEAT (SETQ N (SSLENGTH SS))
  5.       (VL-CATCH-ALL-APPLY FUNC (LIST (SSNAME SS (SETQ N (1- N)))))
  6.     )
  7.   )
  8. )
  9. (DEFUN SSMAP2 (FUNC SS / N)
  10.   (AND
  11.     (eq 'PICKSET (type ss))
  12.     (REPEAT (SETQ N (SSLENGTH SS))
  13.       (VL-CATCH-ALL-APPLY (QUOTE FUNC) (LIST (SSNAME SS (SETQ N (1- N)))))
  14.     )
  15.   )
  16. )
  17. (DEFUN SSMAP3 (FUNC SSET / N ENAME)
  18.   (AND
  19.     (eq 'PICKSET (type sset))
  20.     (SETQ N -1)
  21.     (WHILE (SETQ ENAME (SSNAME SSET (SETQ N (1+ N))))
  22.       (VL-CATCH-ALL-APPLY (FUNCTION (LAMBDA ()
  23.               (FUNC ENAME)
  24.             )
  25.         )
  26.       )
  27.     )
  28.   )
  29. )
  30. (DEFUN SSMAP4 (FUNC SSET / N ENAME)
  31.   (AND
  32.     (SETQ FUNC (EVAL FUNC))
  33.     (eq 'PICKSET (type sset))
  34.     (SETQ N -1)
  35.     (WHILE (SETQ ENAME (SSNAME SSET (SETQ N (1+ N))))
  36.       (VL-CATCH-ALL-APPLY (FUNCTION (LAMBDA ()
  37.               (FUNC ENAME)
  38.             )
  39.         )
  40.       )
  41.     )
  42.   )
  43. )

评分

参与人数 1D豆 +6 收起 理由
XDSoft + 6 很给力!经验;技术要点;资料分享奖!

查看全部评分

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

使用道具 举报

签到天数: 127 天

连续签到: 1 天

[LV.7]常住居民III

发表于 2013-5-25 16:33:05 | 显示全部楼层
好贴。woman1314改的也非常好。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 257 天

连续签到: 1 天

[LV.8]以坛为家I

点击这里给我发消息

已领礼包: 2个

财富等级: 恭喜发财

发表于 2013-5-25 16:39:26 | 显示全部楼层
  1. ;;;不知道如何修改不了自己的贴子了
  2. ;;;运行以下代码
  3. ((LAMBDA ()
  4.    (SETQ SS (SSGET))
  5.    (BENCHMARK '((SSMAP1 '(LAMBDA (E)
  6.                            (VLA-PUT-COLOR (VLAX-ENAME->VLA-OBJECT E) 5)
  7.                          ) SS
  8.                 )
  9.                (SSMAP2 (LAMBDA (E)
  10.                          (VLA-PUT-COLOR (VLAX-ENAME->VLA-OBJECT E) 5)
  11.                        ) SS
  12.                )
  13.                (SSMAP3 (LAMBDA (E)
  14.                          (VLA-PUT-COLOR (VLAX-ENAME->VLA-OBJECT E) 5)
  15.                        ) SS
  16.                )
  17.                (SSMAP4 '(LAMBDA (E)
  18.                           (VLA-PUT-COLOR (VLAX-ENAME->VLA-OBJECT E) 5)
  19.                         ) SS
  20.                )
  21.               )
  22.    )
  23. )
  24. )
  25. ;;;测试结果
  26. Elapsed milliseconds / relative speed for 4096 iteration(s):

  27.     (SSMAP2 (LAMBDA (E) (vla-put-Color (...).....1435 / 2.00 <fastest>
  28.     (SSMAP3 (LAMBDA (E) (vla-put-Color (...).....1482 / 1.94
  29.     (SSMAP4 (QUOTE (LAMBDA (E) (vla-put-...).....1497 / 1.92
  30.     (SSMAP1 (QUOTE (LAMBDA (E) (vla-put-...).....2871 / 1.00 <slowest>
复制代码
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 1373 天

连续签到: 2 天

[LV.10]以坛为家III

点击这里给我发消息

已领礼包: 144个

财富等级: 日进斗金

发表于 2013-5-25 16:43:22 | 显示全部楼层

编辑帖子

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

使用道具 举报

签到天数: 257 天

连续签到: 1 天

[LV.8]以坛为家I

点击这里给我发消息

已领礼包: 2个

财富等级: 恭喜发财

发表于 2013-5-26 13:34:03 | 显示全部楼层
  1. ;;;应该是出自EA
  2. (DEFUN ENTMODE-ELIST (EL TYLST / C)
  3.   (FOREACH N TYLST
  4.     (IF        (SETQ C (ASSOC (CAR N) EL))
  5.       (SETQ EL (SUBST
  6.                  N
  7.                  C
  8.                  EL
  9.                )
  10.       )
  11.       (SETQ EL (APPEND
  12.                  EL
  13.                  (LIST N)
  14.                )
  15.       )
  16.     )
  17.   )
  18.   (ENTMOD EL)
  19. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

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

GMT+8, 2018-10-23 07:56 , Processed in 0.113215 second(s), 75 queries , Gzip On, WinCache On.

Powered by Discuz! X3.4

© 2001-2017 Comsenz Inc.

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