Perpendicular lines

Hi,

I have a lisp file that runs perpendicular lines between 2 polylines and generates an ascii file. The lisp file also draws the lines in AutoCAD2010. I would like to update the file by including the following improvements:

1. The measured width should be drawn in the drawing at the mid point of the measured line as text.

2. A note (text object) of the start of the polyline should be drawin in and the end of the poly line.

3. Coordinates, X and Y need to be generated in the ascii file.

This lisp routine is producing fantastic results.

Thanks

bsimpson.

perpendiculardist.lsp

Wow - its been a long time since I wrote that...

Try this, it uses a different method:

(defun c:LPerp ( / *error*  DER DOC E1 E2 EDIS FILE ILST L
                           LLST OBJ2 OFILE PA PT SDIS SPC TMP)
 (vl-load-com)
 ;; Lee Mac  ~  17.05.10

 (defun *error* ( msg )
   (and tmp   (entdel tmp))
   (and ofile (close ofile))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )    

 (setq spc
   (if
     (or
       (eq AcModelSpace
         (vla-get-ActiveSpace
           (setq doc
             (vla-get-ActiveDocument
               (vlax-get-acad-object)
             )
           )
         )
       )
       (eq :vlax-true (vla-get-MSpace doc))
     )
     (vla-get-ModelSpace doc)
     (vla-get-PaperSpace doc)
   )
 )
 
 (if
   (apply (function and)
     (append
       (mapcar
         (function
           (lambda ( sym str )
             (set sym (CurveifFoo isCurveObject str))
           )
         )
         '(e1 e2) '("\nSelect First Curve: ""\nSelect Curve to Measure to: ")
       )
       (list (setq file (getfiled "Create Output File" "" "txt" 1)))
     )
   )
   (progn
     (initget 6)
     (setq *step*
       (cond
         (
           (getdist
             (strcat "\nSpecify Step <"
               (rtos
                 (setq *step*
                   (cond ( *step* ) ( 1.0 ))
                 )
               )
               "> : "
             )
           )
         )
         ( *step* )
       )
     )
     (mapcar (function set) '(obj1 obj2)
       (mapcar
         (function vlax-ename->vla-object) (list e1 e2)
       )
     )
     (mapcar
       (function
         (lambda ( entity )
           (mapcar
             (function
               (lambda ( ipt str )
                 (MText spc ipt str acAttachmentPointMiddleCenter)
               )
             )
             (list
               (vlax-curve-getStartPoint entity)
               (vlax-curve-getEndPoint   entity)
             )
             (list "Start" "End")
           )
         )
       )
       (list e1 e2)
     )
     (setq sDis (- (vlax-curve-getDistatParam e1
                     (vlax-curve-getStartParam e1)) *step*)

           eDis (vlax-curve-getDistatParam e1
                  (vlax-curve-getEndParam e1)))

     (while (<= (setq sDis (+ sDis *step*)) eDis)
       (setq pt (vlax-curve-getPointatDist e1 sDis))

       (if
         (progn
           (setq iLst
             (vlax-invoke
               (vlax-ename->vla-object
                 (setq tmp
                   (Line pt
                     (polar pt
                       (+
                         (angle '(0 0 0)
                           (vlax-curve-getFirstDeriv e1
                             (vlax-curve-getParamatDist e1 sDis)
                           )
                         )
                         (/ pi 2.)
                       )
                       1.
                     )
                   )
                 )
               )
               'IntersectWith Obj2 acExtendThisEntity
             )
           )
           (entdel tmp) (setq tmp nil)
           iLst
         )
         (progn
           (setq lLst
             (cons
               (list
                 (car iLst) (cadr iLst)
                 (vlax-curve-getDistatParam
                   (setq l
                     (Line pt
                       (list (car iLst) (cadr iLst) (caddr iLst))
                     )
                   )
                   (vlax-curve-getEndParam l)
                 )
               )
               lLst
             )
           )
           (vla-put-rotation
             (MText spc
               (polar
                 (vlax-curve-getPointatParam l
                   (setq pa
                     (/ (vlax-curve-getEndParam l) 2.)
                   )
                 )
                 (+ (/ pi 2.)
                   (setq der
                     (angle '(0. 0. 0.)
                       (vlax-curve-getFirstDeriv l pa)
                     )
                   )
                 )
                 (/ (getvar 'TEXTSIZE) 2.)
               )
               (rtos
                 (vlax-curve-getDistatParam l
                   (vlax-curve-getEndParam l)
                 )
               )
               acAttachmentPointMiddleCenter
             )
             (MakeReadable der)
           )
         )
       )
     )
     (setq ofile (open file "w"))
     (mapcar
       (function
         (lambda ( line )
           (write-line
             (lst2str
               (mapcar (function rtos) line) "      "
             )
             ofile
           )
         )
       )
       lLst
     )
     (setq ofile (close ofile))
   )
 )
 (princ)
)

(defun MakeReadable ( a )
 (cond
   (
     (and (> a (/ pi 2)) (<= a pi))

     (- a pi)
   )
   (
     (and (> a pi) (<= a (/ (* 3 pi) 2)))

     (+ a pi)
   )
   (
     a
   )
 )
)

(defun MText ( block point str jus / o )
 (vla-put-AttachmentPoint
   (setq o
     (vla-addMText block
       (vlax-3D-point point) 0. str
     )
   )
   jus
 )
 (vla-put-InsertionPoint o (vlax-3D-point point))
 o
)

(defun CurveifFoo ( foo str / sel ent )
 (while
   (progn
     (setq sel (entsel str))
     
     (cond
       (
         (vl-consp sel)

         (if (not (foo (setq ent (car sel))))
           (princ "\n** Invalid Object Selected **")
         )
       )
     )
   )
 )
 ent
)

(defun Line ( p1 p2 )
 (entmakex
   (list
     (cons 0 "LINE")
     (cons 10 p1)
     (cons 11 p2)
   )
 )
)

(defun isCurveObject ( ent )
 (not
   (vl-catch-all-error-p
     (vl-catch-all-apply
       (function vlax-curve-getEndParam) (list ent)
     )
   )
 )
)

(defun lst2str ( lst del )
 (if (cdr lst)
   (strcat (car lst) del (lst2str (cdr lst) del))
   (car lst)
 )
)
       

Hi Lee,

Thanks for this, the widths plot perfectly in the drawing. There is still some anomolies that exist which are as follows;

1. The coordinates don't tie up with the drawing, I can't tell where they are from.

2. I can't tell when I open the ascii file which side of the polyline the measurement are taken from. This would happen in the case when the road widths are the same.

Perhapse you could put the increment on the drawing next to the base of the perpendicular line and put the increment in the ascii file.

Thanks again

bsimpson8)

Mr Simpson,

The way the code works is to incrementally move along the first selected object by a set distance, and create a perpendicular line from the first object extending to the second (if possible).

The points you see in the ASCII file are those intersections with the second object.

I must stress however, that you should please bear in mind that my time on this forum is voluntary, and I am receiving no renumeration for providing these codes.

Hi Lee,

I appreciate that there is no renumeration exchange here. I can see the potential with the buisness and could connect you with the right company on a national scale that would need this type of improvement to their softwear.

I am using this file on an experimental basis for reference only and trying to improve design time that exists in road design.

People are asking where the information is comming from.

Thanks

bsimpson.

Hi,

I am in need of a deviation from the code.

The coordinate point sent to the ascii file needs to be changed to the other interesection point where the perpendicular angle is measured from.

The step increment needs to be drawn on the drawing at the intersection of the line and the perpendicular line and inserted into the ascii file.

thanks

bsimpson

test_v3.txt

test_v3.dwg

This should suit your needs, but I seriously recommend you change the way you ask for such.

(defun c:LPerp ( / *error* DOC E1 E2 EDIS FILE ILST L LLST OBJ2
                       OFILE PA PT SDIS SPC TANG TMP TOBJ UNDO)
 (vl-load-com)
 ;; Lee Mac  ~  17.05.10

 (defun *error* ( msg )
   (and Undo  (vla-EndUndoMark doc))
   (and tmp   (entdel tmp))
   (and ofile (close ofile))    
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )    

 (setq spc
   (if
     (or
       (eq AcModelSpace
         (vla-get-ActiveSpace
           (setq doc
             (vla-get-ActiveDocument
               (vlax-get-acad-object)
             )
           )
         )
       )
       (eq :vlax-true (vla-get-MSpace doc))
     )
     (vla-get-ModelSpace doc)
     (vla-get-PaperSpace doc)
   )
 )
 
 (if
   (apply (function and)
     (append
       (mapcar
         (function
           (lambda ( sym str )
             (set sym (CurveifFoo isCurveObject str))
           )
         )
         '(e1 e2) '("\nSelect First Curve: ""\nSelect Curve to Measure to: ")
       )
       (list (setq file (getfiled "Create Output File" "" "txt" 1)))
     )
   )
   (progn
     (setq Undo (not (vla-StartUndoMark doc)))
     (initget 6)
     (setq *step*
       (cond
         (
           (getdist
             (strcat "\nSpecify Step <"
               (rtos
                 (setq *step*
                   (cond ( *step* ) ( 1.0 ))
                 )
               )
               "> : "
             )
           )
         )
         ( *step* )
       )
     )
     (mapcar (function set) '(obj1 obj2)
       (mapcar
         (function vlax-ename->vla-object) (list e1 e2)
       )
     )
     (mapcar
       (function
         (lambda ( entity )
           (mapcar
             (function
               (lambda ( ipt str )
                 (MText spc ipt str acAttachmentPointMiddleCenter)
               )
             )
             (list
               (vlax-curve-getStartPoint entity)
               (vlax-curve-getEndPoint   entity)
             )
             (list "Start" "End")
           )
         )
       )
       (list e1 e2)
     )
     (setq sDis (- (vlax-curve-getDistatParam e1
                     (vlax-curve-getStartParam e1)) *step*)

           eDis (vlax-curve-getDistatParam e1
                  (vlax-curve-getEndParam e1)))

     (while (<= (setq sDis (+ sDis *step*)) eDis)
       (setq pt (vlax-curve-getPointatDist e1 sDis))

       (if
         (progn
           (setq iLst
             (vlax-invoke
               (vlax-ename->vla-object
                 (setq tmp
                   (Line pt
                     (polar pt
                       (+
                         (angle '(0 0 0)
                           (vlax-curve-getFirstDeriv e1
                             (vlax-curve-getParamatDist e1 sDis)
                           )
                         )
                         (/ pi 2.)
                       )
                       1.
                     )
                   )
                 )
               )
               'IntersectWith Obj2 acExtendThisEntity
             )
           )
           (entdel tmp) (setq tmp nil)
           iLst
         )
         (progn
           (setq lLst
             (cons
               (list (car pt) (cadr pt)
                 (vlax-curve-getDistatParam
                   (setq l
                     (Line pt
                       (list (car iLst) (cadr iLst) (caddr iLst))
                     )
                   )
                   (vlax-curve-getEndParam l)
                 )
               )
               lLst
             )
           )
           (vla-put-rotation
             (setq tObj
               (MText spc
                 (vlax-curve-getPointatParam l
                   (setq pa
                      (/ (vlax-curve-getEndParam l) 2.)
                   )
                 )
                 (rtos
                   (vlax-curve-getDistatParam l
                     (vlax-curve-getEndParam l)
                   )
                 )
                 acAttachmentPointMiddleCenter
               )
             )
             (setq tAng
               (MakeReadable
                 (angle '(0. 0. 0.)
                   (vlax-curve-getFirstDeriv l pa)
                 )
               )
             )
           )
           (vla-put-backgroundfill tObj :vlax-true)
           (vla-put-rotation
             (MText spc pt (rtos sDis) acAttachmentPointMiddleCenter) tAng
           )             
         )
       )
     )
     (setq ofile (open file "w"))
     (mapcar
       (function
         (lambda ( line )
           (write-line
             (lst2str
               (mapcar (function rtos) line) "      "
             )
             ofile
           )
         )
       )
       (reverse lLst)
     )
     (setq ofile (close ofile))
     
     (setq Undo (vla-EndUndoMark doc))
   )
 )
 (princ)
)

(defun MakeReadable ( a )
 (cond
   (
     (and (> a (/ pi 2)) (<= a pi))

     (- a pi)
   )
   (
     (and (> a pi) (<= a (/ (* 3 pi) 2)))

     (+ a pi)
   )
   (
     a
   )
 )
)

(defun MText ( block point str jus / o )
 (vla-put-AttachmentPoint
   (setq o
     (vla-addMText block
       (vlax-3D-point point) 0. str
     )
   )
   jus
 )
 (vla-put-InsertionPoint o (vlax-3D-point point))
 o
)

(defun CurveifFoo ( foo str / sel ent )
 (while
   (progn
     (setq sel (entsel str))
     
     (cond
       (
         (vl-consp sel)

         (if (not (foo (setq ent (car sel))))
           (princ "\n** Invalid Object Selected **")
         )
       )
     )
   )
 )
 ent
)

(defun Line ( p1 p2 )
 (entmakex
   (list
     (cons 0 "LINE")
     (cons 10 p1)
     (cons 11 p2)
   )
 )
)

(defun isCurveObject ( ent )
 (not
   (vl-catch-all-error-p
     (vl-catch-all-apply
       (function vlax-curve-getEndParam) (list ent)
     )
   )
 )
)

(defun lst2str ( lst del )
 (if (cdr lst)
   (strcat (car lst) del (lst2str (cdr lst) del))
   (car lst)
 )
)

This is, after all, a help and advice site.

Hi,

Thanks for the advice, :wink:

The program is working but still the results could be better. There are points between the increments that are missed so in additon a lisp file that measures slightly differently to pick up these points is in need.

This will be done by measureing the line from the vertex of the polyline (red) to the perpendicular angle of the polyline (blue)

No need to step at an increment along the first curve (blue) as before but the text measurement is needed for the distance from the start to the point of intersection on the first curve (blue). This text is also needed in the ascii file for the location of the perpendicular measurement + coordinates. see attachments.

Hope you will find time to help out

cheers

bsimpson

TEST_V4.dwg

TEST_V9.txt

I think it's time someone learned to write their own LISP routines.

That's a different thing entirely... it would have been niceto have had that drawing from the first post - that would have saved a lot of time. So much for 'refinements'.

Try this:

(defun c:chain ( / *error* DOC E1 E2 FILE L LEN LLST OFILE PA
                           PT SDIS SPC TANG TOBJ UNDO VLST X)
 (vl-load-com)
 ;; © Lee Mac  ~  24.05.10

 (defun *error* ( msg )
   (and Undo  (vla-EndUndoMark doc))
   (and ofile (close ofile))    
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )    

 (setq spc
   (if
     (or
       (eq AcModelSpace
         (vla-get-ActiveSpace
           (setq doc
             (vla-get-ActiveDocument
               (vlax-get-acad-object)
             )
           )
         )
       )
       (eq :vlax-true (vla-get-MSpace doc))
     )
     (vla-get-ModelSpace doc)
     (vla-get-PaperSpace doc)
   )
 )
 
 (if
   (apply (function and)
     (append
       (mapcar
         (function
           (lambda ( sym str )
             (set sym
               (CurveifFoo
                 (lambda ( x )
                   (eq "LWPOLYLINE" (cdr (assoc 0 (entget x))))
                 )
                 str
               )
             )
           )
         )
         '(e1 e2) '("\nSelect First Curve: ""\nSelect Curve to Measure to: ")
       )
       (list (setq file (getfiled "Create Output File" "" "txt" 1)))
     )
   )
   (progn
     (setq Undo (not (vla-StartUndoMark doc)))

     (setq vLst
       (GroupByNum
         (vlax-get
           (vlax-ename->vla-object e1) 'Coordinates
         )
         2
       )
     )

     (while (setq x (car vLst))
       (setq lLst
         (cons
           (list
             (setq sDis
               (vlax-curve-getDistatPoint e2
                 (setq pt
                   (vlax-curve-getClosestPointto e2 x)
                 )
               )
             )
             (car x) (cadr x)
             (progn
               (setq l (line x pt))
               (setq len
                 (vlax-curve-getDistatParam l
                   (vlax-curve-getEndParam l)
                 )
               )
             )
           )
           lLst
         )
         vLst (cdr vLst)
       )
       (vla-put-rotation
         (setq tObj
           (MText spc
             (vlax-curve-getPointatParam l
               (setq pa
                 (/ (vlax-curve-getEndParam l) 2.)
               )
             )
             (rtos len)
             acAttachmentPointMiddleCenter
           )
         )
         (setq tAng
           (MakeReadable
             (angle '(0. 0. 0.)
               (vlax-curve-getFirstDeriv l pa)
             )
           )
         )
       )
       (vla-put-backgroundfill tObj :vlax-true)
       (vla-put-rotation
         (MText spc pt (rtos sDis) acAttachmentPointMiddleCenter) tAng
       )             
     )
     (setq ofile (open file "w"))
     (mapcar
       (function
         (lambda ( line )
           (write-line
             (lst2str                
               (mapcar
                 (function
                   (lambda ( p )
                     (PadRight (rtos p) " " 10)
                   )
                 )
                 line
               )
               "      "
             )
             ofile
           )
         )
       )
       (vl-sort Llst
         (function
           (lambda ( a b )
             (< (car a) (car b))
           )
         )
       )          
     )
     (setq ofile (close ofile))
     
     (setq Undo (vla-EndUndoMark doc))
   )
 )
 (princ)
)

(defun MakeReadable ( a )
 ;; © Lee Mac
 (cond
   (
     (and (> a (/ pi 2)) (<= a pi))

     (- a pi)
   )
   (
     (and (> a pi) (<= a (/ (* 3 pi) 2)))

     (+ a pi)
   )
   (
     a
   )
 )
)

(defun PadRight ( str char len )
 (while (< (strlen str) len)
   (setq str (strcat str char))
 )
 str
)

(defun MText ( block point str jus / o )
 ;; © Lee Mac
 (vla-put-AttachmentPoint
   (setq o
     (vla-addMText block
       (vlax-3D-point point) 0. str
     )
   )
   jus
 )
 (vla-put-InsertionPoint o (vlax-3D-point point))
 o
)

(defun CurveifFoo ( foo str / sel ent )
 ;; © Lee Mac
 (while
   (progn
     (setq sel (entsel str))
     
     (cond
       (
         (vl-consp sel)

         (if (not (foo (setq ent (car sel))))
           (princ "\n** Invalid Object Selected **")
         )
       )
     )
   )
 )
 ent
)

(defun Line ( p1 p2 )
 (entmakex
   (list
     (cons 0 "LINE")
     (cons 10 p1)
     (cons 11 p2)
   )
 )
)

(defun lst2str ( lst del )
 ;; © Lee Mac
 (if (cdr lst)
   (strcat (car lst) del (lst2str (cdr lst) del))
   (car lst)
 )
)


(defun GroupByNum (l n / a b i)
 ;; © Lee Mac
 (while l (setq i n)
   (while (< 0 i)
     (setq a (cons (car l) a) l (cdr l) i (1- i))
   )
   (setq b (cons (reverse a) b) a nil)
 )
 (reverse b)
)

Hi Lee,

Thanks this is a master piece, I have being trying to generate the lisp file for at least 2 years.

I am sure there are intermediate programs that could write the lisp for me but your the best.

Some time I would like to change the coordinates that are sent to the ascii file as the other intersection point on the blue line.

ty

bsimpson:roll:

Thanks bSimpson.