1. ## Slope routine

Registered forum members do not see this ad.

Hello im new on this, i just whant help for a lisp routine that draw a slope.

I already try a lot of them but doesnt work correctly.

Thank´s

2. Could you provide us with more detail please? And be as specific as possible. Thank you.

3. Ok, i try many routines but they bring the message "this is not a polyline" but in fact the line that i indicate was a polyline.

4. Give this a try
Code:
```Code:
;|--------------Inclination of line-------------------
q_|_|| _\|| q_|| _\|

يقوم بتحديد ميل الخط من خلال اختيار نقطتين عليه
و من الممكن ان يختار المستخدم
بين ان يرسم خط بين النقطتين او لا

------------------------------------------------------
Author: Hasan M. Asous, 2010
------------------------------------------------------
Version: 1     20 Oct 2010
____________________________________________________|;
;     q_|_|| _\|| q_|| _\|     ;
;       Mainroutine Start      ;
(defun c:TanLine (/ p1 p2 p3)
(HSN:DDwnMnuSetSysVar)
(and
(setq doc (cond (doc) ((vla-get-ActiveDocument (vlax-get-Acad-Object)))))
(setq spc (if (zerop (vla-get-activespace doc))
(if (= (vla-get-mspace doc) :vlax-true) (vla-get-modelspace doc) (vla-get-paperspace doc))
(vla-get-modelspace doc)))
)

(if (not TL-sel) (setq TL-sel "Points"))
(initget "select Line or Points")
(setq TL-sel (cond ( (getkword (strcat "\nChoose  هل تريد تحديد خط او اختيار نقطتين [Line/Points] <" TL-sel ">: ") ) ) ( TL-sel ) ))
(if (equal TL-sel "Points")
(progn
(and
(setq p1 (trans (getpoint "\nFirst Point اختار النقطة الاولى على الخط ")1 0))
(setq p2 (trans (getpoint p1 "\nSecond Point اختار النقطة الثانية على الخط")1 0))
(setq p3 (trans (getpoint "\nText insertion Point قم بتحديد مكان النص")1 0))
)
(setq tan2 (/ (- (cadr p2) (cadr p1)) (- (car p2) (car p1))))
(setq h 220)
(setq h 22)
(setq h 2.2)))
(if (not TL-Line) (setq TL-Line "Yes"))
(initget "Yes No")
(setq TL-Line (cond ( (getkword (strcat "\nChoose هل تريد رسم خط بين النقطتين [Yes/No] <" TL-Line ">: ") ) ) ( TL-Line ) ))
(if (equal TL-Line "Yes")
(progn
(HSN:TL-Text h)
(HSN:TL-Line)
)
(progn
(HSN:TL-Text h)
)
)
)
(progn
(setq TL:SS (entget (car (entsel))))
(if (and
(equal TL-sel "Line")
(equal (cdr (assoc 0 TL:SS)) "LINE")
)
(Progn
(setq p1 (cdr (assoc 10 TL:SS)))
(setq p2 (cdr (assoc 11 TL:SS)))
(setq p3 (trans (getpoint "\nText insertion Point قم بتحديد مكان النص")1 0))
(setq tan2 (/ (- (cadr p2) (cadr p1)) (- (car p2) (car p1))))
(HSN:TL-Text)
)
(progn
(princ "\n  PLease Seect a line or Points")
)
)
)
)
(HSN:ReDDwnMnuSetSysVar)
(vla-EndUndoMark ActDoc)
)
;     q_|_|| _\|| q_|| _\|     ;
;       Mainroutine End        ;
;     q_|_|| _\|| q_|| _\|     ;
;       Subroutine Start       ;
(defun *error* (msg)
(and uFlag (vla-EndUndoMark doc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ)
)
(defun HSN:DDwnMnuSetSysVar ()
(setq OldOS (getvar "osmode"))
(setq OldDynmode (getvar "dynmode"))
(setq OldDynprompt (getvar "dynprompt"))

(setvar "osmode" 33)
(setvar "dynmode" 1)
(setvar "dynprompt" 1)
(setvar "cmdecho" 0)
)
(defun HSN:ReDDwnMnuSetSysVar ()
(setq *error* TERR\$)
(setvar "osmode" OldOS)
(setvar "dynmode" OldDynmode)
(setvar "dynprompt" OldDynprompt)
)
(defun HSN:TL-Text (H)
(entmakex (list
(cons 0 "TEXT")
(cons 10  p3)
(cons 40 H)
(cons 1 (strcat (rtos (abs (* tan2 100))2 2) "%"))
))
)
(defun HSN:TL-Line ()
(entmake (list
(cons 0 "LINE")
(cons 10 p1)
(cons 11 p2)
))
)
;     q_|_|| _\|| q_|| _\|     ;
;        Subroutine End        ;
(princ "\n     ...Type TanLine to Invoke...   ")
(princ)```

