Perpendicular Distance between 2 lines every X meter

[svippala]

I have two lines (not parallel) let say 1km lenght each line.

I need to know the distance (Perpendicular) between those two lines every 5 meters, there is a lisp that can do it? 

 

output should be in table format in excel or text file.

 

 

Many thanks

[devitg]

For better understanding, and, maybe, get further help, please upload such sample.dwg
As far as I know, ACAD only can edit DWG.

 

perpendicular to center line? . distance step at center line ?

 

 

 

[hosneyalaa]

;;  ;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/how-to-calculate-road-widths-between-a-given-distance/td-p/9681443

 

 

(defun c:roadwidths (/ *error* ent1 ent2 i len pt p1 ptlst getintersections step f file1 co len dist pt1 pt2 pt3 lo )
; modified from Lee Macs solution to create centerline to two lwpolylines

 (vl-load-com)
 (defun *error* ()
 (setvar 'cmdecho 1)
 (close file1)
 (princ)
 )
 (defun getintersections ( obj1 obj2 / var )
    (setq var (vlax-variant-value (vla-intersectwith obj1 obj2 acExtendThisEntity)))
    (if (< 0 (vlax-safearray-get-u-bound var 1))
        (vlax-safearray->list var)
    )
)
(setq step (getreal "\n Step >"))
(setq f (getfiled "Output file name:" (getvar "dwgprefix") "csv" 3))
(setq file1 (open f "w"))

(setvar 'cmdecho 0)
 (if (and (setq ent1 (car (entsel "\nSelect First Polyline: ")))
          (wcmatch (cdr (assoc 0 (entget ent1))) "*POLYLINE"))
   (if (and (setq ent2 (car (entsel "\nSelect Second Polyline: ")))
            (wcmatch (cdr (assoc 0 (entget ent2))) "*POLYLINE"))
     (progn
       (setq i -1 len (/ (vla-get-Length
                           (vlax-ename->vla-object ent1)) 100.))
       (while (setq pt (vlax-curve-getPointatDist ent1 (* (setq i (1+ i)) len)))
         (setq p1 (vlax-curve-getClosestPointto ent2 pt t)
               ptlst (cons (polar pt (angle pt p1) (/ (distance pt p1) 2.)) ptlst)))
       (setq ptlst (apply 'append
                     (mapcar
                       (function
                         (lambda (x)
                           (list (car x) (cadr x)))) ptlst)))
       (vla-AddLightWeightPolyline
         (vla-get-ModelSpace
           (vla-get-ActiveDocument
             (vlax-get-acad-object)))
         (vlax-make-variant
           (vlax-safearray-fill
             (vlax-make-safearray
               vlax-VBDouble (cons 0 (1- (length ptlst)))) ptlst))))))
        (command "reverse" (entlast) "")
        (setq 
            co (vlax-ename->vla-object (entlast))
            len (vlax-get co 'Length)
            i 0
        )
        
        (while (<= (setq dist (* i step)) len)
            (setq 
                pt1 (vlax-curve-getPointAtDist co dist)
                pt2 (vlax-curve-getPointAtDist co (+ dist 0.01))
                pt3 (polar pt1 (+(angle pt1 pt2) (/ PI 2.0)) 0.5)
                lo (vla-addline (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point pt1)(vlax-3d-point pt3))
                pt1  (getintersections lo (vlax-ename->vla-object ent1))
                pt2  (getintersections lo (vlax-ename->vla-object ent2))
            )
            (vla-delete lo)
            (cond
                ((and pt1 pt2)            
                    (command "line" "none" pt1 "none" pt2 "")
                    (write-line (strcat (rtos dist 2 1) ";" (rtos (vlax-get (vlax-ename->vla-object (entlast)) 'Length ) 2 3)) file1)
                )
            )
            (setq i (+ i 1))
        )
 (close file1)    
 (setvar 'cmdecho 1)
 (princ)
)

 

Edited September 11, 2020 by hosneyalaa

[hosneyalaa]

HI 

This LISP is more accurate to operate

 

 

  

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;;                                                                         ;
   ;; Return angle along curve, at specified point (on curve)                 ;
   ;; e - valid curve (ENAME or VLA-OBJECT)                                   ;
   ;; p - point on curve                                                      ;
   ;; Alan J. Thompson, 11.04.10                                              ;
   ;;                                                                         ;

   (defun AngleAtPoint (e p)
      (angle '(0. 0. 0.) (vlax-curve-getFirstDeriv e (vlax-curve-getParamAtPoint e p)))
   )


    ;                                                                                                                                    ;  

   ;;                                                                         ;
   ;; in_range      by ElpanovEvgeniy       (recursive)                       ;
   ;;                                                                         ;
   ;; Similar to the Python Function                                          ;
   ;;                                                                         ;

   (defun in_range (s e i)
      (if (or (and (> i 0) (< s e)) (and (< i 0) (> s e)))
         (cons s (in_range (+ i s) e i))
      )
   )


   ;                                                                                                                                    ;

   
;https://www.cadtutor.net/forum/topic/52728-break-a-list-in-two-sub-lists/
;https://www.cadtutor.net/forum/topic/57990-split-list/
(defun split (lst len opt / ls l i) ; opt, T= by division or nil=by length
(setq i 1 l '() len (if opt (/ (length lst) len) len))
 (while lst
   (setq l (append  l (list(car lst))))
   (if
   (zerop (rem i len))
(setq ls (cons l ls) l nil)
   ) 
   (setq i (1+ i) lst (cdr lst))
 ) ;_ end of foreach
 (if l
   (append (reverse ls) (list  l))
   (reverse ls)
 ) ;_ end of if
) ;_ end of defun
 


 

;;; https://www.cadtutor.net/forum/topic/52728-break-a-list-in-two-sub-lists/
(defun div ( d l / m r )
   (foreach x l
       (if (= x d)
           (if   m (setq r (cons (reverse m) r) m nil))
           (setq m (cons x m))
       )
   )
   (reverse (if m (cons (reverse m) r) r))
)

  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun c:testCRTPOIT ( / ANG DLST DTOT EN ENOFL ENOFR ENT ENTL
		      ENTR EXTR F FILE1 INTV IP LLN OBJLL OUTL
		      OUTR PPL PPR PTLSTALL PTLSTL PTLSTR PT_C
		      FILE FILE1 PT_C X PT_L PT_R X)
  ;hanhphuc 28.10.2019   https://www.cadtutor.net/forum/topic/68979-export-cad-text-table-in-excel-get-error/


 
  (vl-load-com)
(setvar "CMDECHO" 0)
(command "-osnap" "off")

(defun *error* ()
 (setvar 'cmdecho 1)
 (close file1)
 (princ)
 )

   (if (and
	 
  (setq en   (car (entsel "\nSelect the CENTER *POLYLINE "))
	     
	enOFR (car (entsel "\nSelect the RIGHT *POLYLINE "))
	      
        enOFL (car (entsel "\nSelect the LEFT *POLYLINE "))
	      
        	   entR (vlax-ename->vla-object enOFR) 
                   entL (vlax-ename->vla-object enOFL))
  (wcmatch (cdr (assoc 0 (entget en))) "*POLYLINE")
  (wcmatch (cdr (assoc 0 (entget enOFR))) "*POLYLINE")
  (wcmatch (cdr (assoc 0 (entget enOFL))) "*POLYLINE")
  
  (setq intv (getdist "\n Enter INCREASE Distance: "))

          (setq f (getfiled "Output file name:" (getvar "dwgprefix") "csv" 3))
             (setq file1 (open f "w"))
	      (write-line (strcat "STATION " ";" "Roadwidth") file1)
         
   )
       (progn 
      (setq ent  (entget en)
            dtot (vlax-curve-getDistAtPoint en (vlax-curve-getendpoint en)) 
            dlst (in_range 0 dtot intv)

      )
  
     
  (setq IP  0)
  
  
  
            

  ;                                                                                                                                    ;  
 

  
         (REPEAT (LENGTH dlst)
  
    (setq pt_C (vlax-curve-getPointAtDist en (NTH IP dlst))
          ang (angle '(0. 0. 0.) (vlax-curve-getFirstDeriv en (vlax-curve-getParamAtPoint en pt_C)))
	  pt_R(polar pt_C (- ang (/ pi 2.)) 50)
          pt_L(polar pt_C (+ ang (/ pi 2.)) 50)
   
              LLN(entmakex (list '(0 . "LINE") (cons 10 pt_L) (cons 11 pt_R)))
            objLL(vlax-ename->vla-object LLN)
          )
        ;;;;POINTSSSSSSSSS  CENTER 
	    
           
          (IF(and
	    (setq PPR (vlax-invoke objLL 'IntersectWith entR acExtendNone))
	      (setq PPL (vlax-invoke objLL 'IntersectWith entL acExtendNone))   
	    
	    )
	          (PROGN
                        (setq ptLstR (vl-sort (mapcar '(lambda(x)(list(distance  x pt_C) x)) (setq ExtR (split PPR 3 nil)))'(lambda(a b)(<(car a)(car b)))))
		        (setq outR(CADR(car ptLstR)))
		    (setq ptLstL (vl-sort (mapcar '(lambda(x)(list(distance  x pt_C) x)) (setq ExtR (split PPL 3 nil)))'(lambda(a b)(<(car a)(car b)))))
		        (setq outL(CADR(car ptLstL)))
		     (setq ptLstall (cons (list (rtos (NTH IP dlst) 2 2) (rtos (distance  outR outL) 2 2) ) ptLstall))

		    (write-line (strcat (rtos (NTH IP dlst) 2 2) ";" (rtos (distance  outR outL) 2 2)) file1)
                        
                 )
              );PROGN - IF



(entdel LLN)
  
(setq IP(+ 1 IP))

    );;;;;;;;;REPEAT

        (close file1)

      
	  (startapp "explorer" F)

    )
)
  (setvar "CMDECHO" 1)
  (command "_undo" "_end")
     
 
 
  
  (princ)
  );;;;;;;;;;;;      END       ;;;;;;;;;;;;

 

[svippala]

Sample.dwg

On 9/11/2020 at 5:22 PM, devitg said:

For better understanding, and, maybe, get further help, please upload such sample.dwg
As far as I know, ACAD only can edit DWG.

 

perpendicular to center line? . distance step at center line ?

 

 

 

 

please find the attached sample dwg