Search the Community

Hi good people! I like measure distance between polylines and I found nice visualLISP for starting point. This lisp make lines between polylines with can be measure. But I have some problems: 1. In EX1 is new lines right angle but "step 50" is for polyline 1, I like that "step 50" is for polyline 2 like in EX2 but in EX2 is new lines wrong angle. It's difficult to explain:) 2. New lines must be in red color 3. How measure these new lines Thanks for all tips or maybe is something similar already made8) ;; written by Fatty T.O.H. ()2005 * all rights removed ;; edited 5/14/12 ;; draw perpendicular lines ;;load ActiveX library (vl-load-com) ;;local defuns ;;// (defun start (curve) (vl-catch-all-apply (function (lambda() (vlax-curve-getclosestpointto curve (vlax-curve-getstartpoint curve ) ) ) ) ) ) ;;// (defun end (curve) (vl-catch-all-apply (function (lambda() (vlax-curve-getclosestpointto curve (vlax-curve-getendpoint curve ) ) ) ) ) ) ;;// (defun pointoncurve (curve pt) (vl-catch-all-apply (function (lambda() (vlax-curve-getclosestpointto curve pt ) ) ) ) ) ;;// (defun paramatpoint (curve pt) (vl-catch-all-apply (function (lambda() (vlax-curve-getparamatpoint curve pt ) ) ) ) ) ;;// (defun distatpt (curve pt) (vl-catch-all-apply (function (lambda() (vlax-curve-getdistatpoint curve (vlax-curve-getclosestpointto curve pt) ) ) ) ) ) ;;// (defun pointatdist (curve dist) (vl-catch-all-apply (function (lambda() (vlax-curve-getclosestpointto curve (vlax-curve-getpointatdist curve dist) ) ) ) ) ) ;;// (defun curvelength (curve) (vl-catch-all-apply (function (lambda() (vlax-curve-getdistatparam curve (- (vlax-curve-getendparam curve) (vlax-curve-getstartparam curve) ) ) ) ) ) ) ;;// (defun distatparam (curve param) (vl-catch-all-apply (function (lambda() (vlax-curve-getdistatparam curve param ) ) ) ) ) ;;// written by VovKa (Vladimir Kleshev) (defun gettangent (curve pt) (setq param (paramatpoint curve pt) ang ((lambda (deriv) (if (zerop (cadr deriv)) (/ pi 2) (atan (apply '/ deriv)) ) ) (cdr (reverse (vlax-curve-getfirstderiv curve param) ) ) ) ) ang ) ;;// main program ;;--------------------------------------------------;; (defun c:DIP (/ *error* acsp adoc cnt div en en2 ent ent2 ip lastp leng ln lnum mul num pt rot sign start step) (defun *error* (msg) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)) ) (cond ((or (not msg) (member msg '("console break" "Function cancelled" "quit / exit abort")) ) ) ((princ (strcat "\nError: " msg))) ) (princ) ) (setq adoc (vla-get-activedocument (vlax-get-acad-object)) acsp (vla-get-block (vla-get-activelayout adoc)) ) (while (not (and (or (initget 6) (setq step (getreal "\nEnter step <50>: ")) (if (not step) (setq step 50.))) )) (alert "\nEnter a step") ) (if (and (setq ent (entsel "\nSelect polyline 1 >>" ) ) (setq ent2 (entsel "\nSelect polyline 2 >>" ) ) ) (progn (setq en (car ent) pt (pointoncurve en (cadr ent)) leng (distatparam en (vlax-curve-getendparam en)) en2 (car ent2) ) (setq num (fix (/ leng step)) ) (setq div (fix (/ 100. step) ) ) (setq mul (- leng (* (setq lnum (fix (/ leng (* step div)))) (* step div)))) (if (not (zerop mul)) (setq lastp T) (setq lastp nil) ) (if (> (- (paramatpoint en pt) (paramatpoint en (vlax-curve-getstartpoint en)) ) (- (paramatpoint en (vlax-curve-getendpoint en)) (paramatpoint en pt) ) ) (progn (setq start leng sign -1 ) ) (progn (setq start (distatparam en (vlax-curve-getstartparam en)) sign 1 ) ) ) (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)) ) (setq cnt 0) (repeat (1+ num) (setq pt (pointatdist en start) rot (gettangent en pt) ) (setq ln (vlax-invoke-method acsp 'addline (setq ip (vlax-3d-point pt))(vlax-3d-point(pointoncurve en2 pt)))) (setq cnt (1+ cnt) start (+ start (* sign step)) ) ) (if lastp (progn (if (= sign -1) (progn (setq pt (vlax-curve-getstartpoint en) rot (gettangent en pt) ) ) (progn (setq pt (vlax-curve-getendpoint en) rot (gettangent en pt) ) ) ) (setq ln (vlax-invoke-method acsp 'addline (setq ip (vlax-3d-point pt))(vlax-3d-point(pointoncurve en2 pt)))) ) ) ) (princ "\nNothing selected") ) (*error* nil) (princ) ) (prompt "\n >>> Type DIP to execute...") (prin1)