Slope arrow

[woodman78]

We used to have a routine in VB for indicating the slope of a line in % terms. The guy who wrote it has left the office and I know even less about VB compared to lisp. I was wondering if someone could write a lisp to produce the arrow ad text as shown in the attached file based on the current textstyle and dimstyle?

 

Thanks.

[lpseifert]

Aw give it a try... I'm sure someone here will help if you get stuck.

 

This might help you get started

;;;returns slope of line/polyline in profile LPS with help from ronjomp 2008
(defun c:sl ()
 (vl-load-com)
 (setq ent (entsel))
 (if (= (cdr (assoc 0 (entget (car ent)))) "LINE")
   (progn
     (setq lst     (entget (car ent))
       pt1     (cdr (assoc 10 lst))
       pt2     (cdr (assoc 11 lst))
       x1     (car pt1)
       y1     (cadr pt1)
       x2     (car pt2)
       y2     (cadr pt2)
       dy     (- y2 y1)
       dx     (- x2 x1)
       slp     (* 100 (/ dy dx))
       slp2 (/ dx dy)
       txtx (rtos (abs dx) 2 2)
       txty (rtos dy 2 2)
       txts (rtos slp 2 2)
       txts2 (rtos slp2 2 2)
     )                    ;setq
   )                    ;progn
   (progn
     (setq pt    (osnap (cadr ent) "nea")
       ent    (car ent)
     )                    ;setq
     (defun getadjacentplinevertices (ent pt / i p1 p2)
   (if (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
     (progn
       (setq i  (fix (vlax-curve-getParamAtPoint
               ent
               (vlax-curve-getClosestPointTo ent pt)
             )
            )
         p1 (vlax-curve-getPointAtParam ent i)
         p2 (vlax-curve-getPointAtParam ent (+ 1 i))
       )
       (setq ls1 (list p1 p2))
     )                ;progn
   )                ;if
     )                    ;defun
     (getadjacentplinevertices ent pt)
     (setq p1x     (car (car ls1))
       p1y     (cadr (car ls1))
       p2x     (car (cadr ls1))
       p2y     (cadr (cadr ls1))
       dx     (- p2x p1x)
       dy     (- p2y p1y)
       slp     (* 100 (/ dy dx))
       slp2 (/ dx dy)
       txtx (rtos (abs dx) 2 2)
       txty (rtos dy 2 2)
       txts (rtos slp 2 2)
       txts2 (rtos slp2 2 2)
     )                    ;setq
   )                    ;progn
 )                    ;if
 (prompt (strcat "\nHorizontal distance = " txtx "'"
                "\nRelief = " txty "'"
                "\nSlope is " txts "%..." txts2 ":1")
)
   
(princ)
)

[woodman78]

Thanks, this has the basics of what i need but can it be put in the format as per my image at the start of the post??

[lpseifert]

Yes it can... did you give an attempt to do it?

[woodman78]

to be honest i wouldn't know where to begin.....

[woodman78]

Can anyone help with this???

[fixo]

Can anyone help with this???

Try this one

Text height will the same as for the current dimension style text height

 

;; draw arrow w/slop
(defun c:das (/ ang coords dx dy elist en ent ldlist ldpt
        mpt p1 p2 pline seg_num slp sorted txpt
        txtang txth txts unsorted)
(while
 (setq ent
 (entsel
   "\nSelect desired segment of the polyline (or pres Enter to Exit): ")
)
  (if (eq "LWPOLYLINE"
   (cdr (assoc 0 (setq elist (entget (setq en (car ent)))))))
    (progn
      (setq coords (vl-remove-if
       (function not)
       (mapcar (function (lambda (x)
      (if (= 10 (car x))
        (cdr x))))
        elist)))
      (setq
 seg_num (1+ (fix (vlax-curve-getparamatpoint
      en
      (vlax-curve-getclosestpointto en (cadr ent))))))
      (setq p2       (nth (1- seg_num) coords)
     p1       (nth seg_num coords)
     unsorted (list p2 p1)
     )
      (setq sorted (vl-sort unsorted
       (function (lambda (a b) (< (car a) (car b)))))
     p1     (car sorted)
     p2     (cadr sorted)
     mpt    (mapcar (function (lambda (a b) (/ (+ a b) 2)))
      p2
      p1)
     )
      (setq dx   (- (car p2) (car p1))
     dy   (- (cadr p2) (cadr p1))
     slp  (* 100 (/ dy dx))
     txts (rtos (abs slp) 2 2)
     )
      (setq ang  (angle p1 p2)
     txth (getvar "DIMTXT");<-- you can change the text height here
     )
      (setq ldpt   (polar mpt (+ ang (/ pi 2)) txth)
     txpt   (polar mpt (+ ang (/ pi 2)) (* txth 2))
     txtang (* ang (/ 180.0 pi))
     )
      (command "_.MTEXT"
 txpt
 "_H"
 txth
 "_J"
 "_BC"
 "_R"
 txtang
 "_non"
 txpt
 (strcat (rtos slp 2 2) "%")
 "")
      (setq ldlist
     (list
       (list (* txth 2) 0.)
       (list (* -2 txth) 0.)
       (list (* -2 txth) (/ txth 3))
       (list (* -5 txth) 0.)
       (list (* -2 txth) (/ txth -3))
       (list (* -2 txth) 0.)
       )
     ldlist (mapcar (function (lambda (x) (mapcar '+ ldpt x))) ldlist)
     )
      (entmake
 (append
   (list
     '(0 . "LWPOLYLINE")
     '(100 . "AcDbEntity")
     '(8 . "0")
     '(100 . "AcDbPolyline")
     (cons 90 (length ldlist))
     (cons 70 0)
     (cons 43 0.0)
     )
   (mapcar '(lambda (x) (cons 10 x)) ldlist)
   )
 )
      (setq pline (entlast))
      (command "_.ROTATE"
 pline
 ""
 "_non"
 ldpt
 (if (minusp slp)
   (+ txtang 180)
   txtang))
      )
    )
  )
 (princ)
 )

 

~'J'~

[woodman78]

That's exactly what i was looking for Fixo. Thanks

[fixo]

That's exactly what i was looking for Fixo. Thanks

Check slope calculation coz I'm not a big math

 

~'J'~

[woodman78]

I'll check it Fixo. I was wondering if you could make a version that would display the slope based on Z values of coords and put a small "v" after the %. I am wokring using 3d polylines a lot at the moment and that would be great.

 

Thanks

[stevesfr]

Check slope calculation coz I'm not a big math

 

~'J'~

 

Math is fine. Slope is accurately reported.

[fixo]

Math is fine. Slope is accurately reported.

Thanks for confirmation

 

Cheers

 

~'J'~