Topic: COPY MULTIPLE BLOCKS AND PLACE ON LINE (BY ORDER SELECTED)

[Verticalmojo#2]

Hello Swampers!!

Its been awhile since I posted here!

I'm trying to find a lisp routine that does the following.

1. select blocks
2. copy blocks
3. places blocks on a line (in order selected) * it would be nice if it places the block to its original form

Attached is a visual of what I am trying to do....

Ive been searching everywhere and I cant seem to find this simple routine... Can you guys help? I figured if its out there you guys would know where to find it if its not already here. Thanks in advance!

~Mario

[alanjt]

Search "CopyAlongCurve" and "SpaceAlongCurve" for several good examples.

Would you be copying selected blocks a specified distance or dividing them evenly along the selected curve?

[Verticalmojo#2]

separated 4' from base-point to base point...

Thanks for the info, I'm searching right now...

[Verticalmojo#2]

I have searched with the mentioned keywords but still not having any luck.

Anymore suggestions would greatly be appreciated.

[ronjonp]

This does not copy to a line but will place them in a row 48" apart.

Code: [Select]

;;Allows individual pick of blocks
(defun c:cb2 (/ b co p ss)
  (vl-load-com)
  (if (setq p (getpoint "\nPick a point to place block: "))
    (while (setq ss (ssget ":L:S" '((0 . "insert"))))
      (setq b (vlax-ename->vla-object (ssname ss 0)))
      (setq co (vlax-invoke b 'copy))
      (vlax-invoke co 'move (vlax-get co 'insertionpoint) p)
      (setq p (list (+ 48. (car p)) (cadr p) (caddr p)))
    )
  )
  (princ)
)

;;Pick multiple blocks at once
(defun c:cb (/ ss2lst e co p ss)
  (vl-load-com)
  (defun ss2lst (ss / e n out)
    (setq n -1)
    (if ss
      (while (setq e (ssname ss (setq n (1+ n)))) (setq out (cons (vlax-ename->vla-object e) out)))
    )
  )
  (if (and (setq ss (ss2lst (ssget ":L" '((0 . "insert")))))
   (setq p (getpoint "\nPick a point to place block: "))
      )
    (foreach b ss
      (setq co (vlax-invoke b 'copy))
      (vlax-invoke co 'move (vlax-get co 'insertionpoint) p)
      (setq p (list (+ 48. (car p)) (cadr p) (caddr p)))
    )
  )
  (princ)
)

[Verticalmojo#2]

This is what I get.....

------

Select objects: 1 found, 2 total

Select objects:

Pick a point to place block:
Invalid complex object.
Command:

------

[fixo]

Found in my old library

Code: [Select]

(defun C:DCP(/ *error* ang ccl clr clt dist step istep dym dyp i n-divide next-divide-pt osm pag pal pmd pt1 pt2 ss stp)
 
  (defun *error*  (msg)   ; create standard error handler
          (command "._undo" "_end")
      (command)
      (cond ((not msg))   ; normal exit, no error
    ((member msg '("Function cancelled" "quit / exit abort"))) ; escape
    ((princ (strcat "\nError: " msg))   ; display fatal error
     (cond (*debug* (vl-bt)))))   ; if in debug mode, dump backtrace

      (setvar 'cmdecho 1)                        ; restore environments
(if osm
  (setvar 'osmode osm)
)
(if clr
  (setvar 'clayer clr)
)
(if ccl
  (setvar 'cecolor ccl)
)
(if clt
  (setvar 'celtype clt)
)

(if pal
  (setvar 'polarang pal)
)
(if pag
  (setvar 'polaraddang pag)
)
(if stp
  (setvar 'snaptype stp)
)
(if pmd
  (setvar 'polarmode pmd)
)

(if dym
  (setvar 'dynmode dym)
)
(if dyp
  (setvar 'dynprompt dyp)
)

(princ)
      )

  (command "._undo" "_begin")
   
  (setvar 'cmdecho 0)
 
  (setq dym (getvar 'dynmode))
  (setvar 'dynmode 3)
   (setq dyp (getvar 'dynprompt))
   (setvar 'dynprompt 1)


   (setq clr (getvar 'clayer))
  (setvar 'clayer "0")
   (setq ccl (getvar 'cecolor))
  (setvar 'cecolor "BYLAYER")
   (setq clt (getvar 'celtype))
  (setvar 'celtype "BYLAYER")
   (setq osm (getvar 'osmode))
   (setvar 'osmode 0)
   
   
  (setq pal (getvar 'polarang))
  (setvar 'polarang 45.0)
  (setq pag (getvar 'polaraddang))
  (setvar 'polaraddang "0;45;90;135;180;225;270;315")
  (setq stp (getvar 'snaptype))
  (setvar 'snaptype 1)
  (setq pmd (getvar "polarmode"))
  (setvar 'polarmode 6)

  (command "._ucs" "_w")

 
  (setq ss (ssadd))
(setq ss (ssget))
   (setq orig (getpoint "\nSpecify base point: "))
 
  (setq pt1 (getpoint "\nStart point: "))
 
  (setq pt2 (getpoint pt1 "\nEnd point: "))
 
  (setq dist (distance pt1 pt2))
 
  (setq ang (angle pt1 pt2))
 
  (setq num (getint "\nNumber of copies: "))
 
  (setq step (/ dist (1+ num)))
 
  (setq istep step)
 
  (setq  i 1)
 
  (while (<= i num)
   
    (setq inspt (polar pt1 ang istep))
   
  (command "._copybase" orig ss "")

  (command "._pasteclip" inspt)
   
    (setq istep (+ istep step))
   
    (setq i (1+ i))
  )
 
    (*error* nil)
 
      (princ)

      )
~'J'~

[Lee Mac]

Another, quickly written:

Code - Auto/Visual Lisp: [Select]

1. ;; Copy Blocks to Curve  -  Lee Mac  -  2012  -  www.lee-mac.com
2. ;;
3. ;; Prompts for a Curve Object to which blocks are to be copied and
4. ;; a spacing for blocks along the curve, then continuously prompts
5. ;; for selection of a block and copies the block to align with the
6. ;; curve.
7. ;;
8. ;; Prompts will cease when either the user right-clicks / Enter, or
9. ;; the curve is not long enough to fit another block with the
10. ;; specified spacing.
11. ;;
12. ;; Blocks retain layer / linetype / lineweight etc properties, but
13. ;; are set to 1:1 scale and rotated to align with the curve.
14.  
15. (defun c:CopyBlocksToCurve
16.  
17.     (
18.         /
19.         *error*
20.         _SelectIf
21.         _IsCurveObject
22.         _MakeReadable
23.  
24.         blk dis ent len msg obj pt1 spc
25.     )
26.  
27.     (defun *error* ( msg )
28.         (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
29.             (princ (strcat "\nError: " msg))
30.         )
31.         (princ)
32.     )
33.    
34.     (defun _SelectIf ( msg pred )
35.         (
36.             (lambda ( f / e )
37.                 (while
38.                     (progn (setvar 'ERRNO 0) (setq e (car (entsel msg)))
39.                         (cond
40.                             (   (= 7 (getvar 'ERRNO))
41.                                 (princ "\nMissed, try again.")
42.                             )
43.                             (   (eq 'ENAME (type e))
44.                                 (if (and f (null (f e)))
45.                                     (princ "\nInvalid Object.")
46.                                 )
47.                             )
48.                         )
49.                     )
50.                 )
51.                 e
52.             )
53.             (eval pred)
54.         )
55.     )
56.  
57.     (defun _IsCurveObject ( ent )
58.         (null
59.             (vl-catch-all-error-p
60.                 (vl-catch-all-apply 'vlax-curve-getendparam (list ent))
61.             )
62.         )
63.     )
64.  
65.     (defun _MakeReadable ( a )
66.         (
67.             (lambda ( a )
68.                 (if (and (< (/ pi 2.0) a) (<= a (/ (* 3.0 pi) 2.0)))
69.                     (+ a pi)
70.                     a
71.                 )
72.             )
73.             (rem (+ a pi pi) (+ pi pi))
74.         )
75.     )
76.  
77.     (if
78.         (and
79.             (setq ent (_SelectIf "\nSelect Object to Align Blocks to: " '_IsCurveObject))
80.             (progn
81.                 (setq len (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)))
82.                 (while
83.                     (and
84.                         (setq spc (getdist (strcat "\nSpecify Block Spacing (less than " (rtos len 2 2) "): ")))
85.                         (< len spc)
86.                     )
87.                     (princ "\nSpacing is greater than Object Length!")
88.                 )
89.                 spc
90.             )
91.             (setq dis 0.0)
92.         )
93.         (while
94.             (and
95.                 (setq pt1 (vlax-curve-getpointatdist ent dis))
96.                 (princ
97.                     (strcat
98.                         "\n" (rtos len 2 2) " Length available for " (itoa (1+ (fix (/ len spc)))) " block(s)."
99.                     )
100.                 )
101.                 (setq blk
102.                     (_SelectIf "\nSelect Block <Exit>: "
103.                        '(lambda ( x ) (eq "INSERT" (cdr (assoc 0 (entget x)))))
104.                     )
105.                 )
106.             )
107.             (setq obj (vla-copy (vlax-ename->vla-object blk)))
108.             (vla-put-insertionpoint obj (vlax-3D-point pt1))
109.             (foreach prop
110.                '(
111.                     (XEffectiveScaleFactor XScaleFactor)
112.                     (YEffectiveScaleFactor YScaleFactor)
113.                     (ZEffectiveScaleFactor ZScaleFactor)
114.                 )
115.                 (vlax-put-property obj
116.                     (if (vlax-property-available-p obj (car prop) t)
117.                         (car  prop)
118.                         (cadr prop)
119.                     )
120.                     1.0
121.                 )
122.             )
123.             (vla-put-rotation obj
124.                 (_MakeReadable
125.                     (angle '(0.0 0.0 0.0)
126.                         (vlax-curve-getfirstderiv ent (vlax-curve-getparamatpoint ent pt1))
127.                     )
128.                 )
129.             )
130.             (setq dis (+ dis spc)
131.                   len (- len spc)
132.             )
133.         )
134.     )
135.     (princ)
136. )
137. (vl-load-com) (princ)

[ronjonp]

This is what I get.....

------

Select objects: 1 found, 2 total

Select objects:

Pick a point to place block:
Invalid complex object.
Command:

------

Updated the code above. Give it a try ... or use Lee's solution 

[ribarm]

Doesn't A2012 have array by path command???

As far as I know it is the main feature of A2012...

M.R.

[CAB]

My guess is that the OP is trying to select the blocks within the building and then
automatically paste them on that line you see on the bottom outside the building.
 Actually you could sort by the attribute with the 3V1-n string.

[Verticalmojo#2]

thanks for all  the responses!

 I think that ronjonp's updated routine is pretty darn close to what I'm looking for. Only thing is the blocks that are being copied have been mirrored and/or rotated so they don't align as nicely as I would like to have it. Would that be a easy add to the routine?

CAB - thats correct...

[Lee Mac]

Only thing is the blocks that are being copied have been mirrored and/or rotated so they don't align as nicely as I would like to have it. Would that be a easy add to the routine?

Mine should align to the curve and set the scale to 1.0, resetting any mirroring. 

[Verticalmojo#2]

Mine should align to the curve and set the scale to 1.0, resetting any mirroring. 

I had trouble getting it to work before you mentioned that, but I tried it again and it works great! Thanks!

[Lee Mac]

Mine should align to the curve and set the scale to 1.0, resetting any mirroring. 

I had trouble getting it to work before you mentioned that, but I tried it again and it works great! Thanks!

I see no problem with the code - glad you got it working