Jump to content

copy and paste on multiple points


CADWORKER

Recommended Posts

Hi,

 

Back with a situation, I have lots of points / blocks on which I have to place a rectangle,

I have a rectangle I pick the rectangle and the mid of one of the sides of the rectangle depending upon the orientation and then I have to paste the same on all the points individually.

 

Is there any lisp routine that will do the same like select the rectangle and select the base point and then the points on which it has to be pasted.

 

Thanks in advance

Link to comment
Share on other sites

try this:

This should be LEEMAC program

(defun c:bpl ( / _block _ang b e i j p s )    
   (if
       (and
           (setq b (LM:ssget "\nSelect Block to Align: " '("_+.:E:S" ((0 . "INSERT")))))
           (setq s (LM:ssget "\nSelect LWPolylines: "    '(((0 . "LWPOLYLINE")))))
       )
       (progn
           (eval
               (list 'defun '_block '( p r )
                   (list 'entmake
                       (list 'list
                         ''(0 . "INSERT")
                          '(cons 10 p)
                          '(cons 50 r)
                           (list 'quote (assoc 2 (entget (ssname b 0))))
                       )
                   )
               )
           )
           (defun _ang ( e p )
               (apply 'atan (cdr (reverse (vlax-curve-getfirstderiv e p))))
           )
           (repeat (setq i (sslength s))
               (setq e (ssname s (setq i (1- i))))
               (_block (vlax-curve-getstartpoint e) (_ang e 0))
               (_block (vlax-curve-getendpoint   e) (+ pi (_ang e (vlax-curve-getendparam e))))
               (repeat (fix (setq j (1- (vlax-curve-getendparam e))))
                   (_block (setq p (vlax-curve-getpointatparam e j)) (_ang e j))
                   (_block p (+ pi (_ang e (setq j (1- j)))))
               )
           )
       )
   )
   (princ)
)

;; ssget  -  Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;;
;; Arguments:
;; msg    - selection prompt
;; params - list of ssget arguments

(defun LM:ssget ( msg params / sel )
   (princ msg)
   (setvar 'nomutt 1)
   (setq sel (vl-catch-all-apply 'ssget params))
   (setvar 'nomutt 0)
   (if (not (vl-catch-all-error-p sel)) sel)
)

(vl-load-com)
(princ)

Link to comment
Share on other sites

Maybe this, if you want to copy to selected points...

 

(defun c:copy2points ( / cpm ssobj bp sspts i entpt pt ptlst )
 (setq cpm (getvar 'copymode))
 (prompt "\nSelect object(s) for copying to points")
 (setq ssobj (ssget "_:L"))
 (setq bp (getpoint "\nPick base point : "))
 (prompt "\nSelect destination points")
 (setq sspts (ssget '((0 . "POINT"))))
 (setq i -1)
 (while (setq entpt (ssname sspts (setq i (1+ i))))
   (setq pt (cdr (assoc 10 (entget entpt))))
   (setq ptlst (cons pt ptlst))
 )
 (setvar 'copymode 1)
 (foreach pt ptlst
   (command "_.copy" ssobj "" bp pt)
 )
 (setvar 'copymode cpm)
 (princ)
)

Link to comment
Share on other sites

Thanks to flyfox for the support & Leemac for the code; This code is not what I was lookig for.

Thanks to Marko_ribar, this is the code I was looking for.

 

I appericiate All for your time and efforts.

Link to comment
Share on other sites

  • 1 year later...

Hi, in first, very thanks to all for the indirect help that I received from this forum.

I've a little question:

referring to the marko_ribar script, is there a way to modify it for paste the rectangle (or any other thing) at the final point of many lines that I've in the drawing?

Substitute the points with the final point of a line.

Thanks!

Link to comment
Share on other sites

(defun c:copy2lineends ( / cpm ssobj bp sspts i entpt pt ptlst )
 (setq cpm (getvar 'copymode))
 (prompt "\nSelect object(s) for copying to points")
 (setq ssobj (ssget "_:L"))
 (setq bp (getpoint "\nPick base point : "))
 (prompt "\nSelect destination lines endpoints")
 (setq sspts (ssget '((0 . "LINE"))))
 (setq i -1)
 (while (setq entpt (ssname sspts (setq i (1+ i))))
   (setq pt (cdr (assoc 11 (entget entpt))))
   (setq ptlst (cons pt ptlst))
 )
 (setvar 'copymode 1)
 (foreach pt ptlst
   (command "_.copy" ssobj "" bp pt)
 )
 (setvar 'copymode cpm)
 (princ)
)

 

HTH, M.R. (if I understood correctly...)

Link to comment
Share on other sites

Hi, I'm here again... If I would make the same with leader?

I wrote this

 

(setq sspts (ssget '((0 . "LEADER"))))

(setq i -1)

(while (setq entpt (ssname sspts (setq i (1+ i))))

(setq pt (cdr (assoc 11 (entget entpt))))

(setq ptlst (cons pt ptlst))

)

 

It select the leader but don't paste in the end point.

 

I try and also to set

 

"assoc 10" instead of"assoc 11"

 

It work, but it paste the object to the start point of the leader

Link to comment
Share on other sites

Need to look up dxf code for leader assoc 10 or dxf code 10 is most common in a lot of objects insert pt, start of line/pline centre arc/circle. Do a google dxf assoc.

 

Hint http://www.autodesk.com/techpubs/autocad/acad2000/dxf/leader_dxf_06.htm

 

Here is a quickie what assoc codes can help sometimes this is usefull when you know certain points etc. a 2 line leader

 

Command: (setq obj (entget (car (entsel))))

Select object: ((-1 . <Entity name: 7ffffb2b730>) (0 . "LEADER") (330 . <Entity name: 7ffffb039f0>) (5 . "606B") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (100 . "AcDbLeader") (3 . "Standard") (71 . 1) (72 . 0) (73 . 0) (74 . 0) (75 . 0) (40 . 0.18) (41 . 0.754286) (76 . 3) (10 7475.55 121.047 0.0) (10 10519.4 2759.88 0.0) (10 13649.5 1971.1 0.0) (340 . <Entity name: 7ffffb2b740>) (211 1.0 0.0 0.0) (210 0.0 0.0 1.0) (212 0.0 0.0 0.0) (213 0.0 0.0 0.0))

 

You need to walk through the list check for assoc 10's

 

(defun c:test ( / obj len objent x)
(setq obj (entget (car (entsel))))
(setq len (length obj))
(setq x 0)
(repeat len
(setq objent (nth x obj))
(if (= (car objent) 10)
(princ (cdr objent))
(princ "miss")
)
(setq x (+ x 1)) 
)
)

Edited by BIGAL
Link to comment
Share on other sites

Thanks Bigal, with yours hint solved my problems:

 

 

(defun c:qq ( / cpm ssobj bp sspts i entpt pt ptlst )
 (setq cpm (getvar 'copymode))
 (prompt "\nSelect object(s) for copying to points")
 (setq ssobj (ssget "_:L"))
 (setq bp (getpoint "\nPick base point : "))
 (prompt "\nSelect destination points")
 (setq sspts (ssget '((0 . "LEADER"))))
 (setq i -1)
 (while (setq entpt (ssname sspts (setq i (1+ i))))
   (setq pt (cdr (nth 21 (entget entpt))))
   (setq ptlst (cons pt ptlst))
 )
 (setvar 'copymode 1)
 (foreach pt ptlst
   (command "_.copy" ssobj "" bp pt)
 )
 (setvar 'copymode cpm)
 (princ)
)

 

This code provide to copy selected objects to the end points of a 2 vertex leaders.

 

Luca

Link to comment
Share on other sites

  • 2 years later...
Maybe this, if you want to copy to selected points...

 

(defun c:copy2points ( / cpm ssobj bp sspts i entpt pt ptlst )
 (setq cpm (getvar 'copymode))
 (prompt "\nSelect object(s) for copying to points")
 (setq ssobj (ssget "_:L"))
 (setq bp (getpoint "\nPick base point : "))
 (prompt "\nSelect destination points")
 (setq sspts (ssget '((0 . "POINT"))))
 (setq i -1)
 (while (setq entpt (ssname sspts (setq i (1+ i))))
   (setq pt (cdr (assoc 10 (entget entpt))))
   (setq ptlst (cons pt ptlst))
 )
 (setvar 'copymode 1)
 (foreach pt ptlst
   (command "_.copy" ssobj "" bp pt)
 )
 (setvar 'copymode cpm)
 (princ)
)

 

What if I want to paste to insertion point of texts.

Link to comment
Share on other sites

  • 2 years later...
On 4/18/2015 at 4:03 PM, marko_ribar said:

 


(defun c:copy2lineends ( / cpm ssobj bp sspts i entpt pt ptlst )
 (setq cpm (getvar 'copymode))
 (prompt "\nSelect object(s) for copying to points")
 (setq ssobj (ssget "_:L"))
 (setq bp (getpoint "\nPick base point : "))
 (prompt "\nSelect destination lines endpoints")
 (setq sspts (ssget '((0 . "LINE"))))
 (setq i -1)
 (while (setq entpt (ssname sspts (setq i (1+ i))))
   (setq pt (cdr (assoc 11 (entget entpt))))
   (setq ptlst (cons pt ptlst))
 )
 (setvar 'copymode 1)
 (foreach pt ptlst
   (command "_.copy" ssobj "" bp pt)
 )
 (setvar 'copymode cpm)
 (princ)
)
 

 

 

HTH, M.R. (if I understood correctly...)

how to paste to the end and mid of the lines?

your help is appreciated..

Link to comment
Share on other sites

...
 (while (setq entpt (ssname sspts (setq i (1+ i))))
   (setq pt (cdr (assoc 11 (entget entpt))))
   (setq ptlst (cons pt ptlst))
   (setq pt (cdr (assoc 10 (entget entpt))))
   (setq ptlst (cons pt ptlst))
   (setq pt (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) (car ptlst) (cadr ptlst)))
   (setq ptlst (cons pt ptlst))
 )
...

 

Link to comment
Share on other sites

  • 7 months later...

i love this lisp from marko_ribar,its help me much,,my question is:can use this lisp for block object?

thanks for your humble

Screenshot_2021-05-24-21-51-37-83_6bcd734b3b4b52977458a65c801426b0.jpg

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...