CADWORKER Posted January 25, 2014 Share Posted January 25, 2014 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 Quote Link to comment Share on other sites More sharing options...
flyfox1047 Posted January 25, 2014 Share Posted January 25, 2014 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) Quote Link to comment Share on other sites More sharing options...
marko_ribar Posted January 25, 2014 Share Posted January 25, 2014 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) ) Quote Link to comment Share on other sites More sharing options...
CADWORKER Posted January 26, 2014 Author Share Posted January 26, 2014 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. Quote Link to comment Share on other sites More sharing options...
Mina Posted April 18, 2015 Share Posted April 18, 2015 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! Quote Link to comment Share on other sites More sharing options...
marko_ribar Posted April 18, 2015 Share Posted April 18, 2015 (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...) Quote Link to comment Share on other sites More sharing options...
Mina Posted April 19, 2015 Share Posted April 19, 2015 Very thanks! It work fine! It will save me a lot of time! Quote Link to comment Share on other sites More sharing options...
Mina Posted April 21, 2015 Share Posted April 21, 2015 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 Quote Link to comment Share on other sites More sharing options...
Mina Posted April 25, 2015 Share Posted April 25, 2015 No one can help me? It's a week that I try to solve this, but without results... Thanks. Luca Quote Link to comment Share on other sites More sharing options...
BIGAL Posted April 25, 2015 Share Posted April 25, 2015 (edited) 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 April 26, 2015 by BIGAL Quote Link to comment Share on other sites More sharing options...
Mina Posted April 26, 2015 Share Posted April 26, 2015 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 Quote Link to comment Share on other sites More sharing options...
CADWORKER Posted March 6, 2018 Author Share Posted March 6, 2018 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. Quote Link to comment Share on other sites More sharing options...
BIGAL Posted March 7, 2018 Share Posted March 7, 2018 try (setq sspts (ssget '((0 . "Text")))) Quote Link to comment Share on other sites More sharing options...
CADWORKER Posted March 10, 2018 Author Share Posted March 10, 2018 try (setq sspts (ssget '((0 . "Text")))) BIGAL : Thanks a lot, it works Quote Link to comment Share on other sites More sharing options...
CADWORKER Posted October 4, 2020 Author Share Posted October 4, 2020 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.. Quote Link to comment Share on other sites More sharing options...
marko_ribar Posted October 11, 2020 Share Posted October 11, 2020 ... (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)) ) ... Quote Link to comment Share on other sites More sharing options...
masihpakecad Posted May 24, 2021 Share Posted May 24, 2021 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 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.