This is a new lisp
Any suggestions are welcome
Sorry for native language its explanation of the lisp
;|-------------------Layers List----------------------
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)
;Copyright © by 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)))
(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 (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)
(HSN:TL-Line)
)
(progn
(HSN:TL-Text)
)
)
(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 ()
;Copyright © by 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 ()
;Copyright © by HasanCAD
(setq *error* TERR$)
(setvar "osmode" OldOS)
(setvar "dynmode" OldDynmode)
(setvar "dynprompt" OldDynprompt)
)
(defun HSN:TL-Text ()
;Copyright © by HasanCAD
(entmakex (list
(cons 0 "TEXT")
(cons 10 p3)
(cons 40 2.2)
(cons 1 (strcat (rtos (* tan2 100)) "%"))
))
)
(defun HSN:TL-Line ()
;Copyright © by 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)