Copy block x time between 2 points (with orientation) (CM2P adaptation)

[m.lharidon]

Hello,

I tried to modified the attached LSP to add fonctionnalities:

- automatically select the base point of my block

- keep the orientation of my block (for instance if my block is looking up, then when it copy along the line it stay normal to this line)

Here is my try:

(defun c:CM2PM nil (c:CopyMultipleArrayBetween2point))
(defun c:CopyMultipleArrayBetween2point
       (/ *error* ss p p1 p2 pt n l d c lst)
  ;; Author : Tharwat ~ 15. Jan. 2014	;;
  (defun *error* (pm)
    (if c
      (setvar 'CMDECHO c)
    )
    (princ "\n *Cancel*")
  )
  (if (and       
	   (setq e (car (entsel "\Select block: ")))
           (setq p (cdr (assoc 10 (entget e)))
           (setq p1 (getpoint "\n Specify first point :"))
           (setq p2 (getpoint "\n Next point :" p1))
           (setq n (getint "\n Number of EQ spaces :"))
	   (setq rad (angle p1 p2)
		 dau (angtos rad (getvar 'AUNITS) 12))
      )
    (progn
      (setq l (distance p1 p2)
            d (/ l n)
            c (getvar 'CMDECHO)
      )
      (setvar 'CMDECHO 0)
      (foreach x (list p1 p2)
        (command "_.copy" ss "" "_none" p "_none" x)
	(command "_.INSERT" p e "_Scale" 1 "_Rotate" dau "_none" x)
      )
      (repeat (1- n)
        (command "_.copy"
                 ss
                 ""
                 "_none"
                 p
                 "_none"
                 (setq pt (polar p1 (angle p1 p2) d))
        )
        (setq p1 pt)
      )
      (setvar 'CMDECHO c)
    )
  )
  (princ)
)

If anyone can help, it could be so great.

Thanks 🙂

ML

[dbhunia · Accepted solution]

This types of requirements are specific....... so you have to think how to manipulate.......try this.......

(defun c:CM2PM (/ *error* e p p1 p2 n rad l d c blk_ent p3)
  (defun *error* (pm)
    (if c
      (setvar 'CMDECHO c)
    )
    (princ "\n *Cancel*")
  )
  (if (and       
	   (setq e (car (entsel "\n Select block: ")))
	   (setq p (cdr (assoc 10 (entget e))))
           (setq p1 (getpoint "\n Specify first point :"))
           (setq p2 (getpoint "\n Next point :" p1))
           (setq n (getint "\n Number of copies :"))
	   (setq rad (angle p1 p2))
      )
    (progn
      (setq l (distance p1 p2)
            d (/ l (* 2 n))
            c (getvar 'CMDECHO)
      )
      (setvar 'CMDECHO 0)
      (setq p1 (polar p1 rad d))
      (command "_.copy" e "" "_none" p "_none" p1)
      (setq blk_ent (entget (entlast)))
      (entmod (subst (cons 50 (+ rad (/ pi 2)))(assoc 50 blk_ent)blk_ent))
      (setq e (entlast))
      (setq p3 (cdr (assoc 10 (entget e))))
      (repeat (1- n)
	(setq p1 (polar p1 rad (* 2 d)))
        (command "_.copy" e "" "_none" p3 "_none" p1)
      )
      (setvar 'CMDECHO c)
    )
  )
  (princ)
)

[m.lharidon]

Thanks so much!

[m.lharidon]

Dear 

 To complete my range of tool, I want to create a last one where I set the lenght between block.

Still in the same principe:

Set: Set Block/Set P1/Set P2/set distance between two block

Action: Copy as many block as possible between P1-P2 and center then.

Under is my modified lisp with my logic

(defun c:CM2PDist (/ *error* e p p1 p2 n rad l d c blk_ent p3)

  (defun *error* (pm)
    (if c
      (setvar 'CMDECHO c)
    )
    (princ "\n *Cancel*")
  )
  (if (and       
	   (setq e (car (entsel "\n Select block: ")))
	   (setq p (cdr (assoc 10 (entget e))))
           (setq p1 (getpoint "\n Specify first point :"))
           (setq p2 (getpoint "\n Next point :" p1))
           (setq dist (getint "\n Distance between two block :"))
           (setq n (/ l dist)) ; Number Eq distance between blocks, but I need to round it down to an integer
           (setq td (* dist n)) ; dist from block 1 to block last block
           (setq r (td- l)) ; resting distance
           (setq r2 (/ td 2)) ; half of resting distance (start point)
	   (setq rad (angle p1 p2))
      )
    (progn
      (setq l (distance p1 p2)
            d (/ l (* 2 n))
            c (getvar 'CMDECHO)
      )
      (setvar 'CMDECHO 0)
      (setq p1 (polar p1 rad r2))
      (command "_.copy" e "" "_none" p "_none" p1)
      (setq blk_ent (entget (entlast)))
      (entmod (subst (cons 50 (+ rad (/ pi 2)))(assoc 50 blk_ent)blk_ent))
      (setq e (entlast))
      (setq p3 (cdr (assoc 10 (entget e))))
      (repeat n
	(setq p1 (polar p1 rad dist))
        (command "_.copy" e "" "_none" p3 "_none" p1)
      )
      (setvar 'CMDECHO c)
    )
  )
  (princ)
)

For the round down function I found it in lee mac but I don't really understand how to use it.

;; Round Down  -  Lee Mac
;; Rounds 'n' down to the nearest 'm'

(defun LM:rounddown ( n m )
    ((lambda ( r ) (cond ((equal 0.0 r 1e-8) n) ((< n 0) (- n r m)) ((- n r)))) (rem n m))
)

Am I correct?

Thanks.

ML

[dbhunia · Accepted solution]

Try this.......

(defun c:CM2PM (/ *error* e p p1 p2 n rad l d c blk_ent p3 dist td r)
  (defun *error* (pm)
    (if c
      (setvar 'CMDECHO c)
    )
    (princ "\n *Cancel*")
  )
  (if (and       
	   (setq e (car (entsel "\n Select block: ")))
           (setq p1 (getpoint "\n Specify first point :"))
           (setq p2 (getpoint "\n Next point :" p1))
	   (setq dist (getdist "\n Distance between two block :"))
      )
    (progn
      (setq p (cdr (assoc 10 (entget e)))
	    l (distance p1 p2)
            n (fix (/ l dist))
            td (* dist n)
            d (/ td (* 2 n))
            r (if (/= l td) (/ (- l td) 2) d)
	    rad (angle p1 p2)
            c (getvar 'CMDECHO)
      )
      (setvar 'CMDECHO 0)
      (setq p1 (polar p1 rad r))
      (command "_.copy" e "" "_none" p "_none" p1)
      (setq blk_ent (entget (entlast)))
      (entmod (subst (cons 50 (+ rad (/ pi 2)))(assoc 50 blk_ent)blk_ent))
      (setq e (entlast))
      (setq p3 (cdr (assoc 10 (entget e))))
      (repeat (if (= l td) (1- n) n)
	(setq p1 (polar p1 rad (* 2 d)))
        (command "_.copy" e "" "_none" p3 "_none" p1)
      )
      (setvar 'CMDECHO c)
    )
  )
  (princ)
)

[m.lharidon]

Thank you 🙂