Jump to content

how to solve this text problem

MUTHUKUMAR1983

By MUTHUKUMAR1983
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

MUTHUKUMAR1983 Contributor

MUTHUKUMAR1983

Posted
Posted (edited)

1) I want Triangle T1 T2 T3 

2) I run program TRI command for T1 Triangle in UCS World position T1 Triangle is good for the shape and distance 

3) I run program TRI command for T2 Triangle in  UCS World position T2 Triangle shape and distance is rong
    but text value is aligned to the object 

4) I run program TRI command for T2 Triangle Change in  UCS "3" Point method T2 Triangle shape is            correct distance ,But text value is Outside of object

 

 

vlcsnap-2023-05-10-21h04m17s027.png

vlcsnap-2023-05-10-21h04m57s698.png

vlcsnap-2023-05-10-21h05m06s680.png

Final.dwg

Edited by SLW210
Removed code per request by poster.
Link to comment
Share on other sites
Steven P Grand Master

Steven P

Posted
Posted

I think I can see what you are doing, creating a triangle and writing the distances of each line?

 

I haven't looked at this yet, but a couple of quick notes, if you can edit your post and copy the code into the code tags whcih are the <> button in the text, opens a box, paste the code in there, that helps with reading he code - clearer what it is.

 

You ask near the beginning to enter start point of text, might want to change that to getpoint instead

Link to comment
Share on other sites
MUTHUKUMAR1983 Contributor

MUTHUKUMAR1983

Posted
  • Author
