Jump to content

Help me draw slope polyline from 2 text, include: Length + %slope + Arrow?


Recommended Posts

This might get you started

;;; Program to obtain the slope between 2 points
;;; obtaining the length using only the x and y coordinates
;;; 20210914 By Isaac A.
;;; https://www.cadtutor.net/forum/topic/73702-help-me-draw-slope-polyline-from-2-text-include-length-slope-arrow/

(vl-load-com)
(defun c:sl2 (/ alpha dist m m3 teta txt pt11 pt12 pt13 x1 x2 x3 y1 y2 y3 z1 z2 z3)
   (setvar "cmdecho" 0)
   (vl-cmdf "_undo" "_begin")
   (setq olderr *error*
         angbases (getvar "angbase")
         angdirs (getvar "angdir")
         aunitss (getvar "aunits")
         dzin (getvar "dimzin")
         *osnap (getvar "osmode")
   )
   (setvar "angbase" 0)
   (setvar "angdir" 0)
   (setvar "aunits" 0)
   (setvar "dimzin" 0)
   (setq *error* newerror)

   (setvar "osmode" 8)
   (setq pt11 (getpoint "\nPick the first point: ")
         pt12 (getpoint pt11 "\nPick the second point: ")
         y1 (cadr pt11)
         y2 (cadr pt12)
         y3 (/ (+ y1 y2) 2)
         x1 (car pt11)
         x2 (car pt12)
         x3 (/ (+ x1 x2) 2)
         z1 (caddr pt11)
         z2 (caddr pt12)
         z3 (- z2 z1)
         pt13 (list x3 y3)
         dist (sqrt (+ (expt (- x2 x1) 2) (expt (- y2 y1) 2)))
         m3 (abs (* 100 (/ z3 dist)))
         txt (strcat "L="(rtos dist 2 3)"m   i=" (rtos m3 2 2) "%" ))
   (if (/= x1 x2)
      (setq m (/ (- y2 y1) (- x2 x1))
            teta (atan (abs (/ (- y2 y1) (- x2 x1))))
            teta (angtos teta 0 4)
      )
   )
   (if (and (> y1 y2) (> x1 x2))
         (setq teta (atof teta)
               alpha (+ 180 teta)
               alpha (rtos alpha 2 4))
   )
   (if (and (< y1 y2) (< x1 x2))
      (setq alpha teta)
   )
   (if (and (> y1 y2) (< x1 x2))
         (setq teta (atof teta)
               alpha (* -1 teta)
               alpha (rtos alpha 2 4))
   )
   (if (and (< y1 y2) (> x1 x2))
         (setq teta (atof teta)
               alpha (- 180 teta)
               alpha (rtos alpha 2 4))
   )
   (if (and (= y1 y2) (< x1 x2))
      (setq alpha 0)
   )
   (if (and (= y1 y2) (> x1 x2))
      (setq alpha 180)
   )
   (if (and (> y1 y2) (= x1 x2))
      (setq alpha 270)
   )
   (if (and (< y1 y2) (= x1 x2))
      (setq alpha 90)
   )

   (setvar "osmode" 0)
   (vl-cmdf "-style" "times" "times new roman" "0" "1" "" "" "")
   (vl-cmdf "text" "j" "bc" pt13 "0.5" alpha txt)
   (vl-cmdf "line" pt11 pt12 "")

   (setvar "angbase" angbases)
   (setvar "angdir" angdirs)
   (setvar "aunits" aunitss)
   (setvar "dimzin" dzin)
   (setvar "osmode" *osnap)
   (setq *error* olderr)

   (vl-cmdf "_undo" "_end")
   (princ)
)

 

  • Like 1
Link to post
Share on other sites
2 hours ago, Isaac26a said:

This might get you started




;;; Program to obtain the slope between 2 points
;;; obtaining the length using only the x and y coordinates
;;; 20210914 By Isaac A.
;;; https://www.cadtutor.net/forum/topic/73702-help-me-draw-slope-polyline-from-2-text-include-length-slope-arrow/

