Block Distance From Nearest Point on a Polyline

[Lee Mac]

Ahhh, sorry bout that - I will edit it to work on 3D polylines.

 

 

EDIT: Works amazingly on 2D pl's. How is the side it is on being worked out?

 

I offset the polyline to one side and measure the distance from the block to this offset. I then compare this distance to the original and thus determine left or right.

[Lee Mac]

OK,

 

This is far from ideal, but will work with 3DPolylines and avoid your error, although I can't determine left and right, as I can't offset a 3DPolyline...

 

(defun c:pdis (/    varlist     oldvars  cCurve   nlist    sAng     cBlock   txtpnt   index    ent
          dPt1    dPt2     blkDist  blkDist2 blkDist3 blklist  txt      dCurve   lPt1    rl
          pCurve    plist
         )

   (defun makelay (x)
   (if (not (tblsearch "Layer" x))
       (progn
       (setvar "cmdecho" 0)
       (command "-layer" "m" x "")
       (setvar "cmdecho" 1)
       ) ;_  end progn
   ) ;_  end if
   ) ;_  end defun

   (defun Make_Text (txt_pt txt_val)
   (entmake
       (list '(0 . "TEXT")
         '(8 . "TEXT")
         (cons 10 txt_pt)
         (cons 40 2.5)
         (cons 1 txt_val)
         '(50 . 0.0)
         '(7 . "STANDARD")
         '(71 . 0)
         '(72 . 0)
         '(73 . 0)
       ) ; end list
   ) ; end entmake
   ) ;_  end defun

   (defun massoc (key alist / x)
   (foreach x alist
       (if    (eq key (car x))
       (setq nlist (cons (cdr x) nlist))
       ) ;_  end if
   ) ;_  end foreach
   (setq nlist (reverse nlist))
   ) ;_  end defun

   (setq varlist (list "CMDECHO" "CLAYER")
     oldvars (mapcar 'getvar varlist)
   ) ;_  end setq
   (setvar "cmdecho" 0)
   (vl-load-com)
   (if
   (and
       (setq cCurve (car (entsel "\nSelect curve to measure > ")))
       (member (cdr (assoc 0 (entget cCurve)))
           '("LINE" "POLYLINE" "LWPOLYLINE" "SPLINE" "ARC" "CIRCLE" "ELLIPSE")
       ) ;_  end member
   ) ; end and
      (progn
          (makelay "TEXT")
          (cond ((= "POLYLINE" (cdr (assoc 0 (entget cCurve))))
             (setq pCurve (entnext cCurve))
             (while (/= "SEQEND" (cdr (assoc 0 (entget pCurve))))
             (setq    plist  (cons (cdr (assoc 10 (entget pCurve))) plist)
               pCurve (entnext pCurve)
             ) ;_  end setq
             ) ;_  end while
             (while
             (and
                 (setq cBlock (ssget '((0 . "INSERT"))))
                 (setq txtpnt (getpoint "\nSelect Point for Table > "))
             ) ;_  end and
                (setq index   (1- (sslength cBlock))
                  blklist "\n"
                  txt       1
                ) ;_  end setq
                (while (not (minusp index))
                (setq ent    (entget (ssname cBlock index))
                      dPt1    (cdr (assoc 10 ent))
                      dPt2    (vlax-curve-getClosestPointToProjection cCurve dPt1 '(0.0 0.0 1.0))
                      blkDist2    (distance dPt1 dPt2)
                      blkDist    (expt (+ (expt (- (car dPt1) (car dPt2)) 2)
                            (expt (- (cadr dPt1) (cadr dPt2)) 2)
                             ) ;_  end +
                             0.5
                       ) ;_  end exp
                ) ;_  end setq
                (setq blklist (strcat "Block Coord: "
                              (rtos (car dPt1) 2 1)
                              ","
                              (rtos (cadr dPt1) 2 1)
                              "  Distance: "
                              (rtos blkDist 2 1)
                          ) ;_  end strcat
                ) ;_  end setq
                (Make_Text (polar txtpnt (* pi 1.5) (* 3.5 txt)) blklist)
                (setq index (1- index)
                      txt   (1+ txt)
                ) ;_  end setq
                ) ; end while
             ) ;_  end while
            )
            ((= "LWPOLYLINE" (cdr (assoc 0 (entget cCurve))))
             (massoc 10 (entget cCurve))
             (setq sAng (angle    (nth 0 nlist)
                   (nth 1 nlist)
                ) ;_  end angle
             ) ;_  end setq
             (while
             (and
                 (setq cBlock (ssget '((0 . "INSERT"))))
                 (setq txtpnt (getpoint "\nSelect Point for Table > "))
             ) ;_  end and
                (setq index   (1- (sslength cBlock))
                  blklist "\n"
                  txt       1
                ) ;_  end setq
                (command "_offset" "0.01" cCurve (polar (nth 0 nlist) (- sAng (/ pi 2)) 0.01) "")
                (setq dCurve (entlast))
                (while (not (minusp index))
                (setq ent    (entget (ssname cBlock index))
                      dPt1    (cdr (assoc 10 ent))
                      dPt2    (vlax-curve-getClosestPointToProjection cCurve dPt1 '(0.0 0.0 1.0))
                      blkDist2    (distance dPt1 dPt2)
                      blkDist    (expt (+ (expt (- (car dPt1) (car dPt2)) 2)
                            (expt (- (cadr dPt1) (cadr dPt2)) 2)
                             ) ;_  end +
                             0.5
                       ) ;_  end exp
                ) ;_  end setq
                (setq lPt1    (vlax-curve-getClosestPointToProjection dCurve dPt1 '(0.0 0.0 1.0))
                      blkDist3    (distance dPt1 lPt1)
                ) ;_  end setq
                (if (< blkDist3 blkDist2)
                    (setq rl "RIGHT")
                    (setq rl "LEFT")
                ) ;_  end if
                (setq blklist (strcat "Block Coord: "
                              (rtos (car dPt1) 2 1)
                              ","
                              (rtos (cadr dPt1) 2 1)
                              "  Distance: "
                              (rtos blkDist 2 1)
                              " : "
                              rl
                          ) ;_  end strcat
                ) ;_  end setq
                (Make_Text (polar txtpnt (* pi 1.5) (* 3.5 txt)) blklist)
                (setq index (1- index)
                      txt   (1+ txt)
                ) ;_  end setq
                ) ; end while
                (entdel dCurve)
             ) ;_  end while
            )
          ) ;_  end cond
      ) ;_  end progn
      (princ "\n<!> Empty selection or this isn't a Curve (line, polyline, etc.) <!> ")
   ) ; end if
   (mapcar 'setvar varlist oldvars)
   (princ)
) ;_  end defun

[Lee Mac]

I shall need to think of a way to determine left and right for a 3d polyline.

 

I am thinking, creating a duplicate polyline from the original, using only the x,y, and then offset this to one side.

 

What dya reckon

[Lee Mac]

OK, this is better:

 

(defun c:pdis (/    varlist     oldvars  cCurve   nlist    sAng     cBlock   txtpnt   index    ent
          dPt1    dPt2     blkDist  blkDist2 blkDist3 blklist  txt      dCurve   lPt1    rl
          pCurve    plist     plistz      plistzd)

   (defun makelay (x)
   (if (not (tblsearch "Layer" x))
       (progn (setvar "cmdecho" 0) (command "-layer" "m" x "") (setvar "cmdecho" 1))))

   (defun Make_Text (txt_pt txt_val)
   (entmake (list '(0 . "TEXT") '(8 . "TEXT") (cons 10 txt_pt) (cons 40 2.5) (cons 1 txt_val)
         '(50 . 0.0) '(7 . "STANDARD") '(71 . 0) '(72 . 0)'(73 . 0))))

   (defun massoc (key alist / x)
   (foreach x alist
       (if    (eq key (car x))
       (setq nlist (cons (cdr x) nlist))))
   (setq nlist (reverse nlist)))

   (setq varlist (list "CMDECHO" "CLAYER") oldvars (mapcar 'getvar varlist))
   (setvar "cmdecho" 0)
   (vl-load-com)
   (if (and (setq cCurve (car (entsel "\nSelect curve to measure > ")))
        (member (cdr (assoc 0 (entget cCurve)))
           '("LINE" "POLYLINE" "LWPOLYLINE" "SPLINE" "ARC" "CIRCLE" "ELLIPSE")))
      (progn
          (makelay "TEXT")
          (while (and (setq cBlock (ssget '((0 . "INSERT"))))
                  (setq txtpnt (getpoint "\nSelect Point for Table > ")))
             (cond ((= "POLYLINE" (cdr (assoc 0 (entget cCurve))))
                (setq pCurve (entnext cCurve))
                (while (/= "SEQEND" (cdr (assoc 0 (entget pCurve))))
                (setq plist  (cons (cdr (assoc 10 (entget pCurve))) plist)
                      pCurve (entnext pCurve)))
                (foreach s    plist (setq plistz (cons (list (car s) (cadr s)) plistz)))
                (command "_.pline")
                (mapcar 'command plistz)
                (command)
                (setq dCurve (entlast)))
               ((= "LWPOLYLINE" (cdr (assoc 0 (entget cCurve))))
                (massoc 10 (entget cCurve))
                (setq sAng    (angle (nth 0 nlist) (nth 1 nlist)))
                (command "_offset" "0.01" cCurve (polar (nth 0 nlist) (- sAng (/ pi 2)) 0.01) "")
                (setq dCurve (entlast))))
             (setq index   (1- (sslength cBlock)) blklist "\n" txt 1)
             (while (not (minusp index))
             (setq    ent     (entget (ssname cBlock index))
               dPt1     (cdr (assoc 10 ent))
               dPt2     (vlax-curve-getClosestPointToProjection cCurve dPt1 '(0.0 0.0 1.0))
               blkDist2 (distance dPt1 dPt2)
               blkDist     (expt (+ (expt (- (car dPt1) (car dPt2)) 2)
                         (expt (- (cadr dPt1) (cadr dPt2)) 2)) 0.5))
             (setq    lPt1     (vlax-curve-getClosestPointToProjection dCurve dPt1 '(0.0 0.0 1.0))
               blkDist3 (distance dPt1 lPt1))
             (if (< blkDist3 blkDist2) (setq rl "RIGHT") (setq rl "LEFT"))
             (setq    blklist    (strcat    "Block Coord: " (rtos (car dPt1) 2 1) "," (rtos (cadr dPt1) 2 1)
                       "  Distance: " (rtos blkDist 2 1) " : " rl))
             (Make_Text (polar txtpnt (* pi 1.5) (* 3.5 txt)) blklist)
             (setq    index (1- index) txt   (1+ txt)))
             (entdel dCurve)))
      (princ "\n<!> Empty selection or this isn't a Curve (line, polyline, etc.) <!> "))
   (mapcar 'setvar varlist oldvars)
   (princ)
) ;_  end Program

[wannabe]

I have a lisp that converts 3d to 2d polylines if that helps?

 

EDIT: You could do that as the first command, right? To save cancelling the 3D values. I'll upload tomorrow am.

[Lee Mac]

It wouldn't matter about cancelling the z coords, as the original line is mapped to the x-y plane when the vlax-curve-getClosestPointToProjection is used.

 

The above should work.