TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: taner on June 02, 2013, 05:06:56 AM

Title: copy entity from block
Post by: taner on June 02, 2013, 05:06:56 AM
Dear all,

Can anyone solve this problem? please see the below link.
 http://bbs.xdcad.net/thread-667613-1-1.html
Title: Re: copy entity from block
Post by: hugha on June 02, 2013, 05:43:36 AM
It's all in Chinese.
Title: Re: copy entity from block
Post by: GP on June 02, 2013, 06:31:02 AM
ncopy ?!?
Title: Re: copy entity from block
Post by: Lee Mac on June 02, 2013, 07:19:15 AM
Code - Auto/Visual Lisp: [Select]
  1. (defun c:test ( / a b )
  2.     (if
  3.         (and
  4.             (setq a (nentselp))
  5.             (= 4 (length a))
  6.             (setq b (entmakex (entget (car a))))
  7.         )
  8.         (vla-transformby (vlax-ename->vla-object b) (vlax-tmatrix (caddr a)))
  9.     )
  10.     (princ)
  11. )
Title: Re: copy entity from block
Post by: taner on June 02, 2013, 11:19:58 AM
yes,it is similar to ncopy.

Hi, Lee, your routine can only copy one entity at one time. But the request is copy all entity at one time.Explode is not allowed.

thanks.
Title: Re: copy entity from block
Post by: Lee Mac on June 02, 2013, 12:26:52 PM
Quote from: Tsec2nd on June 02, 2013, 11:19:58 AM
But the request is copy all entity at one time.Explode is not allowed.

