Slope routine

**worknet** · 22nd Dec 2010 04:58 pm

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

**ReMark** · 22nd Dec 2010 05:03 pm

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

**worknet** · 22nd Dec 2010 05:18 pm

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.

**asos2000** · 22nd Dec 2010 06:19 pm

Give this a try

Code:

Code:
;|--------------Inclination of line-------------------
                q_|_|| _\|| q_|| _\|                  
                                                      
  يقوم بتحديد ميل الخط من خلال اختيار نقطتين عليه      
                   و من الممكن ان يختار المستخدم      
                بين ان يرسم خط بين النقطتين او لا      
                                                      
------------------------------------------------------
  Author: Hasan M. Asous, 2010                        
  Copyright © 2010 by HasanCAD, All Rights Reserved.  
  Contact: HasanCAD @ TheSwamp.org,                   
           asos2000 @ CADTutor.net                    
           HasanCAD@gmail.com                         
------------------------------------------------------
  Version: 1     20 Oct 2010                          
____________________________________________________|;
;     q_|_|| _\|| q_|| _\|     ;
;       Mainroutine Start      ;
(defun c:TanLine (/ p1 p2 p3)
  ; @ HasanCAD
  (vl-load-com)
  (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))))
      (IF (< 1000 (ABS (- (cadr p2) (cadr p1))))
 (setq h 220)
 (if (< 100 (ABS (- (cadr p2) (cadr p1))))
   (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 ()
  ; @ HasanCAD
  (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 ()
  ; @ HasanCAD
  (setq *error* TERR$)
  (setvar "osmode" OldOS)
  (setvar "dynmode" OldDynmode)
  (setvar "dynprompt" OldDynprompt)
  )
(defun HSN:TL-Text (H)
  ; @ HasanCAD
       (entmakex (list
     (cons 0 "TEXT")
                   (cons 10  p3)
                   (cons 40 H)
                   (cons 1 (strcat (rtos (abs (* tan2 100))2 2) "%"))
     ))
  )
(defun HSN:TL-Line ()
  ; @ HasanCAD
       (entmake (list
    (cons 0 "LINE")
                  (cons 10 p1)
                  (cons 11 p2)
    ))
  )
;     q_|_|| _\|| q_|| _\|     ;
;        Subroutine End        ;
(princ "\n  TanLine.lsp ~ Copyright © by HasanCAD")
(princ "\n     ...Type TanLine to Invoke...   ")
(princ)

**Tharwat** · 22nd Dec 2010 07:12 pm

Originally Posted by asos2000

Give this a try

Code:

Code:
;|--------------Inclination of line-------------------
                q_|_|| _\|| q_|| _\|                  
                                                      
  يقوم بتحديد ميل الخط من خلال اختيار نقطتين عليه      
                   و من الممكن ان يختار المستخدم      
                بين ان يرسم خط بين النقطتين او لا      
                                                      
------------------------------------------------------
  Author: Hasan M. Asous, 2010                        
  Copyright © 2010 by HasanCAD, All Rights Reserved.  
  Contact: HasanCAD @ TheSwamp.org,                   
           asos2000 @ CADTutor.net                    
           HasanCAD@gmail.com                         
------------------------------------------------------
  Version: 1     20 Oct 2010                          
____________________________________________________|;
;     q_|_|| _\|| q_|| _\|     ;
;       Mainroutine Start      ;
(defun c:TanLine (/ p1 p2 p3)
  ; @ HasanCAD
  (vl-load-com)
  (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))))
      (IF (< 1000 (ABS (- (cadr p2) (cadr p1))))
 (setq h 220)
 (if (< 100 (ABS (- (cadr p2) (cadr p1))))
   (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 ()
  ; @ HasanCAD
  (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 ()
  ; @ HasanCAD
  (setq *error* TERR$)
  (setvar "osmode" OldOS)
  (setvar "dynmode" OldDynmode)
  (setvar "dynprompt" OldDynprompt)
  )
(defun HSN:TL-Text (H)
  ; @ HasanCAD
       (entmakex (list
     (cons 0 "TEXT")
                   (cons 10  p3)
                   (cons 40 H)
                   (cons 1 (strcat (rtos (abs (* tan2 100))2 2) "%"))
     ))
  )
(defun HSN:TL-Line ()
  ; @ HasanCAD
       (entmake (list
    (cons 0 "LINE")
                  (cons 10 p1)
                  (cons 11 p2)
    ))
  )
;     q_|_|| _\|| q_|| _\|     ;
;        Subroutine End        ;
(princ "\n  TanLine.lsp ~ Copyright © by HasanCAD")
(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 .

**Tharwat** · 22nd Dec 2010 07:32 pm

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)

Please recheck your routine once again .

Thanks.

Tharwat

**asos2000** · 23rd Dec 2010 08:38 am

Thanks Tharwat for your reply

Could you please help me for fixing this error
Second comment I can handle

Thanks

**Tharwat** · 23rd Dec 2010 09:21 am

Originally Posted by asos2000

Thanks Tharwat for your reply
Could you please help me for fixing this error
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)
  (vl-load-com)
  (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

**athabe** · 6th Oct 2011 06:31 pm

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

**Tharwat** · 6th Oct 2011 06:36 pm

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 )

Thread: Slope routine

Thread Tools

Slope routine

ReMark's Computer Details

ReMark's Discipline Details

asos2000's Computer Details

Tharwat's Discipline Details

Tharwat's Discipline Details

asos2000's Computer Details

Tharwat's Discipline Details

athabe's Computer Details

It acurate

Tharwat's Discipline Details

Similar Threads

Slope

Slope arrow

3D Slope Dimension

Slope arrow

Slope / Invert Lisp Routine?

Bookmarks

Bookmarks

Posting Permissions