Familiar with Vlisp? Explore vlax-curve-getDistAtPoint
You could try this, still a work in progress
or this, an oldieCode:;;;Report Station and offset of an alignment LPS 2010-02-26 (defun j (/ temperror *error* varlst oldvar uicon ent ename sta on-pt ox-pt ox-di ang ang-test stra dotpos statxt tot) (vl-load-com) ;;;===Error Trap==== (setq temperr *error* *error* errortrap varlst '("OSMODE" "UCSICON" "CMDECHO" ) oldvar (mapcar 'getvar vlst) ) ;;;====Error Trap===== (setq uicon (getvar "ucsicon" )) (setvar "osmode" 0) ;(vl-cmdf "UCS" "w") (setq ent (entsel "\nSelect alignment: ") ename (car ent)) ;;;====Check if entsel is valid==== (if (not ent) (progn (alert "Missed... try again!") (j) ) ) ;;;====End check=================== (setq sta (vlax-curve-getDistAtPoint ename (setq on-pt (vlax-curve-getClosestPointTo ename (setq ox-pt (trans (getpoint "\nPick Station//Offset point: " ) 1 0)) );end grtClosestPointTo ) ) ) (setq ox-di (abs (distance (list (car on-pt)(cadr on-pt))(list (car ox-pt)(cadr ox-pt))));no 3D ang (angle '(0 0 0) (vlax-curve-getFirstDeriv ename (vlax-curve-getParamAtPoint ename on-pt))) ) ;;;=====Test Left or Right========= (entmake (list (cons 0 "LINE") (cons 10 on-pt) (cons 11 (polar on-pt (+ ang (* 1.5 pi))100.0)) ) ) (setvar "ucsicon" 0) (vl-cmdf "ucs" "ob" "l") (entdel (entlast)) (setq ang-test (angtof (angtos (angle (trans on-pt 0 1)(trans ox-pt 0 1))) 3)) (vl-cmdf "ucs" "p") (setvar "ucsicon" uicon) (cond ((equal 0.0 (fix ox-di) 0.01)(setq dir " Point on alignment")) ((<= 0.0 ang-test pi)(setq dir " Rt")) ((> ang-test pi)(setq dir " Lt")) ('T (setq dir " ")) ) ;;;======End Test=================== (setq stra (rtos sta 2 2 )) (if (not (= stra "0.00")) (progn (setq dotpos (1+ (vl-string-search "." stra))) (substr stra (- dotpos 2)) (if (>= (strlen stra) 6) (setq statxt (strcat (substr stra 1 (- dotpos 3)) "+"(substr stra (- dotpos 2)))) (setq statxt (strcat (chr 48)"+" (substr stra (- dotpos 2)))) ) );progn (setq statxt "0+00") );if (setq tot (vlax-curve-getDistAtPoint ename (vlax-curve-getEndPoint ename))) (if (or (= sta 0.0)(= sta tot)) (alert (strcat "\nStation: " statxt "\nOffset: "(rtos ox-di 2 2) dir "\n\n Alert!\nThe offset point may be beyond the\nendpoints of the alignment;\nIf so, the reported data is incorrect" ) ) (alert (strcat "\nStation: " statxt "\nOffset: "(rtos ox-di 2 2) dir ) ) );if (mapcar 'setvar varlst oldvar) (princ) );defun (defun c:idox ()(j)) ;;;====Error Trap==== (defun errortrap (msg) (if oldvar (mapcar 'setvar varlst oldvar)) (setq *error* temperr) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n<< Error: " msg " >>")) ) (princ) ) ;;;====Error Trap==== (princ "Application loaded... Type IDOX to run.") (princ)
Code:;reports distance from beginning of a polyline LPS 8-8-08 (defun c:ids () (vl-load-com) (command "ucs" "w") (setq ename-pline (car (entsel "\nPick a Polyline:")) vlaobject-pline (vlax-ename->vla-object ename-pline) ;make vla-object from entity name pt1 (vlax-curve-getClosestPointTo vlaobject-pline (getpoint "\nPick point on Polyline: ")) ;pt1 (getpoint "Pick point on Polyline: ") sta (vlax-curve-getDistatPoint vlaobject-pline pt1) sta-str (strcat "The distance from the start of the Polyline is " (rtos sta 2 2) "'") );setq (command "ucs" "p") (alert Sta-str) );defun




Reply With Quote



Bookmarks