Lisp for SLOPE

[Bin2009]

Hello

We need draw slope symbol for each profile drawing, I try to write a lisp, when I pick up 2 points, form ground profile, the slope triangle with slope calculate (SLOPE XX%) show on the drawing, the formula for slope is : xx%=∆y/∆x.

I wrote a lisp as below, the result come out as PIC1, but I want result looks as PIC 2, text show SLOPE 36% instead 36.13 I don’t know how to combine the text SLOPE with my calculation 36.13, and how to get rid off the decimal.

(defun c:mcir()

(setvar "cmdecho" 0)

(setq pt1 (getpoint "Enter left Point:"))

(setq px1 (car pt1))

(setq py1 (cadr pt1))

(setq pt2 (getpoint "Enter right Point:"))

(setq px2 (car pt2))

(setq py2 (cadr pt2))

(setq px3 (+ px1 10))

(setq pt3 (list px3 py1))

(setq myb (- px2 px1))

(setq px4 (+ px1 10))

(setq mya (- py2 py1))

(setq myb (- px2 px1))

(setq py4 (+ py1 (* (/ mya myb) 10)))

(setq pt4 (list px4 py4))

(command "pline" pt1 pt3 pt4 "c")

(setq px5 (/ (+ px1 px4) 2))

(setq py5 (/ (+ py1 py4) 2))

(setq pt5 (list px5 py5))

(setq ang (angle pt1 pt2))

(setq ann (/ (* ang 180) 3.14 ))

(setq slp (* 100 (/ mya myb)))

(command "text" pt5 2.5 ann slp)

(prin1)

)

In PIC1, all the red text and dimension are reference.

Thank very much for your help in advance.

Bin

[SeeMSixty7]

You can just use (fix ann) it will truncate the decimal. It will not round it though. so (33.9) would be 33.

Another option would be to use (setq ann (ANGTOS ang 0 0))

Angtos will round appropriately, and take care of the conversion from Radians to Decimal Degrees.

Good Luck,

[Ranjit_Singh · Accepted solution]

Many ways to do this and you may find several variations in these forums and on google. One example below. Minimal testing done. Note that rising slopes are positive and falling are negative (based on the sequence of pick points)

;;Ranjit Singh
;;5/25/17

