Topic: copy entity from block

[Lee Mac]

Oh now i see ^^ Great, It's new for me.

You're welcome!
I also use this construct when retrieving Object IDs, as shown by my LM:ObjectID function in this program. 

Lee

[ahsattarian]

Have a look at this routine below.
It copies Line from inside Block into Current Space.

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" (trans (car li) 0 1) (trans (cadr li) 0 1) "")
47.     (command "pselect" "last" "")
48.     (princ)
49.   )
50. )