Slope routine

[Guest]

satishrajdev can you add a command to give the text size ,because all the times the text is 2.5 and is too big !!

[MSasu]

Check the GETREAL function and line below:

(entmake (list (cons 0 "TEXT")(cons 10 (trans p3 1 0)) [color=magenta](cons 40 (getvar 'textsize))[/color] (cons 7 "TanLine")

[Guest]

I now few thing about lisp .Please help me litle more

[Guest]

(setq h (getdist "\nGive the text size:"))
(entmake (list (cons 0 "TEXT")(cons 10 (trans p3 1 0)) (cons 40 (getvar 'textsize)) (cons 40 h) (cons 7 "TanLine") 

 

I try this but didn' t work !

[satishrajdev]

TRY This :-

 

(defun c:TanLine (/	   doc	    spc	     *error*  TH:UnDo
	  TH:StartUnDo	    p1	     p2	      p3       p4
	  tan2	   TL-Line  TH:UnDo
	 )
;;; Authour : Hasan Asos    -> Modified by Tharwat 
 (vl-load-com)
 (command "-style" "TanLine" "wgsimpl.shx" 0 1 0 "N" "N")
 (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 p4 (getreal "\n Specify text height "))
     (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 p4)
      (cons 7 "TanLine")
      (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 p4 (getreal "\n Specify text height "))
     (setq tan2 (/ (- (cadr p2) (cadr p1)) (- (car p2) (car p1))))
     (entmake
(list (cons 0 "TEXT")
      (cons 10 (trans p3 1 0))
      (cons 40 p4)
      (cons 7 "TanLine")
      (cons 1 (strcat (rtos (abs (* tan2 100)) 2 4) "%"))
)
     )
   )
 )
 (setq TH:UnDo (vla-EndUndoMark Doc))
 (princ "\n Modified by Tharwat")
 (princ)
)

[Guest]

thank you satishrajdev nice job

[MSasu]

Prodromosm: The DXF code 40 store the height of label - you forgot to remove the original one:

(entmake (list (cons 0 "TEXT")(cons 10 (trans p3 1 0)) [color=red][s](cons 40 (getvar 'textsize))[/s][/color] (cons 40 h) (cons 7 "TanLine")

[Guest]

Thank you MSasu for the advise .

[satishrajdev]

PRODROMOSM.......... you need to know about functions, check here http://www.theswamp.org/~john/avlisp/

[Guest]

Thank you satishrajdev

[satishrajdev]