Topic: Copy object from block to active space

[Coder]

Hello guys 

I saw before in this forum before a way with function vla-copyobjects to copy specific object to active space but I can't find .
Anyone can give me any example ?

ncopy lisp command in the Express tools helps but I need to include that in my lisp . 

many thanks

[hanhphuc]

hi coder try,
http://www.theswamp.org/index.php?topic=39876.0

[Coder]

hi coder try,
http://www.theswamp.org/index.php?topic=39876.0

Thank you hanhphuc , that's what I wanted 

many thanks

[Coder]

I am sorry , that works on single block and I need to work on many blocks by using the ssget function 

Can you help me ?

Thanks

[hanhphuc]

;i remember there was a thread by Lee Mac here,
;it was something like this:

Code: [Select]

(vl-load-com)
(if (and (setq blk (car (entsel "select entity..")))
         (vlax-write-enabled-p blk)
    ) ;_  and
  (vla-explode (vlax-ename->vla-object blk))
) ;_  if

;it means that you clone the block first, then you are able to manipulate ssget filter, modify, delete, etc..
;make sure layer is unlock
;hope this help 

[Coder]

I don't want to explode the block 

[ahsattarian]

Have a look at this code for lines  :

Code - Auto/Visual Lisp: [Select]

1. (defun c:ncopyline ()
2.   (while t
3.     (setq g 1)
4.     (while (= g 1)
5.       (while (null (setq es (nentselp "\r Select Line : "))))
6.       (setq s (car es))
7.       (setq en (entget s '("*")))
8.       (setq typ (strcase (cdr (assoc 0 en)) t))
9.       (cond ((= typ "line") (setq g 0)))
10.     )
11.     (setq en (entget s '("*")))
12.     (setq po1 (cdr (assoc 10 en)))
13.     (setq po2 (cdr (assoc 11 en)))
14.     (setq li (list po1 po2))
15.     (foreach s (cadddr es)
16.       (setq en (entget s '("*")))
17.       (setq po (cdr (assoc 10 en)))
18.       (setq scx (cdr (assoc 41 en)))
19.       (setq scy (cdr (assoc 42 en)))
20.       (setq scz (cdr (assoc 43 en)))
21.       (setq ang (cdr (assoc 50 en)))
22.       (setq ocs (cdr (assoc 210 en)))
23.       (setq method1 2)
24.       (cond
25.         ((= method1 1) ;|  Written by  :  Lee Mac  |;
26.          (defun mxv (m v) (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m))
27.          (defun trp (m) (apply 'mapcar (cons 'list m)))
28.          (defun mxm (m n) ((lambda (a) (mapcar '(lambda (r) (mxv a r)) m)) (trp n)))
29.          (setq li1 '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0)))
30.          (setq li2 (list (list (cos ang) (- (sin ang)) 0.0) (list (sin ang) (cos ang) 0.0) '(0.0 0.0 1.0)))
31.          (setq li3 (list (list scx 0.0 0.0) (list 0.0 scy 0.0) (list 0.0 0.0 scz)))
32.          (setq mat (mxm (mapcar '(lambda (v) (trans v 0 ocs t)) li1) (mxm li2 li3)))
33.          (setq li4 (mxv mat (cdr (assoc 10 (tblsearch "block" (cdr (assoc 2 en)))))))
34.          (setq rfg (list mat (mapcar '- (trans (cdr (assoc 10 en)) ocs 0) li4)))
35.          (setq li (apply (function (lambda (m v) (mapcar (function (lambda (p) (mapcar '+ (mxv m p) v))) li))) rfg))
36.         )
37.         ((= method1 2) ;|  Written by  :  Amir Hossein Sattarian  |;
38.          (setq li (mapcar '(lambda (pt) (mapcar '* pt (list scx scy scz))) li))
39.          (setq li (mapcar '(lambda (pt) (polar '(0 0 0) (+ ang (angle '(0 0 0) pt)) (distance '(0 0 0) pt))) li))
40.          (setq li (mapcar '(lambda (pt) (mapcar '+ pt po)) li))
41.          (setq li (mapcar '(lambda (pt) (trans pt ocs 0)) li))
42.         )
43.       )
44.     )
45.     (setvar "cmdecho" 0)
46.     (command "line" (car li) (cadr li) "")
47.     (command "pselect" "last" "")
48.     (princ)
49.   )
50. )

Regards,   Amir Hossein Sattarian