Path Array Lisp Routine

[jeff_Moskovciak]

Hi, I'm having trouble with my lisp routine that is supposed to copy an object 6' from the end of a polyline, array that same object every 12' from that end, and offset a second object 6' from the other end of the polyline. Here is the routine and an example of what is happening:

(defun c:op (/ obj obj2 polyline p1 p2)

  ;; Prompt user for object to copy with base point

  (setq obj (car (entsel "\nSelect first outlet to copy: ")))

  (setq obj2 (car (entsel "\nSelect last outlet to copy: ")))

  (setq polyline (car (entsel "\nSelect a polyline: ")))

  ;(setq p1 (vlax-curve-getstartpoint polyline)

  ;       p2 (vlax-curve-getendpoint polyline)

  😉

  (if (and polyline (eq (cdr (assoc 0 (entget polyline))) "LWPOLYLINE"))

    (progn

      ;Copies first outlet 6' from end of polyline

      (initcommandversion)

      (command "_.arraypath" obj "" polyline  "m" "m" "as" "n" "a" "y" "i" "e" "6'" "e" "2" "x")

      ;Copies first outlet every 12' from end of polyline

      (initcommandversion)

      (command "_.arraypath" obj "" polyline  "m" "m" "as" "n" "a" "y" "i" "e" "12'" "f" "x")

      ;Copies second outlet 6' from other end of polyline

      (initcommandversion)

      (command "_.arraypath" obj2 "" polyline  "m" "m" "as" "n" "a" "y" "i" "e" "6'" "e" "2" "x")

      ;Erases first outlet

      (command "_.erase" obj "")

      ;Erases second oulet

      (command "_.erase" obj2 "")

      ;Erases polyline

      (command "_.erase" polyline "")

      (princ "\nOutlets have been placed. Adjust as needed per code and convenience")

    )

    (princ "\nSelected entity is not a valid polyline.")

  )

  (princ)

  (vl-load-com)

)

This is the starting point:

The magenta block arrays correctly, but the green one doesn't:

Thank you. 

[Sea-Haven]

I would redo the code and not use array path but rather the  VL "getpointatdist" which works out a point say along a pline at a given distance, its pretty easy if you have straight segments to work the 2 points per each segment.

Ok you can code which direction a pline runs in by picking it near the end, you swap the co-ords of the vertices if needed. 

This will give you the vertices as points just use in pairs.

(setq plent (entsel "\nPick pline"))
(if plent (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent))))))

