明经CAD社区

 找回密码
 注册

扫一扫,访问微社区

QQ登录

只需一步,快速开始

查看: 4944|回复: 26

谁能仿写一个“给图中的BLOCK添加遮罩”

[复制链接]
发表于 2013-5-2 15:51 | 显示全部楼层 |阅读模式
10明经币
本帖最后由 朽木大师 于 2013-5-13 10:40 编辑

http://www.xdcad.net/forum/thread-667983-1-1.html
这里有这个帖,不过加载xdrx_api,还只能用于2004-2006 有没有高手也仿着写一个

最佳答案

发表于 2013-5-2 15:51 | 显示全部楼层
朽木大师 发表于 2013-5-15 13:30
来明经只是偶尔找一个小工具,说实在,对程序基本上是一无所知

  1. (defun c:tt (/ E EL NAME BLKDEF DOC OBJS LL UR MINS MAXS WIPE NEWOBJS)
  2.   (while
  3.     (and (setq e (car (entsel "\nSelect Insert:")))
  4.          (= "INSERT" (cdr (assoc 0 (setq el (entget e)))))
  5.     )
  6.      (setq name (cdr (assoc 2 el)))
  7.      (setq blkdef (vla-item
  8.                     (vla-get-blocks
  9.                       (setq
  10.                         doc (vla-get-ActiveDocument (vlax-get-acad-object))
  11.                       )
  12.                     )
  13.                     name
  14.                   )
  15.      )
  16.      (vlax-for obj blkdef
  17.        (setq objs (cons obj objs))
  18.        (if
  19.          (not
  20.            (VL-CATCH-ALL-ERROR-P
  21.              (VL-CATCH-ALL-APPLY 'vla-GetBoundingBox (list obj 'll 'ur))
  22.            )
  23.          )
  24.           (progn
  25.             (setq ll   (vlax-safearray->list ll)
  26.                   ur   (vlax-safearray->list ur)
  27.                   mins (cons ll mins)
  28.                   maxs (cons ur maxs)
  29.             )

  30.           )
  31.        )
  32.      )
  33.      (setq ll (apply 'mapcar (cons 'min mins))
  34.            ur (apply 'mapcar (cons 'max maxs))
  35.      )
  36.      (command "_rectang" "_non" ll "_non" ur)
  37.      (command "_wipeout" "p" (entlast) "y")
  38.      (command "_wipeout" "f" "off")
  39.      (setq wipe (vlax-ename->vla-object (entlast)))
  40.      (setq Newobjs (vlax-invoke
  41.                      doc
  42.                      'CopyObjects
  43.                      objs
  44.                      (vla-get-ModelSpace doc)
  45.                    )
  46.      )
  47.      (foreach a objs (vla-delete a))
  48.      (setq Newobjs (cons wipe Newobjs))
  49.      (vlax-invoke doc 'CopyObjects Newobjs blkdef)
  50.      (foreach a Newobjs (vla-delete a))
  51.      (vla-regen doc :vlax-true)
  52.   )
  53.   (princ)
  54. )
回复

使用道具 举报

 楼主| 发表于 2013-5-13 10:40 | 显示全部楼层
顶顶啊,虽然币不多
回复

使用道具 举报

发表于 2013-5-14 20:22 | 显示全部楼层
这样的程序我也想要。
回复

使用道具 举报

发表于 2013-5-15 08:30 | 显示全部楼层
人家给了编程思路了,给你个画wipeout的代码,其它包围盒、提取块内图元且列表、删除块内图元,添加图元什么的代码论坛有。[code="lisp] ;;  CAB - Jan. 3,2010 to present
(defun MkWipeout(lst / c m p)
  (setq        lst (cons (last lst) lst)
        p   (apply 'mapcar (cons 'min lst))
        m   (apply 'max (mapcar '- (apply 'mapcar (cons 'max lst)) p))
        c   (mapcar '+ p (list (/ m 2.0) (/ m 2.0)))
  )
  (entmakex
    (append (list '(000 . "WIPEOUT")
                  '(100 . "AcDbEntity")
                  '(100 . "AcDbWipeout")
                  (cons 10 (trans p 1 0))
                  (cons 11 (trans (list m 0.0) 1 0))
                  (cons 12 (trans (list 0.0 m) 1 0))
                  '(280 . 1)
                  '(071 . 2)
            )
            (mapcar
              (function
                (lambda        (x)
                  (cons        14
                        (mapcar        '(lambda (a b c) (/ (- a b) c))
                                x
                                c
                                (list m (- m))
                        )
                  )
                )
              )
              lst
            )
    )
  )
)
;;真彩色的含义
;;(+ (* BLUE 65536) (* GREEN 256) RED)
;;(+ (* 255 65536) (* 255 256) 255)=16777215
[/code]
回复

使用道具 举报

 楼主| 发表于 2013-5-15 08:39 | 显示全部楼层
x_s_s_1 发表于 2013-5-15 08:30
人家给了编程思路了,给你个画wipeout的代码,其它包围盒、提取块内图元且列表、删除块内图元,添加图元什么 ...

不会,只会相当简单的LISP,希望有朋友能整理一份

点评

以这个开始深化学习,苦练内功,遇到搞不定的地方发帖咨询,要不混论坛只知道下载有什么意思  发表于 2013-5-15 08:49
回复

使用道具 举报

 楼主| 发表于 2013-5-15 13:30 | 显示全部楼层
来明经只是偶尔找一个小工具,说实在,对程序基本上是一无所知
回复

使用道具 举报

发表于 2013-5-19 21:04 | 显示全部楼层
能改为框选块就更好
回复

使用道具 举报

 楼主| 发表于 2013-5-20 08:10 | 显示全部楼层
Gu_xl 发表于 2013-5-19 16:02

要是再增加自动转方向就好

点评

不知道影响不影响打印,就是说打印出来也看不到下面的线  发表于 2013-6-9 13:33
回复

使用道具 举报

 楼主| 发表于 2013-5-20 08:11 | 显示全部楼层
Gu_xl 发表于 2013-5-19 16:02

希望G版大哥再抽时间能补充补充
回复

使用道具 举报

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

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号  
©2000-2017 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2018-11-19 02:42 , Processed in 0.379069 second(s), 35 queries , Gzip On.

Powered by Discuz! X3.3

© 2001-2013 Comsenz Inc.

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