(setq 1sec (getpoint "\n1.Noktayi Secin:"))
(setq 2sec (getpoint "\n2.Noktayi Secin:"))
(setq aci (angtos (angle 1sec 2sec)))

(if (< aci 90)
(progn
(setq mesafe 100)
(setq 1secc (polar 1sec (angtof "90") mesafe))
(setq 2secc (polar 2sec (angtof "180") mesafe))
(setq mer (inters 1sec 1secc 2sec 2secc))
(command "_.point" mer "")
))

;**************************************************************************************************
;**                                     MAIN                                                     **
(defun c:yy ()
  (vl-load-com)
  (initget 1024 "Previous")
  (setq ref (nentsel "\nSelect object or [Previous]"))
  (if (/= ref "Previous")
    (progn
      (setq ref_8  (cdr (assoc 8 (entget (car ref))))
    ref_1  (cdr (assoc 1 (entget (car ref))))
    ref_40 (cdr (assoc 40 (entget (car ref))))
    ref_41 (cdr (assoc 41 (entget (car ref))))
    ref_7  (cdr (assoc 7 (entget (car ref))))
      )
      (if (/= nil (vl-string-position (ascii "|") ref_7))
(progn
  (setq ref_s (tblsearch "STYLE" ref_7)
ref_s_70 (cdr (assoc 70 ref_s))
ref_s_40 (cdr (assoc 40 ref_s))
ref_s_3 (cdr (assoc 3 ref_s))
ref_7 (substr ref_7 (+ 2 (vl-string-position (ascii "|") ref_7)))
  )
  (if (null (tblsearch "STYLE" ref_7))
    (progn
      (style)
    )
  )
  (setq
    s_data (open (strcat (getvar "savefilepath") "S_DATA.TXT")
"W"
   )
  )
  (write-line (rtos ref_s_70 2 0) s_data)
  (write-line (rtos ref_s_40 2 1) s_data)
  (write-line ref_s_3 s_data)
  (write-line ref_7 s_data)
  (close s_data)
)
(progn
  (setq ref_s (tblsearch "STYLE" ref_7)
ref_s_70 (cdr (assoc 70 ref_s))
ref_s_40 (cdr (assoc 40 ref_s))
ref_s_3 (cdr (assoc 3 ref_s))
  )
  (setq
    s_data (open (strcat (getvar "savefilepath") "S_DATA.TXT")
"W"
   )
  )
  (write-line (rtos ref_s_70 2 0) s_data)
  (write-line (rtos ref_s_40 2 1) s_data)
  (write-line ref_s_3 s_data)
  (write-line ref_7 s_data)
  (close s_data)
)
      )
      (setq
y_data
(open (strcat (getvar "savefilepath") "Y_DATA.TXT") "W")
      )
      (write-line ref_8 y_data)
      (write-line ref_1 y_data)
      (write-line (rtos ref_40 2 1) y_data)
      (write-line (rtos ref_41 2 1) y_data)
      (close y_data)
    )
    (progn
      (setq
y_data
(open (strcat (getvar "savefilepath") "Y_DATA.TXT") "r")
      )
      (setq ref_8 (read-line y_data))
      (setq ref_1 (read-line y_data))
      (setq ref_40 (atoi (read-line y_data)))
      (setq ref_41 (atoi (read-line y_data)))
      (close y_data)
      (setq
s_data
(open (strcat (getvar "savefilepath") "S_DATA.TXT") "r")
      )
      (setq ref_s_70 (atoi (read-line s_data))
    ref_s_40 (atoi (read-line s_data))
    ref_s_3  (read-line s_data)
    ref_7  (read-line s_data)
   
      )
      (close s_data)
    )
  )
  (prompt "\nDegistirilecek texti sec yada Nokta sec:")
  (setq dd 0)
  (while (/= nil dd)
    (while (= (car (setq #grread (grread t 5 0))) 5)
      (redraw)
      (setq p1 (cadr #grread))
      ;(LM:displaygrtext p1 (LM:grtext ref_1) 1 15 -31)
    )
    (if (= (car #grread) 3)
      (progn
(setq sset (car (nentselp (cadr #grread))))
(if (= sset nil)
  (progn
    (text_yaz)
  )
  (progn
    (text_deg sset)
  )
)
      )
    )
    (if (= (car #grread) 2)
      (progn
(setq dd nil)
(redraw)
      )
    )
  )
)






;**                                                                                              **
;**************************************************************************************************

;**************************************************************************************************
;**                                     TEXT YAZ                                                 **

(defun text_yaz ()
  (entmake (list
     (cons 0 "TEXT")
     (cons 100 "AcDbEntity")
     (cons 8 ref_8)
     (cons 100 "AcDbMText")
     (cons 10 (cadr #grread))
     (cons 1 ref_1)
     (cons 40 ref_40)
     (cons 41 ref_41)
     (cons 7 ref_7)
   )
  )
)

;**                                                                                              **
;**************************************************************************************************

;**************************************************************************************************
;**                                       TEXT DEGISTIR                                          **

(defun text_deg (slist)
  (setq #dt (entget  slist))
  (setq #dt (subst (cons 1 ref_1) (assoc 1 #dt) #dt))
  (entmod #dt)
)

;**                                                                                              **
;**************************************************************************************************

;**************************************************************************************************
;**                                       MESAJ                                                  **

(PRINT "MIYATU TEXT KOPYALAMA YUKLENDI, CALISTIRMAK ICIN [YY] YAZ")

;**                                                                                              **
;**************************************************************************************************

;                                 TEXTSTYLE TANIMLANIYOR                                          ;
(defun style ()
    (entmake
      (list
(cons 0 "STYLE")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbTextStyleTableRecord")
(cons 2 ref_7)
(cons 3 ref_s_3)
(cons 40 ref_s_40)
(cons 70 ref_s_70)
      )
    )
  )
;                                                                                                 ;

(defun C:tab  (/ *error* acsp adoc align attobj block_coll block_def bname bref
  en hgt msg name names orig pmt sset style tag txtobj txtval val)
  (vl-load-com)
  (defun *error* (msg)
    (if adoc (vla-endundomark  adoc))
    (if
      (and msg
    (not
      (member
        msg
        '("console break"
   "Function cancelled"
   "quit / exit abort"
   ""
  )
      )
    )
      )
       (princ (strcat "\nError: " msg))
    )
    (setvar "nomutt" 0)
   
   
    (princ)
  )
(or adoc
     (setq adoc (vla-get-activedocument
    (vlax-get-acad-object))))
(or acsp
     (setq acsp (if (= (getvar "CVPORT") 1)
    (vla-get-paperspace
      adoc)
    (vla-get-modelspace
      adoc)
    )
    )
     )
(setq block_coll (vla-get-blocks adoc))
(vla-endundomark adoc)
(vla-startundomark adoc)
(while (tblsearch "BLOCK"
     (setq bname (getstring T "\nEnter block name: ")))
   (progn
     (alert "Block already exist, input another name")
     (setq msg "")
     (vlax-for obj  (setq names (vlax-map-collection block_coll 'vla-get-name))
       (setq name (vla-get-name obj))
       (if (not (wcmatch name "`**"))
  (setq msg (strcat msg (vla-get-name obj) "\n"))))
     (alert (strcat "Check existing blocks:\n" msg))))
(setvar "nomutt" 0)
(prompt
   "\nSelect a single text by single pick to get properies from\n")
(setvar "nomutt" 1)
(while (not
   (setq sset (ssget "_:S:L" (list (cons 0 "text")))))
   (alert (strcat "Select text again")))
(setq txtobj (vlax-ename->vla-object (ssname sset 0)))
(setvar "aflags" 4)
(setvar "attreq" 0)
(setvar "attdia" 1)
(setvar "nomutt" 0)
(prompt "\nCreating block with ActiveX method\n")
(setq orig (vlax-get txtobj 'insertionpoint)
       pmt  "Panel type"     ; prompt
       tag  "PANEL_TYPE"     ;tag
       val  (vlax-get txtobj 'textstring)   ;default value
       )
(setq hgt   (vlax-get txtobj 'height)
       style (vlax-get txtobj 'stylename)
       rot (vlax-get txtobj 'rotation)
       align (vlax-get txtobj 'alignment))
;; add block definition first
(setq block_def (vla-add block_coll (vlax-3d-point orig) bname))
;; change properties of the block definition
(vla-put-blockscaling block_def 1)
(vla-put-blockscaling block_def 1)
(vla-put-units block_def 1) ; possible enums: acInsertUnitsInches, acInsertUnitsUnitless, acInsertUnitsMillimeters, acInsertUnitsMeters, etc
;; add attribute
(setq attobj (vlax-invoke
  block_def
  'addattribute
  hgt
  acattributemodepreset
  pmt
  orig
  tag
  val))
;; change properties of the attribute
(vlax-put attobj 'alignment align)
(vlax-put attobj 'stylename style)
(vlax-put attobj 'rotation rot)
(vla-put-layer attobj "0")
(vlax-put attobj 'color 0)
(princ "\n")
(if (not (tblsearch "BLOCK" bname))
   (progn
     (alert "Error on  creating blocks")
     (exit)
     (princ))
   (progn
     (setvar "nomutt" 0)
     (prompt "\n\nSelect all texts to convert to blocks\n")
     (setvar "nomutt" 1)
     (if (setq tset (ssget "_:L" (list (cons 0 "text"))))
       (while (setq en (ssname tset 0))
  (setq txtobj (vlax-ename->vla-object en))
  (setq xlist (cons txtobj xlist))
  (setq orig (vlax-get txtobj 'insertionpoint))
  (setq txtval (vla-get-textstring txtobj))
  (setq orig (vlax-get txtobj 'insertionpoint))
  (setq bref (vlax-invoke acsp 'insertblock orig bname 1 1 1 0))
  (foreach attobj  (vlax-invoke bref 'getattributes)
    (if (eq tag (vla-get-tagstring attobj))
      (vla-put-textstring attobj txtval)
      (vla-update attobj))
    )
  (ssdel en tset)
  (entdel en)
  )
       )
     (setvar "nomutt" 0)
     )
   )
(vl-catch-all-apply
   '(lambda () (vlax-release-object block_def)))
(*error* nil)
(princ)
  )   
(princ "\n\t\t   Start command with: AXBT\n")
(prin1)

(defun c:abd ()
(setq wid1 60 len 115 wid1 60 wid2 22.5 hole1 20 hole2 15 rad1 22.5 rad2 20 rad3 50 rad4 10 rad5 7.5 he1 15 thi1 15 thi2 15 dist1 47.5 dist2 25 dist3 22.5 dist4 37.5)

;base
(setq pnt1 (getpoint "\nPlease select the starting point"))
(setq pnt2 (list (+ (car pnt1) (- len rad2))  (cadr pnt1)  (caddr pnt1)))
(setq pnt3 (list (car pnt2) (- (cadr pnt2) (- wid1 (* rad1 2)))  (caddr pnt1)))


(setq pnt4 (list (+ (car pnt3) (* rad2 2)) (cadr pnt3)  (caddr pnt1)))
(setq pnt5 (list (car pnt4) (+ (cadr pnt4) wid1)  (caddr pnt1)))
(setq pnt6 (list (- (car pnt4) (+ len rad2)) (cadr pnt5)  (caddr pnt1)))
(setq pnt7 (list (car pnt1) (cadr pnt1) (caddr pnt1)))



(command "line" pnt1 pnt2 pnt3 pnt4 pnt5 pnt6 pnt7 "")
)