Code - Auto/Visual Lisp: [Select]
  1. ;; Multiple Nested Copy  -  Lee Mac
  2. ;; Copies all components of a selected block reference to the active space.
  3.  
  4. (defun c:ncopym ( / ent lst mat obj )
  5.     (while
  6.         (progn (setvar 'errno 0) (setq ent (car (entsel "\nSelect Block Reference: ")))
  7.             (cond
  8.                 (   (= 7 (getvar 'errno))
  9.                     (princ "\nMissed, try again.")
  10.                 )
  11.                 (   (= 'ename (type ent))
  12.                     (setq obj (vlax-ename->vla-object ent))
  13.                     (cond
  14.                         (   (/= "AcDbBlockReference" (vla-get-objectname obj))
  15.                             (princ "\nSelected object is not a block reference.")
  16.                         )
  17.                         (   (= :vlax-true (vla-get-hasattributes obj))
  18.                             (princ "\nSelected block must not be attributed.")
  19.                         )
  20.                         (   (= :vlax-true (vla-get-isdynamicblock obj))
  21.                             (princ "\nSelected block must not be dynamic.")
  22.                         )
  23.                         (   (not
  24.                                 (and
  25.                                     (equal (vla-get-xscalefactor obj) (vla-get-yscalefactor obj) 1e-8)
  26.                                     (equal (vla-get-xscalefactor obj) (vla-get-zscalefactor obj) 1e-8)
  27.                                 )
  28.                             )
  29.                             (princ "\nSelected block must be uniformly scaled.")
  30.                         )                                    
  31.                         (   t
  32.                             (setq mat
  33.                                 (vlax-tmatrix
  34.                                     (apply
  35.                                         (function
  36.                                             (lambda ( mat vec )
  37.                                                 (append (mapcar 'append mat (mapcar 'list vec))
  38.                                                    '((0.0 0.0 0.0 1.0))
  39.                                                 )
  40.                                             )
  41.                                         )
  42.                                         (refgeom ent)
  43.                                     )
  44.                                 )
  45.                             )
  46.                             (vlax-for obj (vla-item (vla-get-blocks (LM:acdoc)) (vla-get-name obj))
  47.                                 (setq lst (cons obj lst))
  48.                             )
  49.                             (foreach obj
  50.                                 (vlax-invoke (LM:acdoc) 'copyobjects (reverse lst)
  51.                                     (vlax-ename->vla-object (cdr (assoc 330 (entget ent))))
  52.                                 )
  53.                                 (vla-transformby obj mat)
  54.                             )
  55.                         )
  56.                     )
  57.                 )
  58.             )
  59.         )
  60.     )
  61.     (princ)
  62. )
  63.  
  64. ;; RefGeom (gile)
  65. ;; Returns a list whose first item is a 3x3 transformation matrix and
  66. ;; second item the object insertion point in its parent (xref, block or space)
  67.  
  68. (defun refgeom ( ent / ang enx mat ocs )
  69.     (setq enx (entget ent)
  70.           ang (cdr (assoc 050 enx))
  71.           ocs (cdr (assoc 210 enx))
  72.     )
  73.     (list
  74.         (setq mat
  75.             (mxm
  76.                 (mapcar '(lambda ( v ) (trans v 0 ocs t))
  77.                    '(
  78.                         (1.0 0.0 0.0)
  79.                         (0.0 1.0 0.0)
  80.                         (0.0 0.0 1.0)
  81.                     )
  82.                 )
  83.                 (mxm
  84.                     (list
  85.                         (list (cos ang) (- (sin ang)) 0.0)
  86.                         (list (sin ang) (cos ang)     0.0)
  87.                        '(0.0 0.0 1.0)
  88.                     )
  89.                     (list
  90.                         (list (cdr (assoc 41 enx)) 0.0 0.0)
  91.                         (list 0.0 (cdr (assoc 42 enx)) 0.0)
  92.                         (list 0.0 0.0 (cdr (assoc 43 enx)))
  93.                     )
  94.                 )
  95.             )
  96.         )
  97.         (mapcar '- (trans (cdr (assoc 10 enx)) ocs 0)
  98.             (mxv mat (cdr (assoc 10 (tblsearch "block" (cdr (assoc 2 enx))))))
  99.         )
  100.     )
  101. )
  102.  
  103. ;; Matrix Transpose  -  Doug Wilson
  104. ;; Args: m - nxn matrix
  105.  
  106. (defun trp ( m )
  107.     (apply 'mapcar (cons 'list m))
  108. )
  109.  
  110. ;; Matrix x Matrix  -  Vladimir Nesterovsky
  111. ;; Args: m,n - nxn matrices
  112.  
  113. (defun mxm ( m n )
  114.     ((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n))
  115. )
  116.  
  117. ;; Matrix x Vector  -  Vladimir Nesterovsky
  118. ;; Args: m - nxn matrix, v - vector in R^n
  119.  
  120. (defun mxv ( m v )
  121.     (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
  122. )
  123.  
  124. ;; Active Document  -  Lee Mac
  125. ;; Returns the VLA Active Document Object
  126.  
  127. (defun LM:acdoc nil
  129.     (LM:acdoc)
  130. )
  131.  
Title: Re: copy entity from block
Post by: taner on June 02, 2013, 12:50:10 PM
HI,Lee,Hope you download the attched test file for testing.

the test result:命令:  NCOPYM

Select Block Reference:
Selected block must be uniformly scaled.
Select Block Reference: *取消*
; 错误: 函数被取消
Title: Re: copy entity from block
Post by: Lee Mac on June 02, 2013, 02:11:53 PM
Quote from: Tsec2nd on June 02, 2013, 12:50:10 PM
HI,Lee,Hope you download the attched test file for testing.

the test result:命令:  NCOPYM

Select Block Reference:
Selected block must be uniformly scaled.
Select Block Reference: *取消*
; 错误: 函数被取消

Yes, the program is restricted to uniformly scaled blocks as stated by the message.
Title: Re: copy entity from block
Post by: taner on June 03, 2013, 06:24:11 AM
Hi,LEE,Can you try to write one that can copy not uniformly scaled block(the attachment is uniformly scaled block )? Thanks!
Title: Re: copy entity from block
Post by: Lee Mac on June 03, 2013, 06:29:53 AM
Quote from: Tsec2nd on June 03, 2013, 06:24:11 AM
Can you try to write one that can copy not uniformly scaled block

Code - Auto/Visual Lisp: [Select]
  1. (defun c:ncopym ( / ent obj )
  2.     (while
  3.         (progn (setvar 'errno 0) (setq ent (car (entsel "\nSelect Block Reference: ")))
  4.             (cond
  5.                 (   (= 7 (getvar 'errno))
  6.                     (princ "\nMissed, try again.")
  7.                 )
  8.                 (   (= 'ename (type ent))
  9.                     (setq obj (vlax-ename->vla-object ent))
  10.                     (cond
  11.                         (   (/= "AcDbBlockReference" (vla-get-objectname obj))
  12.                             (princ "\nSelected object is not a block reference.")
  13.                         )
  14.                         (   (= :vlax-true (vla-get-hasattributes obj))
  15.                             (princ "\nSelected block must not be attributed.")
  16.                         )
  17.                         (   (= :vlax-true (vla-get-isdynamicblock obj))
  18.                             (princ "\nSelected block must not be dynamic.")
  19.                         )
  20.                         (   (not (vlax-write-enabled-p obj))
  21.                             (princ "\nSelected block is on locked layer.")
  22.                         )
  23.                         (   (vla-explode obj)) ;; Thanks roy
  24.                     )
  25.                 )
  26.             )
  27.         )
  28.     )
  29.     (princ)
  30. )
Title: Re: copy entity from block
Post by: roy_043 on June 03, 2013, 01:23:51 PM
(vla-explode) does not erase the original object so there is no need for (vla-copy).
Title: Re: copy entity from block
Post by: Lee Mac on June 03, 2013, 06:48:38 PM
Quote from: roy_043 on June 03, 2013, 01:23:51 PM
(vla-explode) does not erase the original object so there is no need for (vla-copy).

Good catch roy, the code was written in haste  :oops:
Now updated.
Title: Re: copy entity from block
Post by: Ketxu on June 04, 2013, 07:08:30 AM
Lee, please tell me what benefit of use LM:acdoc funtion in #6 post. Can be simple (vla-get-activedocument (vlax-get-acad-object)) ? . I haven't understand clearly :(. Thank you
Title: Re: copy entity from block
Post by: Lee Mac on June 04, 2013, 08:45:17 AM
Quote from: Ketxu on June 04, 2013, 07:08:30 AM
Lee, please tell me what benefit of use LM:acdoc funtion in #6 post. Can be simple (vla-get-activedocument (vlax-get-acad-object)) ? . I haven't understand clearly :(. Thank you

The use of defun-q will help to explain the difference:

Consider the following functions:
Code - Auto/Visual Lisp: [Select]
  1. (defun-q f1 nil
  3. )
Code - Auto/Visual Lisp: [Select]
  1. (defun-q f2 nil
  3.     (f2)
  4. )

Before function evaluation, the respective function definitions are as follows:
Code - Auto/Visual Lisp: [Select]
  1. _$ f1
  3. _$ f2

When evaluated, both functions will return the Active Document object:
Code - Auto/Visual Lisp: [Select]
  1. _$ (f1)
  2. #<VLA-OBJECT IAcadDocument 0ceb5b6c>
  3. _$ (f2)
  4. #<VLA-OBJECT IAcadDocument 0ceb5b6c>

However, observe the respective function definitions following function evaluation:
Code - Auto/Visual Lisp: [Select]
  1. _$ f1
  3. _$ f2
  4. (nil #<VLA-OBJECT IAcadDocument 0ceb5b6c>)

Note that function f2 now no longer retrieves the Application Object (vlax-get-acad-object) before retrieving the Active Document Property (vla-get-activedocument), but simply returns the Active Document object directly. The method is similar to setting a global variable pointing to the Active Document Object.

Of course, for this program, I could have equivalently used a local variable assigned with the Active Document Object, however, such local variable would then be re-assigned this value for every use of the program.
Title: Re: copy entity from block
Post by: Ketxu on June 04, 2013, 09:47:21 AM
Oh now i see ^^ Great, It's new for me.
Title: Re: copy entity from block
Post by: Lee Mac on June 04, 2013, 09:57:37 AM
Quote from: Ketxu on June 04, 2013, 09:47:21 AM
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 (http://lee-mac.com/areastofield.html).  :-)

Lee
Title: Re: copy entity from block
Post by: ahsattarian on October 12, 2023, 02:49:09 AM
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. )