Fixing CopyRel Lisp by Lee Mac

[lutzow10]

Hi Guys,

 

New to CAD Tutor. I came here looking for a lisp routine to do multiple copies at varying distances from a point relative to the last copy point.

 

I found Lee Mac's Lisp Routine on an old post but I am having trouble with it. I am using AutoCAD 2018.

 

(defun c:copyrel ( / b i l o p q s )
   (if
       (and
           (setq s (ssget "_:L"))
           (setq p (getpoint "\nSpecify Base Point: "))
           (setq b (vlax-3D-point (trans p 1 0)))
       )
       (progn
           (repeat (setq i (sslength s))
               (setq l (cons (vlax-ename->vla-object (ssname s (setq i (1- i)))) l))
           )
           (while (setq q (acet-ss-drag-move s p "\nSpecify Second Point: " 0 0))
               (setq s (ssadd))
               (foreach x l
                   (vla-move (setq o (vla-copy x)) b (vlax-3D-point (trans q 1 0)))
                   (ssadd (vlax-vla-object->ename o) s)
               )
               (setq p q)
           )
       )
   )
   (princ)
)
(vl-load-com)
(princ)

 

So it seems to work up until the second copy. The issue I have is that I am unable to control the direction of the second copy. Also the distance is incorrect for the direction it does copy it to.

 

I am trying to use it to quickly draw a column grid. I have orthomode on. My first copy is horizontal, the second is also to be horizontal and all visual cues show as if it will be copied horizontally, just like the other copy. However, the result is that it copies the object downward. And not even to the correct distance. For example I typed in 20'-8" and it copied it 7' something down on the Y-axis.

 

This is exactly what I am looking for so if anyone can help me out with this it would be fantastic!!

[lutzow10]

Link to OP: http://www.cadtutor.net/forum/showthread.php?71563-Copy-relative-to-last-copy-location-function

[ReMark]

See if this one works. The command name is copyrela not copyrel.

 

Testit.lsp

 

BTW...I did not write it... Lee Mac did. It was the first of two very similar routines he posted to a thread on 6 Aug 2012.

 

I think you used the second routine.

 

In my test the lisp routine worked. I'm running AutoCAD 2018.

[lutzow10]

See if this one works. The command name is copyrela not copyrel.

 

[ATTACH]62564[/ATTACH]

 

BTW...I did not write it... Lee Mac did. It was the first of two very similar routines he posted to a thread on 6 Aug 2012.

 

I think you used the second routine.

 

In my test the lisp routine worked. I'm running AutoCAD 2018.

 

That did it! Thanks a lot.

[ReMark]

I'm glad to hear it worked for you too. Thanks for updating us.

 

For anyone else that is interested both versions of the routine can be found in post #8 of this thread. I have no idea why the second one did not work as expected in AutoCAD 2018. I too had trouble with it that's why I tried the first version before replying above.

 

http://www.cadtutor.net/forum/showthread.php?71563-Copy-relative-to-last-copy-location-function

[lutzow10]

This is a stretch but I figured I would ask, is there anyway to turn on the preview of the objects being copied like the default copy or move command has?

 

I might just replace the copy command with this command, but sometimes for none precise copying, I just wing it visually which this lisp doesn't currently allow for since there is no preview.

 

Like I said this is a total shot in the dark, so no worries if it can't be done

 

Thanks again for your help! makes laying out column grids a piece of cake

[ReMark]

Your request is beyond my level of expertise. One of the lisp gurus here should be able to answer your question though. Patience.

[Grrr]

The closest I could do with grread is:

 

(defun C:copyrel ( / SS b r )
 (and (setq SS (ssget "_:L")) (setq b (getpoint "\nSpecify Base Point: ")) (setq r (my-ss-drag-move b SS))
   (while r (princ "\nSpecify next point <exit>: ") 
     (setq r (apply 'my-ss-drag-move r))
   )
 )
 (princ)
)
(vl-load-com) (princ)

(defun my-ss-drag-move ( b SS / _MoveSS _CopySS _MoveCopySS SS b i L nL g s p prev nSS tmp )
 '(87 114 105 116 116 101 110 32 98 121 32 71 114 114 114)
 (setq _MoveSS (lambda ( L p1 p2 ) (foreach x L (vla-Move x p1 p2))))
 (setq _CopySS (lambda ( L ) (foreach x L (setq nL (cons (vla-Copy x) nL))) nL))
 (and (or SS (setq SS (ssget "_:L"))) (or b (setq b (getpoint "\nSpecify Base Point: ")))
   (setq b (trans b 1 0))
   (repeat (setq i (sslength SS)) (setq L (cons (vlax-ename->vla-object (ssname SS (setq i (1- i)))) L)))
   (setq nL (_CopySS L))
   (while (not s) (setq g (grread T)) (redraw)
     (cond
       ( (equal g '(2 13)) (setq s T) )
       ( (= (car g) 5) (if p (grdraw b p 1 3)) (setq p (trans (cadr g) 1 0)) (_MoveSS nL (cond (prev (vlax-3D-point prev))((vlax-3D-point b))) (vlax-3D-point p)) (setq prev p) )
       ( (= (car g) 3) (if (setq tmp (getpoint "\nTo snap specify again <back>: ")) (progn (_MoveSS nL (vlax-3D-point prev) (vlax-3D-point tmp)) (setq s T)))  )
       ( (= (car g) 25) (setq prev nil) (mapcar 'vla-Delete nL) (setq s T) )
     ); cond		
   ); while
 ); and
 (redraw)
 (if tmp (list tmp (progn (setq nSS (ssadd)) (mapcar (function (lambda (x) (ssadd (vlax-vla-object->ename x) nSS))) nL) nSS)))
); defun my-ss-drag-move

 

But as you can see it requres additional point input, due to snapping issues (else without that input you won't be able to snap[preview snap] anywhere).

Although I think Its is still possible to replicate the acet-ss-drag-move by using something like this.

[Roy_043]

If you do not care about acet-ss-drag-move and its effects, something like the code below will work. Compared to Lee's code that was discussed here it has the advantage of also copying associative relations (of dimensions and hatch patterns for example).

(vl-load-com)

(defun c:CopyRelAlt ( / *error* doc end org ss sta)

 (defun *error* (msg)
   (setvar 'cmdecho 1)
   (vla-endundomark doc)
 )

 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-endundomark doc)
 (vla-startundomark doc)
 (if
   (and
     (setq ss (ssget))
     (setq org (getpoint "\nBase point: "))
   )
   (progn
     (setq sta org)
     (setvar 'cmdecho 0)
     (while (setq end (getpoint sta "\nSecond point or Enter: "))
       (command "_.copy" ss "" "_non" org "_non" end)
       (setq sta end)
     )
     (setvar 'cmdecho 1)
   )
 )
 (vla-endundomark doc)
 (princ)
)

Edited November 3, 2017 by Roy_043
Improved code