5. Originally Posted by asos2000
Give this a try
Code:
```Code:
;|--------------Inclination of line-------------------
q_|_|| _\|| q_|| _\|

يقوم بتحديد ميل الخط من خلال اختيار نقطتين عليه
و من الممكن ان يختار المستخدم
بين ان يرسم خط بين النقطتين او لا

------------------------------------------------------
Author: Hasan M. Asous, 2010
------------------------------------------------------
Version: 1     20 Oct 2010
____________________________________________________|;
;     q_|_|| _\|| q_|| _\|     ;
;       Mainroutine Start      ;
(defun c:TanLine (/ p1 p2 p3)
(HSN:DDwnMnuSetSysVar)
(and
(setq doc (cond (doc) ((vla-get-ActiveDocument (vlax-get-Acad-Object)))))
(setq spc (if (zerop (vla-get-activespace doc))
(if (= (vla-get-mspace doc) :vlax-true) (vla-get-modelspace doc) (vla-get-paperspace doc))
(vla-get-modelspace doc)))
)

(if (not TL-sel) (setq TL-sel "Points"))
(initget "select Line or Points")
(setq TL-sel (cond ( (getkword (strcat "\nChoose  هل تريد تحديد خط او اختيار نقطتين [Line/Points] <" TL-sel ">: ") ) ) ( TL-sel ) ))
(if (equal TL-sel "Points")
(progn
(and
(setq p1 (trans (getpoint "\nFirst Point اختار النقطة الاولى على الخط ")1 0))
(setq p2 (trans (getpoint p1 "\nSecond Point اختار النقطة الثانية على الخط")1 0))
(setq p3 (trans (getpoint "\nText insertion Point قم بتحديد مكان النص")1 0))
)
(setq tan2 (/ (- (cadr p2) (cadr p1)) (- (car p2) (car p1))))
(setq h 220)
(setq h 22)
(setq h 2.2)))
(if (not TL-Line) (setq TL-Line "Yes"))
(initget "Yes No")
(setq TL-Line (cond ( (getkword (strcat "\nChoose هل تريد رسم خط بين النقطتين [Yes/No] <" TL-Line ">: ") ) ) ( TL-Line ) ))
(if (equal TL-Line "Yes")
(progn
(HSN:TL-Text h)
(HSN:TL-Line)
)
(progn
(HSN:TL-Text h)
)
)
)
(progn
(setq TL:SS (entget (car (entsel))))
(if (and
(equal TL-sel "Line")
(equal (cdr (assoc 0 TL:SS)) "LINE")
)
(Progn
(setq p1 (cdr (assoc 10 TL:SS)))
(setq p2 (cdr (assoc 11 TL:SS)))
(setq p3 (trans (getpoint "\nText insertion Point قم بتحديد مكان النص")1 0))
(setq tan2 (/ (- (cadr p2) (cadr p1)) (- (car p2) (car p1))))
(HSN:TL-Text)
)
(progn
(princ "\n  PLease Seect a line or Points")
)
)
)
)
(HSN:ReDDwnMnuSetSysVar)
(vla-EndUndoMark ActDoc)
)
;     q_|_|| _\|| q_|| _\|     ;
;       Mainroutine End        ;
;     q_|_|| _\|| q_|| _\|     ;
;       Subroutine Start       ;
(defun *error* (msg)
(and uFlag (vla-EndUndoMark doc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ)
)
(defun HSN:DDwnMnuSetSysVar ()
(setq OldOS (getvar "osmode"))
(setq OldDynmode (getvar "dynmode"))
(setq OldDynprompt (getvar "dynprompt"))

(setvar "osmode" 33)
(setvar "dynmode" 1)
(setvar "dynprompt" 1)
(setvar "cmdecho" 0)
)
(defun HSN:ReDDwnMnuSetSysVar ()
(setq *error* TERR\$)
(setvar "osmode" OldOS)
(setvar "dynmode" OldDynmode)
(setvar "dynprompt" OldDynprompt)
)
(defun HSN:TL-Text (H)
(entmakex (list
(cons 0 "TEXT")
(cons 10  p3)
(cons 40 H)
(cons 1 (strcat (rtos (abs (* tan2 100))2 2) "%"))
))
)
(defun HSN:TL-Line ()
(entmake (list
(cons 0 "LINE")
(cons 10 p1)
(cons 11 p2)
))
)
;     q_|_|| _\|| q_|| _\|     ;
;        Subroutine End        ;
(princ "\n     ...Type TanLine to Invoke...   ")
(princ)```

