polyline sectioning

[bsimpson]

Hi,

I am in need of a lisp file that will draw a vertical line from two points on two different polylines where the vertical distance of the points along the polylines is 300.

The application for the polylines are a ground line and a grade line in road desgin.

Thanks.

[LElkins]

bsimpson,

Do you still need this?
If you do, could you please explain in a bit more depth what you want. I should have a few things that could help.

Cheers

[fixo]

Give this a try

(defun C:VLN (/	     acsp   adoc   cnt	  coors1 coors2	dis    en1
	      en2    ln	    num	   p1	  p2	 pl1	pl2    sortpts1
	      sortpts2	    ss1	   ss2	  step	 tmp1	tmp2
	     )
  
  (setq clr (getvar "clayer"))
  (setvar "clayer" "0"); change layer here
  (setq ccl (getvar "cecolor"))
  (setvar "cecolor" "1");change color here
  (or (vl-load-com))
  (or adoc
      (setq adoc (vla-get-activedocument
		   (vlax-get-acad-object)
		 )
      )
  )
  (or acsp
      (setq acsp (if (= (getvar "TILEMODE") 0)
		   (vla-get-paperspace
		     adoc
		   )
		   (vla-get-modelspace
		     adoc
		   )
		 )
      )
  )
  (alert (strcat "Select first the lower polyline\nthen select the upper polyline"))
  (if (and (setq ss1 (ssget ":S" '((0 . "LWPOLYLINE"))))
	   (setq ss2 (ssget ":S" '((0 . "LWPOLYLINE"))))
      )
    (progn
      (setq en1	(ssname ss1 0)
	    en2	(ssname ss2 0)
	    pl1	(vlax-ename->vla-object en1)
	    pl2	(vlax-ename->vla-object en2)
      )
      (setq coors1 (vl-remove-if
		     (function not)
		     (mapcar (function (lambda (x)
					 (if (= 10 (car x))
					   (cdr x)
					 )
				       )
			     )
			     (entget en1)
		     )
		   )
	    coors2 (vl-remove-if
		     (function not)
		     (mapcar (function (lambda (x)
					 (if (= 10 (car x))
					   (cdr x)
					 )
				       )
			     )
			     (entget en2)
		     )
		   )
      )
      (setq sortpts1 (vl-sort coors1
			      (function (lambda (a b) (< (car a) (car b))))
		     )
	    sortpts2 (vl-sort coors2
			      (function (lambda (a b) (< (car a) (car b))))
		     )
      )
      (setq dis	(abs (- (caar sortpts1) (car (last sortpts1))))
      )
      (setq step 300.
	    num	 (fix (/ dis step))
	    cnt	 0
      )
      (repeat (1+ num)
	(setq p1 (list (+ (caar sortpts1) (* cnt step)) 0 0)
	      p2 (mapcar '+ p1 (list 0 1 0))
	      p1 (trans p1 1 0)
	      p2 (trans p2 1 0)
	)
	(if (and
	(setq ln (vlax-invoke acsp 'AddLine p1 p2))
	(setq tmp1 (vlax-invoke ln 'IntersectWith pl1 1)
	      tmp2 (vlax-invoke ln 'IntersectWith pl2 1)
	)
	)
	(progn
	(vlax-put ln 'StartPoint tmp1)
	(vlax-put ln 'EndPoint tmp2)
	(vlax-put ln 'Layer "0")
	(setq cnt (1+ cnt)))
	  )
      )
    )
  )
  (setvar "clayer" clr)
  (setvar "cecolor" ccl)
  (princ)
)
(princ "\n\t\t***\tStart command with VLN\t***")
(princ)

~'J'~