(defun c:somefunc  (/ pt1 pt2)
 (entmakex
  (list '(0 . "MTEXT")
        '(100 . "AcDbEntity")
        '(100 . "AcDbMText")
        (cons 10 (mapcar '+ (list 0 (/ (getvar 'textsize) 2.0)) (mapcar '/ (mapcar '+ (setq pt1 (getpoint)) (setq pt2 (getpoint))) '(2 2))))
        (cons 1 (strcat "SLOPE "(rtos ((lambda (x) (* -100 (/ (cadr x) (abs (car x))))) (mapcar '- pt1 pt2)) 2 0) "%"))
        '(71 . 8)
        (cons 50 (if (> (car pt1) (car pt2)) (+ pi (angle pt1 pt2)) (angle pt1 pt2))))))

[ademercan1]

(defun c:sl (/ p1 dc ms p2 ag ds p3 ls tx pt) (vl-load-com)
  (if (setq p1 (getpoint "\nSpecify first point:"))
    (if (setq dc (vlax-get (vlax-get-acad-object) 'activedocument)
          ms (vlax-get dc 'modelspace) p2 (getpoint "\nSpecify next point:"))
      (progn (vla-startundomark dc)
        (setq ag (angle p1 p2) ds (abs (- (car p1) (car p2))) p3 (cond
          ((< 0 ag (/ pi 2)) (polar p1 0 ds))
          ((< (/ pi 2) ag pi) (polar p1 pi ds))
          ((< pi ag (+ pi (/ pi 2))) (polar p2 0 ds))
          ((< (+ pi (/ pi 2)) ag (* 2 pi)) (polar p2 pi ds))))
        (vla-put-Closed (vla-addLightWeightPolyline ms (vlax-safearray-fill
          (vlax-make-safearray vlax-vbdouble (cons 0 (1- (length (setq ls (list
            (car p1) (cadr p1) (car p2) (cadr p2) (car p3) (cadr p3))))))) ls)) -1)
        (setq tx (vlax-invoke ms 'addtext (strcat "SLOPE " (rtos (abs (* 100 (/ (-
          (cadr p1) (cadr p2)) (- (car p1) (car p2))))) 2 0) "%")
            (setq pt (polar (mapcar '(lambda(a b) (/ (+ a b) 2)) p1 p2)
              (if (< (/ pi 2) ag (+ pi (/ pi 2))) (+ ag (+ pi (/ pi 2)))
                (+ ag (/ pi 2))) 35)) 25))
        (vla-put-Alignment tx 10) (vla-put-TextAlignmentPoint tx (vlax-3d-point pt))
        (vla-put-Rotation tx (if (< (/ pi 2) ag (+ pi (/ pi 2))) (+ ag pi) ag))
        (vla-endundomark dc)
      )
    )
  ) (prin1)
)

[john.uhden]

@Ranjit_Singh's response is probably the best.  If you use a vertical scale factor other than 1.0 (I usually use 10.0), then divide the dy/dx division by another 10.  I am not used to grading or pipe profiles having a 36% grade.

I think an improvement would be to be able to pick just the line (or polyline) segment rather than having to make two picks.  You may also have to translate coordinates from some UCS to World or vice versa.  In fact if the profile continues via a meandering polyline, then you could label all the tangents with one command.

[Bin2009]

Thank for your reply and explain, it's very useful.

This slope symbol is special one which we use to mark the elevation change in work space, where on the mountain area, someplace is really steep, the ground profile is for section of the pipeline. Yes the pipe is hard to change elevation like that.

Pick a line is a great idea, I will try it.

Thanks a lot!

Bin

[Bin2009]

Thank!

the  (setq ann (ANGTOS ang 0 0)) is what I am looking for! I will try it tomorrow  when I go to work, 

Bin

[Bin2009]

Thanks, your lisp looks great!

I am a beginner, only know some simple function, your function looks more powerful, definitely I need study on it!

Thanks!

Bin 

[ВeekeeCZ]

Well, since none of these routines does the zero proof, the all programs fails if you try to do that.

The @ademercan1's routine fails even if the slope is 0.

[braudpat]

Hello

An other version of Slope - Routine: SlopePC from Gilles (gile)

Thanks Gilles, Regards, Patrice

 
;; 
;; Routine: SlopePC       - PentePC 
;; Create a Text Object   - Cree un objet texte le long de la pente 
;; CLIC on 2 Points       - Il suffit de cliquer 2 points 
;; Par GC (gile) le 08/06/2009 (French Forum: cadxp.com) 
;; 
;; Change TEXTSIZE variable BEFORE running to get the right height for Text
;; 

 
(defun c:SlopePC (/ p1 p2 a)

  (if
    (and
      (setq p1 (getpoint "\n1st Point: "))
      (setq p2 (getpoint "\n2nd Point: "))
      (setq a (angle p1 p2))
    )
     (entmake
       (list
	 '(0 . "TEXT")
	 '(100 . "AcDbEntity")
	 '(100 . "AcDbText")
	 '(10 0. 0. 0.)
	 (cons 40 (getvar 'textsize))
	 (cons 1
	       (strcat (rtos (abs (* 100 (/ (sin a) (cos a)))) 2 2) " %")
	 )
	 (cons 50
	       (if (minusp (cos a))
		 (+ pi a)
		 a
	       )
	 )
	 '(72 . 1)
	 (cons 11 (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.)) p1 p2))
	 '(73 . 1)
       )
     )
  )
  (princ)
)
 

[Bin2009]

Your lisp works great for me in Civil 3D, thank a lot!

I need run this lisp in civil 3d, all other lisp post here are work great in Autocad, but only yours work properly in Civil3D, I don’t know why and trying to figure out.

Bin

[robert.maxfieldCHK7M]

Does anyone have a version of this that has Annotative Text (scaling)? 

Thanks

Rob

[kibitotato]

doesnt´work in spanish autocad...

works with other ucs???