copym along polyline?

I've searched for this previously, but haven't been able to find exactly what I'm looking for. I'd like to be able to copy a block along a polyline so the results are as shown:

Horizontally, the block should be inserted every unit width (1.5) along the polyline until it's forced to step with the polyline. When it's forced to step, it steps horizontally by half the block width (0.75). Vertically, the block should one block unit (1.33) as it follows the polyline.

Currently, I'm taking my "running bond pattern" and using the copym command to cover the extents of the polyline. Then I'm using the fastsel command to select all the blocks that touch the poyline. The issue is that it doesn't quite work all the time, nor can I perform both operations using one command.

Thanks for any help!

This is not exactly as you wanted, but result is approximately the same...

(vl-load-com)
(defun c:copysquarealongpline ( / osm a +a -a ss pl stpt enpt loop ptint d )
 (setq osm (getvar 'osmode))
 (setvar 'osmode 0)
 (setq a (getdist "\nDimension of edge of square : "))
 (setq +a a)
 (setq -a (- a))
 (while (not ss)
   (prompt "\nSelect 2d polyline witch vertices are oriented from left to right to perform copym of square along it")
   (setq ss (ssget ":L" '((0 . "*POLYLINE"))))
 )
 (setq pl (ssname ss 0))
 (setq stpt (vlax-curve-getstartpoint pl))
 (setq enpt (vlax-curve-getendpoint pl))
 (if (> (cadr stpt) (cadr enpt))
   (progn
     (setq loop T)
     (while loop
       (setq ptint (vlax-curve-getclosestpointtoprojection pl (list (car stpt) (+ (cadr stpt) a) (caddr stpt)) '(1.0 0.0 0.0)))
       (setq d (- (car ptint) (car stpt)))
       (if (not (eq a -a))
         (vl-cmdf "_.rectangle" stpt "d" +a +a (list (+ (car stpt) 1.0) (+ (cadr stpt) 1.0) (caddr stpt)))
         (vl-cmdf "_.rectangle" stpt "d" +a +a (list (+ (car stpt) 1.0) (- (cadr stpt) 1.0) (caddr stpt)))
       )
       (if ptint
         (repeat (fix (/ d +a))
           (vl-cmdf "_.copy" (entlast) "" '(0.0 0.0 0.0) (list +a 0.0 0.0) "")
         )
       )
       (if (eq a +a)
         (if (eq (cadr ptint) (+ (cadr stpt) a)) 
           (setq stpt ptint) 
           (progn
             (vl-cmdf "_.pedit" pl "r" "")
             (setq ptint nil a 0.0)
           )
         )
       )
       (if (eq a 0.0)
         (if (eq (cadr ptint) (cadr stpt))
           (setq stpt ptint a -a)
         ) 
       )
       (if (and (not (equal stpt ptint 1e-) (eq a -a))
         (progn
           (if (equal ptint enpt 1e-
             (progn 
               (setq d (- (car enpt) (car stpt)))
               (setq loop nil)
             )
           )
           (if (eq (cadr ptint) (+ (cadr stpt) a))
             (setq stpt ptint)
           )
         )
       )
     )
     (vl-cmdf "_.pedit" pl "r" "")
   )
   (progn
     (vl-cmdf "_.pedit" pl "r" "")
     (setq stpt (vlax-curve-getstartpoint pl))
     (setq enpt (vlax-curve-getendpoint pl))
     (setq loop T)
     (while loop
       (setq ptint (vlax-curve-getclosestpointtoprojection pl (list (car stpt) (+ (cadr stpt) a) (caddr stpt)) '(1.0 0.0 0.0)))
       (setq d (- (- (car ptint) (car stpt))))
       (if (not (eq a -a))
         (vl-cmdf "_.rectangle" stpt "d" +a +a (list (- (car stpt) 1.0) (+ (cadr stpt) 1.0) (caddr stpt)))
         (vl-cmdf "_.rectangle" stpt "d" +a +a (list (- (car stpt) 1.0) (- (cadr stpt) 1.0) (caddr stpt)))
       )
       (if ptint
         (repeat (fix (/ d +a))
           (vl-cmdf "_.copy" (entlast) "" '(0.0 0.0 0.0) (list -a 0.0 0.0) "")
         )
       )
       (if (eq a +a)
         (if (eq (cadr ptint) (+ (cadr stpt) a)) 
           (setq stpt ptint) 
           (progn
             (vl-cmdf "_.pedit" pl "r" "")
             (setq ptint nil a 0.0)
           )
         )
       )
       (if (eq a 0.0)
         (if (eq (cadr ptint) (cadr stpt))
           (setq stpt ptint a -a)
         ) 
       )
       (if (and (not (equal stpt ptint 1e-) (eq a -a))
         (progn
           (if (equal ptint enpt 1e-
             (progn 
               (setq d (- (car enpt) (car stpt)))
               (setq loop nil)
             )
           )
           (if (eq (cadr ptint) (+ (cadr stpt) a))
             (setq stpt ptint)
           )
         )
       )
     )
   )
 )
 (setvar 'osmode osm)
 (princ)
)
(defun c:csapl nil (c:copysquarealongpline))
(prompt "\nShortcut to c:copysquarealongpline is c:csapl")
(princ)

Regards, M.R.

P.S. Polyline must have 1 single top... If polyline has bottom, then mirror pline along X axis, perform routine, and mirror back result along X axis... Also notice that pline segments must rise to reach the top and after that segments must fall constantly till the end... Only 1 rising and 1 falling of segments are allowed, but angles between segments may vary...

This is not exactly as you wanted, but result is approximately the same...

 

Regards, M.R.

P.S. Polyline must have 1 single top... If polyline has bottom, then mirror pline along X axis, perform routine, and mirror back result along X axis... Also notice that pline segments must rise to reach the top and after that segments must fall constantly till the end... Only 1 rising and 1 falling of segments are allowed, but angles between segments may vary...

Thanks, M.R. There were a few items that I did not know how to do in LISP and I believe you address those in your code. I'll try to implement my algorithm and see where I get.

I figured I would reply here as this is relevant to my original goal for the routine.

I'm using this routine to obtain the vertices for the selected polyline (from AfraLISP):

(defun c:coord (/ e len n e1)

(setq e (entget (car (entsel))))
;get the entity list

(setq len (length e))
;get the length of the list

(setq n 0)
;set counter to zero

(repeat len
;repeat for the length of the entity list

  (setq e1 (car (nth n e)))
  ;get each item in the entity list
  ;and strip the entity code number

  (if (= e1 10)
  ;check for code 10 (vertex)

    (progn
    ;if it's group 10 do the following

	(terpri)
	  ;new line

                 (setq pt (cdr (nth n e))) ;; my code starts here
          (cdr (reverse (setq lst (list pt lst))))
          (reverse (cdr lst)) ;; my code ends here


    );progn

  );if
  (setq n (1+ n))
  ;increment the counter

);repeat

 (princ)
);defun
(princ)

What I need instead of the vertices being printed is a list. I have where I inserted what I thought would work, but it's placing a list inside of a list... Can anybody help me out here? Thanks.

Hi rjohnson42,

Below are five examples demonstrating how to retrieve a list of vertices from an LWPolyline entity.

Each of the following functions requires a single argument: an LWPolyline entity, and will return a list of vertices (expressed in OCS) for the supplied LWPolyline.

A test function is included below for testing.

([color=BLUE]defun[/color] LM:LW-Vertices ( ent [color=BLUE]/[/color] _lwvertices )
   ([color=BLUE]defun[/color] _lwvertices ( en [color=BLUE]/[/color] pair )
       ([color=BLUE]if[/color] ([color=BLUE]setq[/color] pair ([color=BLUE]assoc[/color] 10 en))
           ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] pair) (_lwvertices ([color=BLUE]cdr[/color] ([color=BLUE]member[/color] pair en))))
       )
   )
   (_lwvertices ([color=BLUE]entget[/color] ent))
)

([color=BLUE]defun[/color] LM:LW-Vertices ( ent )
   ([color=BLUE]apply[/color] '[color=BLUE]append[/color] ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]if[/color] ([color=BLUE]=[/color] 10 ([color=BLUE]car[/color] x)) ([color=BLUE]list[/color] ([color=BLUE]cdr[/color] x)))) ([color=BLUE]entget[/color] ent)))
)

([color=BLUE]defun[/color] LM:LW-Vertices ( ent [color=BLUE]/[/color] lst )
   ([color=BLUE]foreach[/color] pair ([color=BLUE]entget[/color] ent)
       ([color=BLUE]if[/color] ([color=BLUE]=[/color] 10 ([color=BLUE]car[/color] pair))
           ([color=BLUE]setq[/color] lst ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] pair) lst))
       )
   )
   ([color=BLUE]reverse[/color] lst)
)

([color=BLUE]defun[/color] LM:LW-Vertices ( ent [color=BLUE]/[/color] _group2 )
   ([color=BLUE]defun[/color] _group2 ( lst )
       ([color=BLUE]if[/color] lst
           ([color=BLUE]cons[/color] ([color=BLUE]list[/color] ([color=BLUE]car[/color] lst) ([color=BLUE]cadr[/color] lst)) (_group2 ([color=BLUE]cddr[/color] lst)))
       )
   )
   (_group2 ([color=BLUE]vlax-get[/color] ([color=BLUE]vlax-ename->vla-object[/color] ent) 'coordinates))
)

([color=BLUE]defun[/color] LM:LW-Vertices ( ent )
   ([color=BLUE]mapcar[/color] '[color=BLUE]cdr[/color] ([color=BLUE]vl-remove-if-not[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]=[/color] 10 ([color=BLUE]car[/color] x))) ([color=BLUE]entget[/color] ent)))
)

Here is a test function showing how to call any of the above functions:

([color=BLUE]defun[/color] c:test ( [color=BLUE]/[/color] e )
   ([color=BLUE]if[/color]
       ([color=BLUE]and[/color]
           ([color=BLUE]setq[/color] e ([color=BLUE]car[/color] ([color=BLUE]entsel[/color] [color=MAROON]"\nSelect LWPolyline: "[/color])))
           ([color=BLUE]eq[/color] [color=MAROON]"LWPOLYLINE"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ([color=BLUE]entget[/color] e))))
       )
       (LM:LW-Vertices e)
   )
)

Thanks, Lee. I think I know what I was doing wrong now - my syntax for my list was off.