Jump to content

Draw a dimension that shows the gradient of line in %


norrisad

Recommended Posts

Hi,

 

I am trying to show the gradient of a line as a dimension or possibly with a leader indicating which way the slope is declining. I am on AutoCAD 2014 is there command to do this or will I have to look into LISP routine's.

 

Thanks

Link to comment
Share on other sites

I think a custom lisp routine would be the answer to your problem. I'm sure if you look around you could find one. Try searching on "autocad"+"slope"+"lisp".

 

Did you want both the length of the line and the slope as well or just the slope?

 

A couple of links that might be of interest.

 

http://forums.augi.com/showthread.php?107096-Slopes-and-angles-of-a-polyline-in-2d-autocad Refer to post #10.

 

http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/label-slope-between-two-points/m-p/2604319

Edited by ReMark
Link to comment
Share on other sites

Here is an example

 

; xfall as a percentage 
;(defun trap (errmsg)
;  (prompt "\nAn error has occured.")
;  (command "undo" "b")
;  (setvar "osmode" os)
;  (setq *error* temperr)

(defun rtd (a)(/ (*  a 180.0) pi))
(setvar "TEXTSTYLE" "STANDARD")
(defun c:xfallper ()
 (setvar "cmdecho" 0)
(SETQ ANGBASEE (GETVAR "ANGBASE"))
(SETQ ANGDIRR (GETVAR "ANGDIR"))
(SETQ LUNITSS (GETVAR "LUNITS"))
(SETQ LUPRECC (GETVAR "LUPREC"))
(SETQ AUNITSS (GETVAR "AUNITS"))
(SETQ AUPRECC (GETVAR "AUPREC"))
(SETVAR "LUNITS" 2)
(SETVAR "ANGBASE" 0.0)
(SETVAR "ANGDIR" 0)
(SETVAR "LUPREC" 3)
(SETVAR "AUNITS" 3)
(SETVAR "AUPREC" 3)
;(setq temperr *error*)
;(setq *error* trap)
;(command "undo" "m")
;(setq dimz (getvar "DIMZIN"))
;(setvar "DIMZIN" 0)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(if (= horiz nil)
   (progn (setq horiz 100)
   (prompt "\nEnter Horizontal scale <-ve to reset> :<")
   (prin1 horiz)
   (prompt ">:")
   (setq newhoriz (getint))
           
         (if (= newhoriz nil)
  (PRINC "\N")
  (setq horiz newhoriz)
         ) 
  ); progn horiz
) ; if horiz
(if (= vert nil)
   (progn (setq vert 50)
   (prompt "\nEnter Vertical scale:<")
   (prin1 vert)
   (prompt ">:")
   (setq newvert (getint))
   (if (= newvert nil)
     (setq vert vert)
     (setq vert newvert)
   )
   )
)
(if (= prec nil)
   (progn (setq prec 3)
   (prompt "\nEnter number of decimal places:<")
   (prin1 prec)
   (prompt ">:")
   (setq newprec (getint))
   (if (= newprec nil)
     (setq prec prec)
     (setq prec newprec)
   )
   )
)
(setq ss1 (ssget '((0 . "LINE"))))
(setq n (sslength ss1))
  (setq count 0)
  (repeat n
     (setq a (entget (ssname ss1 count)))
     (setq count (+ count 1)) 
     (setq pt1 (cdr (assoc 10 a)))
     (setq pt2 (cdr (assoc 11 a)))
     (setq ang (angle pt1 pt2))
     (setq dist (distance pt1 pt2))
     (if (> dist 0)
        (progn 
           (setq halfdist (/ dist 2))
           (setq pt3 (polar pt1 ang halfdist))
           (if (> ang pi) (setq ang (- ang pi)))
           (if (> ang (/ pi 2)) (setq pt4ang (- ang (/ pi 2))) (setq pt4ang (+ ang (/ pi 2))))
           (setq pt4 (polar pt3 pt4ang 0.6))
           (if (> ang (/ pi 2)) (setq ang (+ ang pi)))
           ;(setq tang (rtd ang))
            (setq tang ang)
           (setq pt1y (cadr pt1))
           (setq pt2y (cadr pt2))
           (setq pt1x (car pt1))
           (setq pt2x (car pt2))
           (if (> pt1y pt2y) (setq ydist (- pt1y pt2y)) (setq ydist (- pt2y pt1y)))
           (if (> pt1x pt2x) (setq xdist (- pt1x pt2x)) (setq xdist (- pt2x pt1x)))
           (setq xfall (* (/ (* ydist vert) (* xdist horiz)) 100))
           (setq xfall (rtos xfall 2 prec))
           (setq xfall (strcat xfall "%"))
           (command "TEXT" pt4 2.5 tang xfall "")
        );progn
     ):if dist=0
);repeat n
;  (setvar "DIMZIN" dimz)
(setvar "cmdecho" 1)
(setvar "osmode" os)
;  (setq *error* temperr)
(SETVAR "LUNITS" lunitss)
(SETVAR "ANGBASE" angbasee)
(SETVAR "ANGDIR" angdirr)
(SETVAR "LUPREC" luprecc)
(SETVAR "AUNITS" aunitss)
(SETVAR "AUPREC" auprecc)
(princ)
)

Link to comment
Share on other sites

Hi,

....gradient of a line as a dimension or possibly with a leader indicating which way the slope is declining.

Thanks

Norrisad welcome to cadtutor

 

i noticed OP requests gradient with leader, so my attempt

Declining arrow function

argument:

x-scl : x-scale, real

y-scl : y-scale, real

p1 & p2 : point

 

http://www.cadtutor.net/forum/showthread.php?90100-Draw-a-dimension-that-shows-the-gradient-of-line-in&p=617023&viewfull=1#post617023
(defun hp:grad% (x-scl y-scl p1 p2  / txsize os e %val lst mp rot rota pt arr )
;hanhphuc 18/12/14
(setq	txsize (cdr (assoc 40 (tblsearch "style" (getvar "textstyle"))))
os (getvar "osmode" )) ;_ end of setq
 
(if (zerop txsize)
 (setq txsize (getvar "textsize")))
 
(setvar "osmode" 0)
 
 ;; Make Angle Readable      ;credit to ymg       
 (defun MakeReadable (a)
   (setq a (rem (+ a pi pi) (+ pi pi)))
   (rem (if (< (* pi 0.5) a (* pi 1.5))
   (+ a pi)
   a
   ) ;_ end of if
 (+ pi pi)
 ) ;_ end of rem
   ) ;_ end of defun
 
 (if (and 
(vl-every 'vl-consp (list p1 p2))
(setq lst (mapcar '- p1 p2))
(setq %val (if (zerop (car lst))
		nil
		(* (/ x-scl y-scl) (apply '/ (cdr (reverse lst))) 100.)
		) ;_ end of if
	 ) ;_ end of setq
   ) ;_ end of and
   (progn (setq lst  (list p1 p2)
	 mp   (apply 'mapcar (cons ''((a b) (* 0.5 (+ a b))) lst))
	 rot  (MakeReadable (apply 'angle lst))
	 rota (+ rot  (atan (apply '/ (cdr (reverse (getvar "ucsxdir"))))))
	 pt (polar mp (+ rot (/ pi 2.)) (* txsize 3.0))
	 arr  (trans(polar mp (+ rot (/ pi 2.)) (* txsize 1.5)) 1 0 )
	 lst
	 (mapcar '(lambda (x) (trans x 0 1))
		      (list (polar arr rota (* txsize 3.)) (polar arr (+ rota pi) (* txsize 3.)))
		      ) ;_ end of mapcar 
	 ) ;_ end of setq
     
   (entmake (list '(0 . "TEXT")
		  '(8 . "TX%")
		  '(72 . 1) ; justify
		  (cons 1 (strcat (rtos (abs %val) 2 2) " %"))
		  (cons 10 pt)
		  (cons 11 pt) ; justify
		  (cons 40 txsize)
		  (cons 50 rot)
		  ) ; list
	    ) ;entmake

    (apply '(lambda (p1 p2 / obj sz)
	     (if (and p1 p2)
	       (vla-put-ArrowheadSize
		 (setq obj (vlax-ename->vla-object
			     (entmakex (list '(0 . "LEADER")
					     '(100 . "AcDbEntity")
					     '(100 . "AcDbLeader")
					     '(73 . 3)
					     '(8 . "grad")
					     (cons 10 p1)
					     (cons 10 (polar p1
							    (angle p1 p2)
							    (setq sz (distance p1 p2)))); _ end of cons
					     ) ;_ end of list
				       ) ;_ end of entmakex
			     ) ;_ end of vlax-ename->vla-object
		       ) ;_ end of setq
		 (/ sz 3.)
		 ) ;_ end of vla-put-ArrowheadSize
	       ) ;_ end of if
	     ) ;_ end of lambda
	  (if (minusp %val)
	    lst
	    (reverse lst)
	    ) ;_ end of if
	  ) ;_ end of apply
   ) ;_ end of progn
   ) ;_ end of if
 (setvar "osmode" os)
 (princ)
 ) ;_ end of defun

 

command: slope

try line & polyline only

(defun c:slope (/ *error* e e1 lst u dat)
 (defun *error* (msg)
   (if	u
     (princ "\n*cancel*")
     (vl-cmdf "_U")
     ) ;_ end of if
   (princ)
   ) ;_ end of defun
 (if (setq e (entsel "\nPick line.. "))
   (cond ((= (cdr (assoc 0 (setq dat (entget (car e))))) "LINE")
     (apply 'hp:grad% (vl-list* 1. 1. (mapcar ''((x) (cdr (assoc x dat))) '(10 11))))
     )
   ((= (cdr (assoc 0 (entget (car e)))) "LWPOLYLINE")
   (progn (command "_explode" (car e))
	  (setq	e1  (car (nentselp (cadr e)))
		lst (if	(= (cdr (assoc 0 (setq dat (entget e1)))) "LINE")
		      (mapcar ''((x) (cdr (assoc x dat))) '(10 11))
		      ) ;_ end of if
		u   (vl-cmdf "_U")
		) ;_ end of setq
	  (apply 'hp:grad% (vl-list* 1. 1. lst))
	  ) ;_ end of progn
   )
 (t nil) ) ;_ end of cond
   ) ;_ end of if
(princ)
 ) ;_ end of defun
(princ "\ncommand: slope")
(vl-load-com)

 

HTH

Edited by hanhphuc
welcome
Link to comment
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
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  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...