Jump to content
toxicsquall

Calculate the Dip (angle) of a 3D Polyline

Recommended Posts

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?

Share this post


Link to post
Share on other sites
marko_ribar

Can you explain, what is DIP (angle) ?

Share this post


Link to post
Share on other sites
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

 

1024px-StrikeLine%26Dip.JPG

Share this post


Link to post
Share on other sites
marko_ribar

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

Share this post


Link to post
Share on other sites
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.

Share this post


Link to post
Share on other sites
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 by marko_ribar

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...