这里是四位小数。。
- (defun c:TanLine (/ doc spc *error* TH:UnDo TH:StartUnDo p1 p2 p3 tan2 TL-Line TH:UnDo)
- ;;; Authour : Hasan Asos -> Modified by Tharwat
- (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 4) "%"))))
- )
- (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 4) "%"))))
- )
- )
- (setq TH:UnDo (vla-EndUndoMark Doc))
- (princ "\n Modified by Tharwat")
- (princ)
- )
| 