Your routine is not returning the Dynamic Input as it was adjusted before .
And the option for Points is not working at the first time you start the routine .
An error return at the end of the routine ...

Command: TANLINE
Choose ?? ???? ????? ?? ?? ?????? ?????? [Line/Points] <Line>: P
First Point ????? ?????? ?????? ??? ????
Second Point ????? ?????? ??????? ??? ????
Text insertion Point ?? ?????? ???? ????
Choose ?? ???? ??? ?? ??? ???????? [Yes/No] <Yes>:
; error: bad argument type: VLA-OBJECT nil
Why do not you rotate the insertion text according to line rotation slope or selected points .

6. And also all the following system variables are not re-set as they were before .
Code:
``` (setvar "osmode" 33)
(setvar "dynmode" 1)
(setvar "dynprompt" 1)
(setvar "cmdecho" 0)```

Thanks.

Tharwat

Second comment I can handle

Thanks

8. Originally Posted by asos2000
Second comment I can handle

Thanks
You're welcome .

Check this out , Do not hesitate to ask if you have any question .

Code:
```(defun c:TanLine (/ doc spc *error* TH:UnDo TH:StartUnDo p1 p2 p3 tan2 TL-Line TH:UnDo)
(and (setq doc (cond (doc) ((vla-get-ActiveDocument (vlax-get-Acad-Object)))))
(setq spc (if (zerop (vla-get-activespace doc))
(if (= (vla-get-mspace doc) :vlax-true) (vla-get-modelspace doc) (vla-get-paperspace doc))
(vla-get-modelspace doc)))
)
(defun *error* (msg)
(and TH:UnDo (vla-EndUndoMark doc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ)
)
(setq TH:StartUnDo (vla-StartUndoMark doc))
(initget "Line Points")
(if (eq (setq TL-sel (getkword (strcat "\nChoose [Line/Points]: " "< Line >"))) "Points")
(progn
(setq p1 (getpoint "\n First Point  "))
(setq p2 (getpoint p1 "\n Second Point "))
(setq p3 (getpoint "\n Text insertion Point "))
(setq tan2 (/ (- (cadr p2) (cadr p1)) (- (car p2) (car p1))))
(entmake (list (cons 0 "LINE")(cons 10 (trans p1 1 0))(cons 11 (trans p2 1 0))))
(entmake (list (cons 0 "TEXT")(cons 10 (trans p3 1 0)) (cons 40 (getvar 'textsize))
(cons 1 (strcat (rtos (abs (* tan2 100))2 2) "%"))))
)
(progn
(prompt "\n please Select Line : ")
(setq TL-Line (ssget '((0 . "LINE"))))
(setq e (ssname TL-Line 0))
(setq p1 (cdr (assoc 10 (entget e))))
(setq p2 (cdr (assoc 11 (entget e))))
(setq p3 (getpoint "\nText insertion Point "))
(setq tan2 (/ (- (cadr p2) (cadr p1)) (- (car p2) (car p1))))
(entmake (list (cons 0 "TEXT")(cons 10 (trans p3 1 0)) (cons 40 (getvar 'textsize))
(cons 1 (strcat (rtos (abs (* tan2 100))2 2) "%"))))
)
)
(setq TH:UnDo (vla-EndUndoMark Doc))
(princ "\n Modified by Tharwat")
(princ)
)```
Enjoy the codes.

Tharwat

9. ## It acurate

The code is wonderful it give you the correct answer (slope reading)

Can I wish to get the answer in 4 decimals and in option of inserting the text or showing message for the reading.

Thanks

10. Registered forum members do not see this ad.

Originally Posted by athabe
The code is wonderful it give you the correct answer (slope reading)

Can I wish to get the answer in 4 decimals and in option of inserting the text or showing message for the reading.

Thanks
Which routine you have used and worked for you ? ( the post number )

#### Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts