A customized copy/array lisp routine

[Kycau]

Hello,

I've wrote a lisp routine, the makes an amount (defined by user) of copies, of several( selected by user) objects, along a distance, defined by 2 points (picked by user).

The program seems to do exactly what I want it to do, but:

1. It seems that the routine runs slowly, and I suppose that it is possible to improve this ) Unfortunately my knowlege of AutoLisp are not deep wnough ) so I ask you for an advise )

2. at the end, I get in the command-line area the next lines:

Command: CC Unknown command "CC". Press F1 for help.
Command: 15359

I examined my code, and I can't find what causes this problem.
I know that 15359 has to do smth. with OSMODE, but I don't see the mistake in my code

3. If it is not so hard to do, I would like a "tracing line" between first point and the second point when they are picked.

but I suppose it will need some essential changes in the code 🙂

P.S.

the routine is attached to the topic

thanks in advance )

[alanjt_]

Here's an update of one I wrote a couple years ago...

(defun c:CM (/ *error* ss p1 p2 d a)
  ;; Copy Multiple Times
  ;; Alan J. Thompson, 03.30.10 / 12.22.10 / 2013.07.05

  (defun *error* (msg)
    (and *AcadDoc* (vla-endundomark *AcadDoc*))
    (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
      (progn (vl-bt) (princ (strcat "\nError: " msg)))
    )
  )

  (vla-startundomark
    (cond (*AcadDoc*)
          ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
    )
  )

  (if (and (setq ss (ssget "_:L"))
           (setq p1 (getpoint "\nSpecify base point: "))
           (setq p2 (if acet-ss-drag-move
                      (acet-ss-drag-move ss p1 "\nSpecify next point: " T)
                      (getpoint p1 "\nSpecify next point: ")
                    )
           )
      )
    (progn
      (setq d  0.
            p1 (trans p1 1 0)
            p2 (trans p2 1 0)
            a  (angle p1 p2)
      )

      (initget 6)
      (setq *CM:Num* (cond ((getint (strcat "\nNumber of copies <"
                                            (itoa (cond (*CM:Num*)
                                                        ((setq *CM:Num* 1))
                                                  )
                                            )
                                            ">: "
                                    )
                            )
                           )
                           (*CM:Num*)
                     )
      )
      (repeat *CM:Num*
        (setq d (+ (distance p1 p2) d))
        (vlax-for x (setq ss (vla-get-activeselectionset *AcadDoc*))
          (vlax-invoke (vla-copy x) 'Move p1 (polar p1 a d))
        )
      )
      (vla-delete ss)
    )
  )
  (*error* nil)
  (princ)
)
(vl-load-com)
(princ)

[Kycau]

I wish there were some 

;commentaries

 🙂

but thanks anyway 🙂

I'll browse all the unknown functions )

[alanjt_]

---

@Kycau wrote:

I wish there were some 

;commentaries

 🙂

but thanks anyway 🙂

I'll browse all the unknown functions )

---

I wish you would just ask, but here you go any way...

(defun c:CM (/ *error* ss p1 p2 d a as)
  ;; Copy Multiple Times
  ;; Alan J. Thompson, 03.30.10 / 12.22.10 / 2013.07.05

  ;; error handler
  (defun *error* (msg)
    (and *AcadDoc* (vla-endundomark *AcadDoc*)) ; undo end
    (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
      (progn (vl-bt) (princ (strcat "\nError: " msg)))
    )
  )

  ;; start undo mark (vl commands aren't recognized by undo, so if you undo afterwards
  ;; it will undo the last command before this one
  (vla-startundomark
    (cond (*AcadDoc*)
          ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
    )
  )

  (if (and (setq ss (ssget "_:L")) ; select objects ("_:L" excludes object(s) on locked layers)
           (setq p1 (getpoint "\nSpecify base point: ")) ; base point for copy
           (setq p2 (if acet-ss-drag-move ; check if function is available. this is part of express tools
                      (acet-ss-drag-move ss p1 "\nSpecify next point: " T) ; function is available, get next point
                      (getpoint p1 "\nSpecify next point: ") ; function unavailable, get next point
                    )
           )
      )
    (progn
      (setq d1 0. ; set copy distance variable
            d2 (distance p1 p2) ; distance b/w p1 and p2
            p1 (trans p1 1 0) ; translate p1 from UCS to WCS (user coordinate system to world..)
            p2 (trans p2 1 0) ; translate p2 from UCS to WCS
            a  (angle p1 p2) ; get angle b/w p1 and p2
      )

      (initget 6) ; removes ability to enter a number 0 or less
      (setq *CM:Num* (cond ((getint (strcat "\nNumber of copies <" ; global variable for number of copies
                                            (itoa (cond (*CM:Num*)
                                                        ((setq *CM:Num* 1))
                                                  )
                                            )
                                            ">: "
                                    )
                            )
                           )
                           (*CM:Num*)
                     )
      )
      (repeat *CM:Num* ; copy object(s) based on number of copies desired
        (setq d1 (+ d2 d1)) ; set distance (distance
        (vlax-for x (cond (as)  ; step through selectionset
                          ((setq as (vla-get-activeselectionset *AcadDoc*)))
                    )
          (vlax-invoke (vla-copy x) 'Move p1 (polar p1 a d1)) ; make copy of each object and move
        )
      )
      (vla-delete as) ; delete vla selection set (doesn't actually delete objects)
    )
  )
  (*error* nil) ; execute the error for a clean close
  (princ) ; exit program quietly
)
(vl-load-com) ; load visual lisp fucntions
(princ) ; load them quietly

Also, I noticed I create the selectionset multiple times, so here's the edited version, without comments.

(defun c:CM (/ *error* ss p1 p2 d a as)
  ;; Copy Multiple Times
  ;; Alan J. Thompson, 03.30.10 / 12.22.10 / 2013.07.05

  (defun *error* (msg)
    (and *AcadDoc* (vla-endundomark *AcadDoc*))
    (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
      (progn (vl-bt) (princ (strcat "\nError: " msg)))
    )
  )

  (vla-startundomark
    (cond (*AcadDoc*)
          ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
    )
  )

  (if (and (setq ss (ssget "_:L"))
           (setq p1 (getpoint "\nSpecify base point: "))
           (setq p2 (if acet-ss-drag-move
                      (acet-ss-drag-move ss p1 "\nSpecify next point: " T)
                      (getpoint p1 "\nSpecify next point: ")
                    )
           )
      )
    (progn
      (setq d1 0.
            d2 (distance p1 p2)
            p1 (trans p1 1 0)
            p2 (trans p2 1 0)
            a  (angle p1 p2)
      )

      (initget 6)
      (setq *CM:Num* (cond ((getint (strcat "\nNumber of copies <"
                                            (itoa (cond (*CM:Num*)
                                                        ((setq *CM:Num* 1))
                                                  )
                                            )
                                            ">: "
                                    )
                            )
                           )
                           (*CM:Num*)
                     )
      )
      (repeat *CM:Num*
        (setq d1 (+ d2 d1))
        (vlax-for x (cond (as)
                          ((setq as (vla-get-activeselectionset *AcadDoc*)))
                    )
          (vlax-invoke (vla-copy x) 'Move p1 (polar p1 a d1))
        )
      )
      (vla-delete as)
    )
  )
  (*error* nil)
  (princ)
)
(vl-load-com)
(princ)

[alanjt_]

To help things along, here's the comand version (similar to yours), just slightly rewritten. I didn't comment it, because you either know what they do, or can take from the other commented one. This is easier to write, but will function a lot slower and just isn't as clean.

(defun c:test (/ ss p1 p2 num ang dst dst2)
  (if (and (setq ss (ssget "_:L"))
           (setq p1 (getpoint "\nSpecify first point: "))
           (setq p2 (getpoint p1 "\nSpecify next point: "))
           (progn (initget 6) (setq num (getint "\nSpecify number of copies: ")))
      )
    (progn
      (setq ang  (angle p1 p2)
            dst  (distance p1 p2)
            dst2 0.
      )
      (repeat num (command "_.copy" ss "" "_non" p1 "_non" (polar p1 ang (setq dst2 (+ dst dst2)))))
    )
  )
  (princ)
)