实体内的复制块（
实体内的复制块（bcopy）(defun c:bcopy ()(c:blkssc)) ;;
(defun c:blkssc (/ *ERROR* *MYERR BLKN E EEE NPT OLDERR PAUSE SS SS2 SSB SSN SSR SSS SSS2 X ssx)
(princ "\n bcopy=Copy block within the entityby lxx.2008.2")
(defun *myerr (msg)(if sss2 (progn(command ".undo" "e")(command ".u")))(setq *error* olderr)(princ))
(setq olderr *error*
*error* *myerr)
(princ "\n Choose the block：")
(if (setq ss (ssget '((0 . "INSERT"))))
(progn
(setq e(ssname ss 0)
blkn (cdr (assoc 2 (entget e)))
)
(command ".undo" "be")
(setvar "qaflags" 1)
(command ".explode" ss "")
(setq ss2 (ssget "p"))
(setq sss2 (xss2lst ss2))
(mapcar '(lambda (x) (redraw x 3)) sss2)
(princ "\n Choose the entity from block:")
(while (setq ssa (ssget ":S"))
(mapcar '(lambda (x)
(if (and (ssmemb x ss2) (member x ssr))
(progn (redraw x 3)
(setq ssr (vl-remove x ssr))
)
(if (ssmemb x ss2)
(progn (redraw x 4)
(setq ssr (cons x ssr))
)
)
)
)
(xss2lst ssa)
)
)
(setq ssx (mapcar 'entget ssr))
(command ".u")
;;; (setq ;npt (getpoint "\n Basic point：")
;;; ;npt2 (getpoint "\n Copy to：")
;;; )
(setq eee (entlast)
ssn (ssadd))
(mapcar 'entmake ssx)
;;; (setq eee(entnext eee))
(while (setq eee(entnext eee))
(ssadd eee ssn)
)
;;; (command ".move" ssn "" npt pause)
;;; (setq rlst (mapcar '(lambda (x) (vl-position x sss2)) ssr))
;;; (setq i -1)
;;; (vlax-for x (vla-item
;;; (vla-get-blocks
;;; (vla-get-activedocument (vlax-get-acad-object))
;;; )
;;; blkn
;;; )
;;; (setq i (1+ i))
;;; (if (member i rlst)
;;; (vla-delete x)
;;; )
;;; )
;;; (setq ssb (ssget "x" (list (cons 0 "INSERT") (cons 2 blkn)))
;;; sssb (xss2lst ssb)
;;; )
;;; (mapcar 'entupd sssb)
(command ".undo" "e")
;;; ssb
)
)
(if ssn
;(sssetfirst ssn ssn)
(command ".move" ssn "")
)
)
;; v1.1
(defun xss2lst (ss / i lst)
(setq i (sslength ss))
(repeat i
(setq lst (cons (ssname ss (setq i (1- i))) lst))
)
)
你只是在一个形状内复制一个块吗？如果这样的话，从对象外开始排列块会容易得多，那么只需删除形状外的任何块。
页:
[1]