(vl-load-com)
(defun c:sl2 (/ alpha dist m m3 teta txt pt11 pt12 pt13 x1 x2 x3 y1 y2 y3 z1 z2 z3)
   (setvar "cmdecho" 0)
   (vl-cmdf "_undo" "_begin")
   (setq olderr *error*
         angbases (getvar "angbase")
         angdirs (getvar "angdir")
         aunitss (getvar "aunits")
         dzin (getvar "dimzin")
         *osnap (getvar "osmode")
   )
   (setvar "angbase" 0)
   (setvar "angdir" 0)
   (setvar "aunits" 0)
   (setvar "dimzin" 0)
   (setq *error* newerror)

   (setvar "osmode" 8)
   (setq pt11 (getpoint "\nPick the first point: ")
         pt12 (getpoint pt11 "\nPick the second point: ")
         y1 (cadr pt11)
         y2 (cadr pt12)
         y3 (/ (+ y1 y2) 2)
         x1 (car pt11)
         x2 (car pt12)
         x3 (/ (+ x1 x2) 2)
         z1 (caddr pt11)
         z2 (caddr pt12)
         z3 (- z2 z1)
         pt13 (list x3 y3)
         dist (sqrt (+ (expt (- x2 x1) 2) (expt (- y2 y1) 2)))
         m3 (abs (* 100 (/ z3 dist)))
         txt (strcat "L="(rtos dist 2 3)"m   i=" (rtos m3 2 2) "%" ))
   (if (/= x1 x2)
      (setq m (/ (- y2 y1) (- x2 x1))
            teta (atan (abs (/ (- y2 y1) (- x2 x1))))
            teta (angtos teta 0 4)
      )
   )
   (if (and (> y1 y2) (> x1 x2))
         (setq teta (atof teta)
               alpha (+ 180 teta)
               alpha (rtos alpha 2 4))
   )
   (if (and (< y1 y2) (< x1 x2))
      (setq alpha teta)
   )
   (if (and (> y1 y2) (< x1 x2))
         (setq teta (atof teta)
               alpha (* -1 teta)
               alpha (rtos alpha 2 4))
   )
   (if (and (< y1 y2) (> x1 x2))
         (setq teta (atof teta)
               alpha (- 180 teta)
               alpha (rtos alpha 2 4))
   )
   (if (and (= y1 y2) (< x1 x2))
      (setq alpha 0)
   )
   (if (and (= y1 y2) (> x1 x2))
      (setq alpha 180)
   )
   (if (and (> y1 y2) (= x1 x2))
      (setq alpha 270)
   )
   (if (and (< y1 y2) (= x1 x2))
      (setq alpha 90)
   )

   (setvar "osmode" 0)
   (vl-cmdf "-style" "times" "times new roman" "0" "1" "" "" "")
   (vl-cmdf "text" "j" "bc" pt13 "0.5" alpha txt)
   (vl-cmdf "line" pt11 pt12 "")

   (setvar "angbase" angbases)
   (setvar "angdir" angdirs)
   (setvar "aunits" aunitss)
   (setvar "dimzin" dzin)
   (setvar "osmode" *osnap)
   (setq *error* olderr)

   (vl-cmdf "_undo" "_end")
   (princ)
)

 

Thank you so much.
Excuse me, can you edit help me, i want to select between 2 text, not pick?

Edited by tuantrinhdp
Link to post
Share on other sites
Jonathan Handojo
(defun c:foo (/ 90d a ang len mpt off pts s2 siz ss txt vec wid _2p)
    (setq
        wid 10      ; arrow width
        siz 50      ; arrowhead width. Text offset from line is half of this.
        
        ;; ----------------------------------- ;;
        
        off (* 0.5 siz)
        90d (* pi 0.5)
        s2 (* siz 2)
    )
    (defun _2p (p) (list (car p) (cadr p)))
    (while
        (cond
            (   (not (setq ss (ssget '((0 . "TEXT"))))) nil)
            (   (not (= (sslength ss) 2)) (princ "\nSelect only two texts."))
            (   (setq pts (mapcar '(lambda (a) (cdr (assoc 10 (entget (ssname ss a))))) '(0 1)))
                (if (> (caar pts) (caadr pts)) (setq pts (reverse pts)))
                (setq mpt (mapcar '/ (apply 'mapcar (cons '+ pts)) '(2.0 2.0 2.0))
                      vec (apply 'mapcar (cons '- pts))
                      ang (apply 'angle pts)
                      txt (list
                                '(0 . "TEXT")
                                (assoc 40 (entget (ssname ss 0)))
                                (cons 1 
                                    (strcat 
                                        "L=" (rtos (/ (apply 'distance pts) 1000) 2 3) "m, "
                                        "i=" (rtos (* 100 (/ (cadr vec) (car vec))) 2 3) "%"
                                    )
                                )
                                (cons 7 (getvar "textstyle"))
                            )
                      len (textbox txt)
                      len (* 0.5 (- (caadr len) (caar len)))
                )
                (entmake (append txt (list (cons 10 (polar (polar mpt (+ 90d ang) off) (+ ang pi) len)) (cons 50 ang))))
                (entmake (cons '(0 . "LINE") (mapcar 'cons '(10 11) pts)))
                (setq mpt (polar mpt (- ang 90d) (+ siz off)))
                (entmake
                    (list
                        '(0 . "LWPOLYLINE")
                        '(100 . "AcDbEntity")
                        '(100 . "AcDbPolyline")
                        '(90 . 3)
                        '(70 . 0)
                        (cons 10 (_2p (polar mpt (+ ang pi) len)))
                        (cons 40 wid)
                        (cons 41 wid)
                        '(42 . 0.0)
                        (cons 10 (_2p (polar mpt ang len)))
                        (cons 40 s2)
                        '(41 . 0.0)
                        '(42 . 0.0)
                        (cons 10 (_2p (polar mpt ang (+ len siz))))
                        '(40 . 0.0)
                        '(41 . 0.0)
                        '(42 . 0.0)
                    )
                )
            )
        )
    )
    (princ)
)

 

Edited by Jonathan Handojo
  • Like 1
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.   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...