sloped lines at end and start of cross section

Hello friends

i have 2 polylines represent cross section one for project line second for ground line i want to draw sloped lines with a predefined slope from first line to second line as in attached drawing

thanks for any help

intersect.dwg

this is my try for left side slope only the problem why can't extend the line if the 2dpolyline to be extended to is top of line but if it is down the extended suucced

the code

(defun c:edsl (/ );xs s1name s2name pon2pl strs1 intersec-pst
 (vl-load-com)
 (setq xs(getreal"\n enter horizental distance(1/?)slop"))
 (while
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun PLREV2 ( / e112 p112 p1112)
 (if
   (and
     (setq s-project (entsel"\select project line near left line<must 2dpolyline>... "))
     
     (wcmatch (cdr (assoc 0 (entget (setq e112 (car s-project))))) "*POLYLINE")
     )
   (progn
     (setq p112 (vlax-curve-getParamAtPoint e112 (vlax-curve-getClosestPointTo e112 (trans (cadr s-project) 1 0)))
                                      ; or (trans (osnap (cadr s) "_nea") 1 0) - for any view and UCS
           p1112 (vlax-curve-getEndParam e112)
           )
     (if (> p112 (/ p1112 2.0))
       (vl-cmdf "_PEDIT" e112 "_R" "") ;will convert 2dPolyline to LWpolyline
       )
     )
   )
 (princ)
 )
 (plrev2)
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
(setq s1name(car s-project))
(setq s2name(car(entsel"\n pick second line ground line<2dpolyline>")))

(setq s1obj(vlax-ename->vla-object s1name))
(setq s2obj(vlax-ename->vla-object s2name))
(setq ends1 (vlax-curve-getpointatparam s1name (vlax-curve-getendparam s1name)))     
(setq strs1 (vlax-curve-getpointatdist s1name 0))
(setq pon2pl(vlax-curve-getClosestPointToProjection s2obj strs1 '(0 1 0)))

   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   
(if(and(>(car ends1)(car strs1))(<(cadr strs1)(cadr pon2pl)))
 (progn
   (setq pon(polar strs1 (* 0.5 pi) 1))
   (setq p2s(polar pon pi xs))
   (command"line" "none"strs1"none"p2s"")
   (setq linename2(entlast))
   (setq lineobj2(vlax-ename->vla-object linename2))
   (setq nerstp(vlax-curve-getClosestPointTo lineobj2 pon))
   (command"extend"s2name""linenam2 "")  
   )
 )
(if(and(>(car ends1)(car strs1))(>(cadr strs1)(cadr pon2pl)))
 (progn
   (setq p1s(polar(polar strs1(*(* -1 0.5) pi)1)pi xs))
   
   (command"line" "none"strs1 "none"p1s"")
   (setq linename(entlast))
   (setq lineobj(vlax-ename->vla-object linename))
   (command"extend" s2name""linename"")
   )
 )
)
 )

My approach pick end pt, pick a point on green line roughly where it should meet, draw a line dummy 1 unit long at correct grade, use intersectwith, erase line redraw to correct point PE add new line. what do you think ?

thank you BIGAL for reply

i think using intersectwith will not succeed if the created line intersect with more than one point on green line

I Posted twice

Intesectwith object1 object2 so only 1 point is returned wether its a pline or line or arc etc. You just need a dummy line as object2 which uses the point pick to say go right or left at correct slope. You can change the extend parameter there are 4 variables available. In the dwg supplied there would only ever be 1 answer.

 ; an example
(setq p4 (getpoint p3 "pick back of kerb"))
(setvar 'osmode 512) ; nearest
(setq obj (vlax-ename->vla-object (ssname (ssget p4) 0))) ; pick arc pline line 
(command "line" p1 p5 "")
(setq obj1 (vlax-ename->vla-object (entlast)))
(setq p5 (vlax-invoke obj1 'intersectWith obj acExtendThisEntity))

Mr BIGAL how you will get p1 p3 p5

motee-z

Try this, using intersections of a ray and your existing poly.

;;                                                                            ;
;; Return list of intersection(s) between two objects                         ;
;; obj1 - first VLA-Object                                                    ;
;; obj2 - second VLA-Object                                                   ;
;; mode - intersection mode (acExtendNone acExtendThisEntity                  ;
;;                                acExtendOtherEntity acExtendBoth)           ;
;; Requires triplet                                                           ;
;;                                                                            ;
    
(defun Intersections (obj1 obj2)
  (triplet (vlax-invoke obj1 'intersectwith obj2 acExtendNone))           
)


;;                                                                            ;
;; triplet, Separates a list into triplets of items.                          ;
;;                                                                            ;

(defun triplet (l)
  (if l (cons (list (car l) (cadr l) (caddr l))(triplet (cdddr l))))
)


;;                                                                            ;
;; listpol     by ymg    (Simplified a Routine by Gile Chanteau               ;
;;                                                                            ;
;; Parameter:  en,  Entity Name or Object Name of Any Type of Polyline        ;
;;                                                                            ;
;; Returns:    List of Points in Current UCS                                  ;
;;                                                                             
;; Notes:      On Closed Polyline the Last Vertex is Same as First)           ;
;;                                                                            ;


(defun listpol (en / i l)
  (repeat (setq i (fix (1+ (vlax-curve-getEndParam en))))
     (setq l (cons (trans (vlax-curve-getPointAtParam en (setq i (1- i))) 0 1) l))
  )
)

;;                                                                            ;
;; mk_lwp    by Alan J Thompson                                               ;
;;                                                                            ;
;; Argument: pl, A list of points (2d or 3d)                                  ;
;; Create an LWPolyline at Elevation 0, on Current Layer.                     ;
;; Return: Polyline Object                                                    ;
;;                                                                            ;

(defun mk_lwp (pl)
  (vlax-ename->vla-object
     (entmakex
        (append (list '(0 . "LWPOLYLINE")
                      '(100 . "AcDbEntity")
                      '(100 . "AcDbPolyline")
                       (cons 90 (length pl))
                      '(70 . 0)
                )
                (mapcar '(lambda (p) (cons 10 (trans (list (car p) (cadr p)) 1 0))) pl)
        )
     )
  )
)

;;                                                                            ;
;; mk_ray    by ymg                                                           ;
;;                                                                            ;
;; Argument: p,  A point                                                      ;
;;           h, Horizontal distance                                           ;
;;           v, Vertical distance   defining a slope                          ;
;;                                                                            ;
;; Create a  Ray on current layer                                             ;
;; Returns : Ray Object                                                       ;
;;                                                                            ;

(defun mk_ray (p h v / m)
  (setq m (sqrt (+ (* h h) (* v v))))
  (vlax-ename->vla-object
     (entmakex
        (list '(0 . "RAY")
              '(100 . "AcDbEntity")
              '(100 . "AcDbRay")
               (cons 10 p)
               (cons 11 (list (/ h m) (/ v m) 0.0))
        )
     )
  )
)
;;-----------------------------------------------------------------------------------------

(defun c:test (/ proj projl objp exis obje p pin1 pin2)
   (setq xs (getreal"\nEnter horizontal distance(1/?) slope: "))
   (if (and (setq proj (car (entsel "\nSelect Projected Polyline: ")))
     (setq exis (car (entsel "\nSelect Existing Polyline: ")))
)
       (progn
    (setq  obje (vlax-ename->vla-object exis)
          projl (vl-sort (setq projl (listpol proj)) '(lambda (a b) (< (car a) (car b))))
	      p (car projl)
	   objp (mk_ray p (- xs) 1.0)
	   pin1 (intersections objp obje)
    )
    (vla-delete objp)
    (if (not pin1)
       (setq objp (mk_ray p (- xs) -1.0)
	     pin1 (intersections objp obje)
	       ** (vla-delete objp)
       )
    )
    (setq    p (last projl)		  
	  objp (mk_ray p  xs 1.0)
	  pin2 (intersections objp obje)
    )
    (vla-delete objp)
    (if (not pin2)
       (setq objp (mk_ray p  xs -1.0)
	     pin2 (intersections objp obje)
	       ** (vla-delete objp)
       )
       
    )
    
    (mk_lwp (append (cons (car pin1) projl) pin2))
)
   )
)  

ymg

High level routine ymg

thank you very much

one notice please the original polyline white one not deleted

can you revise it

motee-z,

It is not deleted, it is underneath the one we create at end of program.

If you want line entmake it from (car projl) to pin1 and (last projl) to pin2

I believe you can modify it yourself.

ymg

okay thank you ymg for your kindness