Just use (repeat (- (length co-ord) 1) to loop through each segment.

Not sure if 1st image is correct, top right block, post a before and after dwg

[jeff_Moskovciak]

Thank you for this suggestion. The complexity is that I need the block to rotate along the pline and it will almost always be a pline with multiple vertices. This is why I went with the path array since it rotates the object automatically. 

[Sea-Haven]

I did not on purpose add the comment about using vlax-curve-getparamatpoint which amongst other things can return a angle of the pline at that point then would insert block plus 90 etc. 

So again post a dwg before & after. Need to check the spacings you want, indicate those on the "after".

For your info. 

(defun alg-ang (obj pnt)
  (angle '(0. 0. 0.)
     (vlax-curve-getfirstderiv
       obj
       (vlax-curve-getparamatpoint
         obj
         pnt
       )
     )
  )
)

The angle of the plines does not matter.

[jeff_Moskovciak]

So the spacing I would need is 6' from either end of the pline and then every 12' from the copied object. I can't post DWG files per my company's policy. 

[Kent1Cooper · Accepted solution]

My DIV+ command defined in DivideMeasurePlus.lsp, >here<, can give you the end ones inset from the ends of the path by your desired distance [6' in your description].  When it asks how many segments, you can ask for 1 [regular DIVIDE won't accept that].

For the rest, you [or perhaps a routine] could make a temporary copy of the path, shorten it by your 6' inset distance from the ends [e.g. with LENGTHEN's Delta option at -6'], and use MEASURE [or MEA+ also defined in the same file] to place Blocks at 12' spacings from there.

All have the option to align Block rotations with the path, but DIV+ [and also MEA+ in place of regular MEASURE, if you need this] have the option to use a Relative rotation.  So if MEASURE with the Align option aims them in some direction you don't want, DIV+ and MEA+ can let you turn them the right way without needing to redefine the Block.

[jeff_Moskovciak]

This is great, thanks so much!

[Moshe-A]

@jeff_Moskovciak  hi,

Check this DVOL command, prompt follow

Command: DVOL
Pick your outlet
Select objects: 1 found

Select objects:
Pick polyline:

You start by selecting you outlet (it could be a block or free some objects) position at it start point, than pick the polyline close to starting working point (as required by DIVIDE\MEASURE commands)

if the polyline length does not exactly divide by 12', what do you expect happen?

enjoy

Moshe

;;; dvol.lsp
;;; divide outlet

(vl-load-com)

(defun c:dvol (/ geometric ; local function
	         ss0 ss1 pick ename startCurve endCurve picked_pt points^ vert)

 (defun geometric (ent / curveLen lst cumulativeDist pt pr t0 t1 lst dir)
  (setq startCurve (vlax-curve-getStartPoint  ent))
  (setq endCurve   (vlax-curve-getEndPoint    ent))
  (setq curveLen   (vlax-curve-getDistAtPoint ent endCurve))
   
  (setq cumulativeDist 6.0) ; start cumulative distance

  (setq t1 (vlax-curve-getPointAtParam ent 1.0))
  (setq dir (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv ent 0)))
  (setq lst (cons (cons dir (list startCurve)) lst))
   
  (while (<= cumulativeDist (- curveLen 6.0))
   (setq pt (vlax-curve-getPointAtDist ent cumulativeDist))
   (setq pr (fix (vlax-curve-getParamAtPoint ent pt)))
   (setq dir (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv ent pr)))
   (setq lst (cons (cons dir (list pt)) lst))
   (setq cumulativeDist (+ cumulativeDist 12.0))
  ); while

  (setq pr (fix (vlax-curve-getParamAtPoint ent endCurve)))
  (setq t0 (vlax-curve-getPointAtParam ent (1- pr)))
  (setq dir (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv ent pr)))
   
  (cons (cons dir (list endCurve)) lst) ; return
 ); geometric
 

 ; here start c:dvol
 (setvar "cmdecho" 0)
 (command "._undo" "_begin")
  
 (if (and
       (not (prompt "\nPick your outlet"))
       (setq ss0 (ssget)) ; select any objects
       (setq pick (entsel "\nPick polyline: "))
       (setq ename (car pick))
       (wcmatch (cdr (assoc '0 (entget ename))) "POLYLINE,LWPOLYLINE")
     )
  (progn
   (setq startCurve (vlax-curve-getStartPoint ename))
   (setq endCurve   (vlax-curve-getEndPoint   ename))
   (setq picked_pt  (vlax-curve-getClosestPointTo ename (cadr pick)))
   ; set working start point
   (if (> (distance startCurve picked_pt) (distance endCurve picked_pt))
    (command "._pedit" ename "_Reverse" "")
   ); if

   (setq points^ (reverse (geometric ename)))

   (foreach vert (cdr points^)
    (setq ename (entlast))
    (command "._copy" "_si" ss0 (cadar points^) (cadr vert))
    (setq ss1 (ssadd))
    (while (setq ename (entnext ename)) (ssadd ename ss1))
    (command "._rotate" "_si" ss1 (cadr vert) (angtos (- (car vert) (caar points^)) 0 4))
    (setq ss1 nil) ; clear ss1
   ); foreach
  ); progn
 ); if

 (command "._undo" "_end")
 (setvar "cmdecho" 1)
  
 (princ)
); c:dvol

[jeff_Moskovciak]

Thank you for this as well!