Posted 
(defun c:tri( / unit mxv v^v transptucs transptwcs p1 p2 loop g p h gp p3 )

 (defun unit ( v / d )
   (mapcar '(lambda ( x y ) (/ x y)) v (list (setq d (distance '(0.0 0.0 0.0) v)) d d))
 )

 (defun mxv ( m v )
   (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
 )

 (defun v^v ( u v )
   (list
     (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
     (- (* (car  v) (caddr u)) (* (car  u) (caddr v)))
     (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
   )
 )

 (defun transptucs ( pt p1 p2 p3 / ux uy uz )
   (setq uz (unit (v^v (mapcar '- p2 p1) (mapcar '- p3 p1))))
   (setq ux (unit (mapcar '- p2 p1)))
   (setq uy (unit (mapcar '- p3 p1)))
   
   (mxv (list ux uy uz) (mapcar '- pt p1))
 )

 (defun transptwcs ( pt pt1 pt2 pt3 / pt1n pt2n pt3n )
   (setq pt1n (transptucs '(0.0 0.0 0.0) pt1 pt2 pt3))
   (setq pt2n (transptucs '(1.0 0.0 0.0) pt1 pt2 pt3))
   (setq pt3n (transptucs '(0.0 1.0 0.0) pt1 pt2 pt3))
   (transptucs pt pt1n pt2n pt3n)
 )

  (defun acos ( x )

  (if (<= -1.0 x 1.0)

    (atan (sqrt (- 1.0 (* x x))) x)

    )

  
)
  
  (setq

    TA(GETSTRING "\n  ENTER START POINT OF TEXT:");A

    TB(GETSTRING  "\n ENTER END POINT OF TEXT:");B

    TC(GETSTRING  "\n ENTER THIRD POINT OF TEXT:");C
)

  (setq p1 (getpoint  "\n Pick  specify start point : "))            

  (setq p2 (getpoint "\n Pick or specify end point : " p1))

  (setq h(getdist p1(STRCAT TA "<----->" TC  " LENGTH")))  ;AC

  (setq k(getdist p2(STRCAT TB "<----->" TC  " LENGTH")))   ;BC

  (SETQ
    AB(DISTANCE P1 P2)
    
    )

  (SETQ

    B2(* h h) C2(* AB AB) A2(* k k) CV(* 2 h AB) CB(* 2 k AB) CC(* 2 k h)

    ANGA(/(-(+ B2 C2)A2)CV)

    ANSA(acos anga);ANGLE A

    )

  (setq loop t)
  (while loop
   (setq g (grread t 15 0))
   (if (eq (car g) 5)
     (progn
       (setq p (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2))
       ;(setq h (/ (distance p1 p2)2 ))
       (setq gp (cadr g))
       (if (not (minusp (cadr (transptucs gp p1 (polar p1 (angle p1 p2) 1.0) (polar p1 (+ (angle p1 p2) (* 0.5 pi)) 1.0)))))
         (progn
           (redraw)
           (setq p3 (polar p1  ANSA h))
           (grdraw p1 p2 1 1)
           (grdraw p2 p3 1 1)
           (grdraw p3 p1 1 1)
         )
         (progn
           (redraw)
           (setq p3 (polar p1 (- ANSA) h))
           (grdraw p1 p2 1 1)
           (grdraw p2 p3 1 1)
           (grdraw p3 p1 1 1)
         )
       )
     )

     
     (progn
       (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 3)
       (if (eq (getvar 'plinegen) 1) '(70 . 129) '(70 . 1))
       (cons 38 (caddr (trans p1 1 (trans '(0.0 0.0 1.0) 1 0 t)))) (cons 10 (list (car (trans p1 1 (trans '(0.0 0.0 1.0) 1 0 t)))
       (cadr (trans p1 1 (trans '(0.0 0.0 1.0) 1 0 t))))) (cons 10 (list (car (trans p2 1 (trans '(0.0 0.0 1.0) 1 0 t)))
       (cadr (trans p2 1 (trans '(0.0 0.0 1.0) 1 0 t))))) (cons 10 (list (car (trans p3 1 (trans '(0.0 0.0 1.0) 1 0 t)))
       (cadr (trans p3 1 (trans '(0.0 0.0 1.0) 1 0 t))))) (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))))
       (setq loop nil)
     )

     
   )
 )
  
 (redraw)
  

  (SETQ 
          ;di   (/ (* *ht* 0.45) 0.5)
          nm   (TRANS '(0.0 0.0 1.0) 1 0 T)
          a    (ANGLE p1 p2)
	  b    (rtos(distance p1 p2)2 2) ;distance p1 p2  
	  c    (STRCAT"("b")") ;final answer with () bracket add of distance p1 p2
	 
    )


  (ENTMAKE (LIST    (CONS 0 "TEXT")            
                   (CONS 100 "AcDbEntity")
                   (CONS 100 "AcDbText")
                   (CONS 10 (LIST 0. 0. 0.))
                   (CONS 40 8)
                   (CONS 7 (GETVAR 'textstyle))
                   (CONS 8 "Some layer")
                   (CONS 62 1)
                   (CONS 1 c)             ;text value of p1 to p2 distance
                   (CONS 50
                         (IF (MINUSP (COS a))
                           (+ PI a)
                           a
                         )
                   )
                   (CONS 72 1)   ; all three cons justification of text
                   (CONS 11 (LIST (/ (+ (CAR p1) (CAR p2)) 2.0) (/ (+ (CADR p1) (CADR p2)) 2.0) 0.0))
                   (CONS 73 1)
             )
    )

(setq
          d(ANGLE p1 p3)
	  e(rtos(distance p1 p3)2 2) ;distance p1 p3  
	  f(STRCAT"("e")") ;final answer with () bracket add of distance p1 p3
  )
  
  (ENTMAKE (LIST    (CONS 0 "TEXT")            
                   (CONS 100 "AcDbEntity")
                   (CONS 100 "AcDbText")
                   (CONS 10 (LIST 0. 0. 0.))
                   (CONS 40 8)
                   (CONS 7 (GETVAR 'textstyle))
                   (CONS 8 "Some layer")
                   (CONS 62 1)
                   (CONS 1 f)         ;text value of p1 to p3 distance
                   (CONS 50
                         (IF (MINUSP (COS d))
                           (+ PI d)
                           d
                         )
                   )
                   (CONS 72 1)   ; all three cons justification of text
                   (CONS 11 (LIST (/ (+ (CAR p1) (CAR p3)) 2.0) (/ (+ (CADR p1) (CADR p3)) 2.0) 0.0))
                   (CONS 73 1)
             )
    )

  (setq
          g(ANGLE p2 p3)
	  h(rtos(distance p2 p3)2 2) ;distance p2 p3  
	  i(STRCAT"("h")") ;final answer with () bracket add of distance p2 p3
  )
  
  (ENTMAKE (LIST    (CONS 0 "TEXT")            
                   (CONS 100 "AcDbEntity")
                   (CONS 100 "AcDbText")
                   (CONS 10 (LIST 0. 0. 0.))
                   (CONS 40 8)
                   (CONS 7 (GETVAR 'textstyle))
                   (CONS 8 "Some layer")
                   (CONS 62 1)
                   (CONS 1 i)         ;text value of p2 to p3 distance
                   (CONS 50
                         (IF (MINUSP (COS g))
                           (+ PI g)
                           g
                         )
                   )
                   (CONS 72 1)   ; all three cons justification of text
                   (CONS 11 (LIST (/ (+ (CAR p2) (CAR p3)) 2.0) (/ (+ (CADR p2) (CADR p3)) 2.0) 0.0))
                   (CONS 73 1)
             )
    )

  (command "text" "j" "bc" p1 8 0 TA "" "")
  (command "text" "j" "bc" p2 8 0 TB "" "")
  (command "text" "j" "bc" p3 8 0 TC "" "")
 
)

 

Yes creating a triangle and writing the distances of each line its on error  for triangle and distance i run program in wcs co-ordinates triangle and distance is error i change ucs triangle 

and distance value is good  but text is mirror and rotate and font is bold 

 

 

Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted (edited)

Just a comment re A B C you dont need to enter the values, 1st go is text1 nil ? If so set its character number to 65 just type (chr 65) and see what you get ! So set X to 65 the next character is (chr (+ x 1)) which is B, C will be (chr (+ x 2)). Hope you understand.

 

So draw 1st triangle starts with 65 and last is 67, then set first to X+1 second x+2 third X+3.

 

The only real limit is 26 characters A-Z

Edited by BIGAL
Link to comment
Share on other sites
Tsuky Community Regular

Tsuky

Posted
Posted (edited)

If you want try... 

(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)
  (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 9)
  (setq cc1 (getpoint "\nPick  specify start point?: "))
  (initget 9)
  (setq cc2 (getpoint cc1 "\nPick or specify end point?: "))
  (grdraw cc1 cc2 1)
  (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 (atoi (getvar "CECOLOR")))
                (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)
              )
            )
            (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 . 8)
                    (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 . 8)
                    (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)
)

 

Edited by Tsuky
  • Like 1
Link to comment
Share on other sites
MUTHUKUMAR1983 Contributor

MUTHUKUMAR1983

Posted
  • Author
Posted
On 5/11/2023 at 6:58 PM, Tsuky said:

 

 

 

 i want change the text height  ex:  (setq th(getint "\n enter text height") )

 

... 

(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)
)

 

 

Link to comment
Share on other sites

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...