Jump to content

Copy block within the entity (bcopy)


AIberto

Recommended Posts

Copy block within the entity (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 entity  by 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))
 )
)


Link to comment
Share on other sites

Are you just copying a block inside a shape if so its much easier to Array the block starting outside the object then just erase any blocks that are outside the shape.

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...