Calculate the Dip (angle) of a 3D Polyline

[toxicsquall]

Hi,

I would like to know: are there any lisp that can calculate the DIP and the length of a 3d Polyline, in Front View or any other view?

[marko_ribar]

Can you explain, what is DIP (angle) ?

[toxicsquall]

The dip gives the steepest angle of descent of a tilted line or feature relative to a horizontal plane, and is given by the number (0°-90°) with the rough direction in which the line is dipping.

Like this image

 

[marko_ribar]

Then why 3D Polyline... Aren't you searching for line DIP and length?

[toxicsquall]

I just wrote wrong. It's "the dip gives the steepest angle of descent of a tilted 3d polyline". Dip is a geological term for this angle or inclination of the plane with a line in real life. But in AutoCad a line with xyz, we call 3dpoly, if I'm not wrong.

[marko_ribar]

Ok, give this a try :

 

(defun c:DIP&Len ( / v^v unit mxv transptucs transptwcs ss pe pa ent p1 p2 l vd vx vy p1u p2u p1up p2up p1p p2p lp pl p ps ph dip )

 (vl-load-com)

 (defun v^v ( u v )
   (mapcar '(lambda ( s1 s2 a b ) (+ ((eval s1) (* (nth a u) (nth b v))) ((eval s2) (* (nth a v) (nth b u))))) '(+ - +) '(- + -) '(1 0 0) '(2 2 1))
 )

 (defun unit ( v )
   (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
 )

 (defun mxv ( m v )
   (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
 )

 (defun transptucs ( pt p1 p2 p3 / ux uy uz )
   (setq uz (unit (v^v (mapcar '- p2 p1) (mapcar '- p3 p1))))
   (setq ux (unit (mapcar '- p2 p1)))
   (setq uy (unit (mapcar '- p3 p1)))
   
   (mxv (list ux uy uz) (mapcar '- pt p1))
 )

 (defun transptwcs ( pt pt1 pt2 pt3 / pt1n pt2n pt3n )
   (setq pt1n (transptucs '(0.0 0.0 0.0) pt1 pt2 pt3))
   (setq pt2n (transptucs '(1.0 0.0 0.0) pt1 pt2 pt3))
   (setq pt3n (transptucs '(0.0 1.0 0.0) pt1 pt2 pt3))
   (transptucs pt pt1n pt2n pt3n)
 )

 (prompt "\nPick Line entity or straight segment of polyline to calculate DIP (angle) to current view and Lenght of its projection & its real Length")
 (setq ss (ssget "_+.:E:S" '((0 . "LINE,*POLYLINE"))))
 (if (and ss (wcmatch (cdr (assoc 0 (entget (ssname ss 0)))) "*POLYLINE"))
   (progn
     (setq pe (vlax-curve-getclosestpointtoprojection (ssname ss 0) (cadr (cadddr (car (ssnamex ss)))) '(0.0 0.0 1.0)))
     (setq pa (vlax-curve-getparamatpoint (ssname ss 0) pe))
     (if (/= (vla-getbulge (vlax-ename->vla-object (ssname ss 0)) (float (fix pa))) 0.0)
       (setq ss nil)
     )
   )
 )
 (while (not ss)
   (prompt "\nMissed selection or picked arced segment... Please select again (LINE, POLYLINE) - only straight segment...")
   (setq ss (ssget "_+.:E:S" '((0 . "LINE,*POLYLINE"))))
   (if (and ss (wcmatch (cdr (assoc 0 (entget (ssname ss 0)))) "*POLYLINE"))
     (progn
       (setq pe (vlax-curve-getclosestpointtoprojection (ssname ss 0) (cadr (cadddr (car (ssnamex ss)))) '(0.0 0.0 1.0)))
       (setq pa (vlax-curve-getparamatpoint (ssname ss 0) pe))
       (if (/= (vla-getbulge (vlax-ename->vla-object (ssname ss 0)) (float (fix pa))) 0.0)
         (setq ss nil)
       )
     )
   )
 )
 (setq ent (ssname ss 0))
 (setq pe (vlax-curve-getclosestpointtoprojection ent (cadr (cadddr (car (ssnamex ss)))) '(0.0 0.0 1.0)))
 (setq pa (vlax-curve-getparamatpoint ent pe))
 (if (wcmatch (cdr (assoc 0 (entget ent))) "*POLYLINE")
   (progn
     (setq p1 (vlax-curve-getpointatparam ent (float (fix pa))))
     (setq p2 (vlax-curve-getpointatparam ent (float (1+ (fix pa)))))
   )
   (progn
     (setq p1 (vlax-curve-getstartpoint ent))
     (setq p2 (vlax-curve-getendpoint ent))
   )
 )
 (setq l (distance p1 p2))
 (setq vd (trans (getvar 'viewdir) 1 0 t))
 (if (not (equal (unit vd) '(0.0 0.0 1.0) 1e-6))
   (progn
     (setq vx (unit (v^v vd '(0.0 0.0 1.0))))
     (setq vy (unit (v^v vd vx)))
   )
   (setq vx '(1.0 0.0 0.0) vy '(0.0 1.0 0.0))
 )
 (setq p1u (transptucs p1 '(0.0 0.0 0.0) vx vy))
 (setq p2u (transptucs p2 '(0.0 0.0 0.0) vx vy))
 (setq p1up (list (car p1u) (cadr p1u) 0.0))
 (setq p2up (list (car p2u) (cadr p2u) 0.0))
 (setq lp (distance p1up p2up))
 (setq p1p (transptwcs p1up '(0.0 0.0 0.0) vx vy))
 (setq p2p (transptwcs p2up '(0.0 0.0 0.0) vx vy))
 (setq p (inters p1 p2 p1p p2p nil))
 (if (and p (> (distance p p2) (distance p p1))) (setq ps p2p ph (distance p2 p2p)) (setq ps p1p ph (distance p1 p1p)))
 (if p
   (progn
     (setq pl (distance p ps))
     (setq dip (cvunit (atan ph pl) "radian" "degree"))
   )
   (if (equal l lp 1e- (setq dip 0.0))
 )
 (prompt "\n.................................................")
 (prompt "\nReal length is : ") (princ (rtos l 2 15))
 (prompt "\nLength of projection is : ") (princ (rtos lp 2 15))
 (prompt "\nDIP (angle) in decimal degrees is : ") (princ (rtos dip 2 15))
 (princ)
)

HTH, M.R.

Edited April 10, 2015 by marko_ribar