社区 › 编程申请 › 谁能仿写一个“给图中的BLOCK添加遮罩”

朽木大师 发表于 2013-5-2 15:51:00

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

本帖最后由 朽木大师 于 2013-5-13 10:40 编辑


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

Gu_xl 发表于 2013-5-2 15:51:01

朽木大师 发表于 2013-5-15 13:30 static/image/common/back.gif
来明经只是偶尔找一个小工具，说实在，对程序基本上是一无所知

(defun c:tt (/ E EL NAME BLKDEF DOC OBJS LL UR MINS MAXS WIPE NEWOBJS)
(while
    (and (setq e (car (entsel "\nSelect Insert:")))
       (= "INSERT" (cdr (assoc 0 (setq el (entget e)))))
    )
   (setq name (cdr (assoc 2 el)))
   (setq blkdef (vla-item
                  (vla-get-blocks
                      (setq
                        doc (vla-get-ActiveDocument (vlax-get-acad-object))
                      )
                  )
                  name
                  )
   )
   (vlax-for obj blkdef
       (setq objs (cons obj objs))
       (if
       (not
           (VL-CATCH-ALL-ERROR-P
             (VL-CATCH-ALL-APPLY 'vla-GetBoundingBox (list obj 'll 'ur))
           )
       )
          (progn
          (setq ll   (vlax-safearray->list ll)
                  ur   (vlax-safearray->list ur)
                  mins (cons ll mins)
                  maxs (cons ur maxs)
          )

          )
       )
   )
   (setq ll (apply 'mapcar (cons 'min mins))
           ur (apply 'mapcar (cons 'max maxs))
   )
   (command "_rectang" "_non" ll "_non" ur)
   (command "_wipeout" "p" (entlast) "y")
   (command "_wipeout" "f" "off")
   (setq wipe (vlax-ename->vla-object (entlast)))
   (setq Newobjs (vlax-invoke
                     doc
                     'CopyObjects
                     objs
                     (vla-get-ModelSpace doc)
                   )
   )
   (foreach a objs (vla-delete a))
   (setq Newobjs (cons wipe Newobjs))
   (vlax-invoke doc 'CopyObjects Newobjs blkdef)
   (foreach a Newobjs (vla-delete a))
   (vla-regen doc :vlax-true)
)
(princ)
)

朽木大师 发表于 2013-5-13 10:40:26

顶顶啊，虽然币不多

timmy521 发表于 2013-5-14 20:22:38

这样的程序我也想要。

x_s_s_1 发表于 2013-5-15 08:30:15

人家给了编程思路了，给你个画wipeout的代码，其它包围盒、提取块内图元且列表、删除块内图元，添加图元什么的代码论坛有。;;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

朽木大师 发表于 2013-5-15 08:39:39

x_s_s_1 发表于 2013-5-15 08:30 static/image/common/back.gif
人家给了编程思路了，给你个画wipeout的代码，其它包围盒、提取块内图元且列表、删除块内图元，添加图元什么 ...

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

朽木大师 发表于 2013-5-15 13:30:46

来明经只是偶尔找一个小工具，说实在，对程序基本上是一无所知

bai2000 发表于 2013-5-19 21:04:54

能改为框选块就更好

朽木大师 发表于 2013-5-20 08:10:09

Gu_xl 发表于 2013-5-19 16:02 static/image/common/back.gif

要是再增加自动转方向就好
http://bbs.mjtd.com/forum.php?mod=attachment&aid=NzU2MzZ8OTIzNDc4OWJ8MTM2OTAwODYxNHw0MTczNjN8MTAxNDY1&noupdate=yes

朽木大师 发表于 2013-5-20 08:11:54

Gu_xl 发表于 2013-5-19 16:02 static/image/common/back.gif


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

查看完整版本: 谁能仿写一个“给图中的BLOCK添加遮罩”