Jump to content

How to change Text Height ?

MUTHUKUMAR1983

By MUTHUKUMAR1983
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

MUTHUKUMAR1983 Contributor

MUTHUKUMAR1983

Posted
Posted 
(defun c:tri ( / TA TB TC cc1 r1 cc2 r2 dce dxf_210 xi yi i cr1 cr2 vi xt yt h1 h2 h i1 i2 key)
   (command "osmode" 1)
  (initget 9)
   (setq cc1 (getpoint "\nPick  specify start point?: "))
  (initget 9)
  (setq cc2 (getpoint cc1 "\nPick or specify end point?: "))
   (SETQ P1 (DISTANCE CC1 CC2))
  (setq th(getint "\n enter text height")) ; i want change text height
  (grdraw cc1 cc2 1)
 ; (SETVAR "users3" (RTOS P1 2 2))
   
  ;(vl-vbaload "E:/FMB Cadd/GUIDELINE.dvb");testdial

  ;(VL-VBARUN "LTV") 
  (setq
    Tx (if (not Tx) 65 Tx)
    TA (getstring (strcat "\nEnter start point of text <" (chr Tx) ">: "))
  )
  
  (if (not (eq TA "")) (setq Tx (1+ (setq TA (ascii TA)))) (setq TA Tx Tx (1+ Tx)))
  (setq TB (getstring (strcat "\nEnter end point of text <" (chr Tx) ">: ")))
  (if (not (eq TB "")) (setq Tx (1+ (setq TB (ascii TB)))) (setq TB Tx Tx (1+ Tx)))
  (setq TC (getstring (strcat "\nEnter third point of text <" (chr Tx) ">: ")))
  (if (not (eq TC "")) (setq Tx (1+ (setq TC (ascii TC)))) (setq TC Tx Tx (1+ Tx)))
  
  (initget 39)
  (setq r1 (getdist cc1 (strcat "\n" (chr TA) "<----->" (chr TC) " Length: ")))
  (initget 39)
  (setq r2 (getdist cc2 (strcat "\n" (chr TB) "<----->" (chr TC) " Length: ")))
  (grdraw cc1 cc2 0)
  (setq
    dce (distance cc1 cc2)
    dxf_210 (trans '(0 1 0) (getvar "UCSYDIR") 0)
  )

 
  
  (if (equal (/ dce (+ r1 r2)) 1E-16)
    (setq
      xi (/ (+ (* r2 (car cc1)) (* r1 (car cc2))) dce)
      yi (/ (+ (* r2 (cadr cc1)) (* r1 (cadr cc2))) dce)
      i (cons xi (cons yi '(0.0)))
    )
    (if (and (not (zerop (- r1 r2))) (equal (/ dce (+ r1 r2)) 1E-16))
      (progn
        (if (= r1 (max r1 r2))
          (setq cr1 cc1 cr2 cc2)
          (setq cr1 cc2 cr2 cc1)
        )
        (setq
          xi (/ (- (* (max r1 r2) (car cr2)) (* (min r1 r2) (car cr1))) dce)
          yi (/ (- (* (max r1 r2) (cadr cr2)) (* (min r1 r2) (cadr cr1))) dce)
          i (cons xi (cons yi '(0.0)))
        )
      )
      (progn
        (if (or (> dce (+ r1 r2)) (< (+ (min r1 r2) dce) (max r1 r2)))
          (prompt "\nNo intersection !...")
          (progn
            (setq vi (angle cc1 cc2))
            (if (> r1 r2)
              (setq
                xt (- (/ (* (+ r1 dce r2) (- (+ r1 dce) r2)) (* 2 dce)) r1)
                yt (- dce xt)
                h1 (sqrt (- (expt r1 2) (expt xt 2)))
                h2 (sqrt (- (expt r2 2) (expt yt 2)))
                xi (/ (+ (* yt (car cc1)) (* xt (car cc2))) dce)
                yi (/ (+ (* yt (cadr cc1)) (* xt (cadr cc2))) dce)
              )
              (setq
                xt (- (/ (* (+ r2 dce r1) (- (+ r2 dce) r1)) (* 2 dce)) r2)
                yt (- dce xt)
                h1 (sqrt (- (expt r2 2) (expt xt 2)))
                h2 (sqrt (- (expt r1 2) (expt yt 2)))
                xi (/ (+ (* xt (car cc1)) (* yt (car cc2))) dce)
                yi (/ (+ (* xt (cadr cc1)) (* yt (cadr cc2))) dce)
              )
            )
            (setq
              h (/ (+ h1 h2) 2)
              i1 (polar (cons xi (cons yi '(0.0))) (+ vi (/ pi 2)) h)
              i2 (polar (cons xi (cons yi '(0.0))) (- vi (/ pi 2)) h)
            )
            (princ "\n<Move cursor> for choice; <Enter>/[Space]/Right-Click for end!.")
            (while (and (not (member (setq key (grread T 4 2)) '((2 13) (2 32)))) (/= (car key) 25))
              (redraw)
              (grdraw cc1 cc2 7)
              (cond
                ((eq (car key) 5)
                  (if (< (distance i1 (cadr key)) (distance i2 (cadr key)))
                    (set 'i i1)
                    (set 'i i2)
                  )
                  (grdraw cc1 i 7)
                  (grdraw i cc2 7)
                )
              )
            )
            (setq
              cc1 (trans cc1 1 dxf_210)
              cc2 (trans cc2 1 dxf_210)
              i (trans i 1 dxf_210)
            )
            (entmake
              (list
                '(0 . "LWPOLYLINE")
                '(100 . "AcDbEntity")
                (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
                (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
                (cons 8 (getvar "CLAYER"))
                (cons 62 150)
                (cons 6 (getvar "CELTYPE"))
                (cons 370 (getvar "CELWEIGHT"))
                '(100 . "AcDbPolyline")
                '(90 . 3)
                (if (eq (getvar "PLINEGEN") 1) '(70 . 129) '(70 . 1))
                (cons 43 (getvar "PLINEWID"))
                (cons 38 (getvar "ELEVATION"))
                (cons 39 (getvar "THICKNESS"))
                (cons 10 (list (car cc1) (cadr cc1)))
                '(40 . 0.0)
                '(41 . 0.0)
                '(42 . 0.0)
                '(91 . 0)
                (cons 10 (list (car i) (cadr i)))
                '(40 . 0.0)
                '(41 . 0.0)
                '(42 . 0.0)
                '(91 . 0)
                (cons 10 (list (car cc2) (cadr cc2)))
                '(40 . 0.0)
                '(41 . 0.0)
                '(42 . 0.0)
                '(91 . 0)
                (cons 210 dxf_210)
              )
            )
	    (SETQ OBJ1(ENTLAST))(COMMAND "EXPLODE" OBJ1 "")
            (mapcar
              '(lambda (d a p / )
                (entmake
                  (list
                    '(0 . "TEXT")
                    '(100 . "AcDbEntity")
                    (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
                    (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
                    (cons 8 "Some layer")
                    '(62 . 1)
                    '(100 . "AcDbText")
                    '(10 0.0 0.0 0.0)
                    '(40 . th)
                    (cons 1 (strcat "(" (rtos d 2 2) ")"))
                    (cons
                      50
                      (if (minusp (cos a))
                        (+ pi a)
                        a
                      )
                    )
                    '(72 . 1)
                    (cons 11 p)
                    (cons 210 dxf_210)
                    '(100 . "AcDbText")
                    '(73 . 1)
                  )
                )
              )
              (mapcar '(lambda (i / ) (distance (list (caar i) (cadar i)) (list (caadr i) (cadadr i)))) (list (list cc1 cc2) (list cc1 i) (list cc2 i)))
              (mapcar '(lambda (i / ) (angle (car i) (cadr i))) (list (list cc1 cc2) (list cc1 i) (list cc2 i)))
              (mapcar
                '(lambda (i / ) (list (* (+ (caar i) (caadr i)) 0.5) (* (+ (cadar i) (cadadr i)) 0.5)))
                (list (list cc1 cc2) (list cc1 i) (list cc2 i))
              )
            )
            (mapcar
              '(lambda (x p / )
                (entmake
                  (list
                    '(0 . "TEXT")
                    '(100 . "AcDbEntity")
                    (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
                    (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
                    (cons 8 "Some layer")
                    '(62 . 1)
                    '(100 . "AcDbText")
                    '(10 0.0 0.0 0.0)
                    '(40 . th)
                    (cons 1 (chr x))
                    '(50 . 0.0)
                    (cons 7 (getvar "TEXTSTYLE"))
                    '(72 . 1)
                    (cons 11 p)
                    (cons 210 dxf_210)
                    '(100 . "AcDbText")
                    '(73 . 1)
                  )
                )
              )
              (list TA TB TC)
              (list cc1 cc2 i)
            )
            (redraw)
          )
        )
      )
    )
  )
  (prin1)(command "osmode" 15359)
)

 

Isaac26a Collaborator

Isaac26a

Posted
Posted
2 hours ago, MUTHUKUMAR1983 said: 
'(40 . th)

You should change this line for 

(cons 40 th)

 

  • Like 1

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...