;|===========================================================================|
|    CnT: Belirlenen sayidan baslayarak gosterilen noktalara belirlenen     |
|    miktar kadar artirarak sayilar yazar.                                  |
|    Hazırlayan: M. Şahin Güvercin - www.autocadokulu.com                   |
|___________________________________________________________________________|;
(princ "\nAuthor: M. Şahin Güvercin - www.autocadokulu.com - ")
;|___________________________________________________________________________|;
(defun C:CnT (/ sayi amk yyuk ynok tro nnK An0 Ang)
  (setvar "cmdecho" 0) (command "undo" "group") (vl-load-com)
  (defun *error* (er) (princ (strcat "\n" er)) (command "_.undo" "end"))
  (mapcar '(lambda (p1 p2) (if (= (eval (read p1)) nil) (set (read p1) p2)))
          '("esayi" "eamk" "eyuk")
          (list 1 1 (* (getvar "dimtxt") (getvar "dimscale"))))
  (setq sayi (getint (strcat "\nBaşlangic sayisi <" (itoa esayi) "> :")))
  (if (= sayi nil) (setq sayi esayi) (setq esayi sayi))
  (setq amk (getint (strcat "Artiş miktari <" (itoa eamk) "> : ")))
  (if (= nil amk) (setq amk eamk) (setq eamk amk))
  (setq yyuk (getreal (strcat "\nYazi yüksekliği <" (rtos eyuk) "> :")))
  (if (= yyuk nil) (setq yyuk eyuk) (setq eyuk yyuk))
  (princ "\nilgili noktayi seçiniz...")
  (while (setq ynok (getpoint))
    (entmake (list '(0 . "TEXT") (cons 10 ynok) (cons 40 yyuk)
              (cons 1 (itoa sayi)) '(50 . 0.0) '(72 . 4) (cons 11 ynok)))
    (setq tro (entget (entlast)))
    (while (and (/= 3 (car (setq nnK (grread T 4 0)))) (/= 25 (car nnK)))
      (if (= 5 (car nnK)) (progn (setq nnK (cadr nnK)) (redraw)
        (if (> (abs (- (car nnK) (car ynok))) (abs (- (cadr nnK) (cadr ynok))))
          (setq nnK (list (car nnK) (cadr ynok) (caddr ynok)))
          (setq nnK (list (car ynok) (cadr nnK) (caddr ynok))))
                            (grdraw ynok nnK -1)
          (setq tro (subst (cons 10 nnK) (assoc 10 tro) tro)
                tro (subst (cons 11 nnK) (assoc 11 tro) tro) tro (entmod tro)
                tro (entget (entupd (cdr (assoc -1 tro))))))))
    (redraw) (setq ynok (cdr (assoc 10 tro)))
    (while (and (/= 3 (car (setq nnK (grread T 4 0)))) (/= 25 (car nnK)))
      (if (= 5 (car nnK)) (progn (setq nnK (cadr nnK) An0 (angle ynok nnK))
          (cond ((and (> An0 0) (<= An0 (/ pi 4.0))) (setq Ang (/ pi 4.0)))
                ((and (> An0 (/ pi 4.0)) (<= An0 (/ pi 2.0)))
                 (setq Ang (/ pi 2.0)))
                ((and (> An0 (/ pi 2.0)) (<= An0(* pi 0.75)))
                 (setq Ang (* pi 1.75)))
                ((and (> An0 (* pi 0.75)) (<= An0 pi)) (setq Ang 0))
                ((and (> An0 pi) (<= An0 (* pi 1.25))) (setq Ang (/ pi 4.0)))
                ((and (> An0 (* pi 1.25)) (<= An0 (* pi 1.5)))
                 (setq Ang (* pi 0.5)))
                ((and (> An0 (* 1.5 pi)) (<= An0 (* pi 1.75)))
                 (setq Ang(* pi 0.75))) ((> An0 (* pi 1.75)) (setq Ang 0)))
          (setq tro (subst (cons 50 Ang) (assoc 50 tro) tro) tro (entmod tro)
                tro (entget (entupd (cdr (assoc -1 tro))))))))
    (setq sayi (+ sayi amk)) (princ "\r... Yeni nokta seçiniz..."))
  (setq esayi sayi) (command "undo" "e") (prin1))
;|___________________________________________________________________________|;

;|============================================================================|
|  Seçilen PoLyLine objesinin parça boyları üzerine yazılarak, gösterilen    |
|  yere toplam boy yazılır. PoLyLine segmentleri doğrusal kabul edilir.      |
|  Hazırlayan: M. Şahin Güvercin  29/03/2012 www.autocadokulu.com            |
|____________________________________________________________________________|
|;(write-line "Hazırlayan: M. Şahin Güvercin - www.autocadokulu.com")       ;|
|____________________________________________________________________________|
|;(defun C:PLoL (/ *error* Luf dp L ds tx sTy pLL cRd n1 n2 bn ms ac)       ;|
|; (setvar "cmdecho" 0) (command "undo" "group") (vl-load-com)              ;|
|; (defun *error* (er) (princ (strcat "\n" er))                             ;|
|;  (setq Lufo Luf dpo dp) (command "undo" "e") (prin1))                    ;|
|; (if (= Lufo nil) (setq Lufo 1)) (if (= dpo nil) (setq dpo 2))            ;|
|; (setq Luf (getreal (strcat "\nCizilen/Yazılan orani <" (rtos Lufo) ">:"));|
|;       dp (getint (strcat "\rOndalik basamak sayisi <" (itoa dpo) ">: ")));|
|; (if (= nil Luf) (setq Luf Lufo)) (if (= nil dp) (setq dp dpo))           ;|
|; (setq L 0 ds (* (getvar "dimscale") (getvar "dimgap"))                   ;|
|;       tx (*(getvar "dimscale")(getvar "dimtxt")) sTy(getvar "TextStyle"));|
|; (princ "\rÖlçülendirmek istediğiniz PLine'ı seçiniz: ")                  ;|
|; (while (not (setq pLL (ssget ":s" (list (cons 0 "LWPOLYLINE"))))))       ;|
|; (setq pLL (ssname pLL 0)                                                 ;|
|;       cRd (vlax-safearray->list (vlax-variant-value (vlax-get-property   ;|
|;               (vlax-ename->vla-object pLL) 'Coordinates))))              ;|
|; (if (= (cdr (assoc 70 (entget pLL))) 1)                                  ;|
|;   (setq cRd (append (append cRd (nth 0 cRd)) (nth 1 cRd))))              ;|
|; (setq n (- (length cRd) 2))                                              ;|
|; (while (not (minusp (setq n (- n 2))))                                   ;|
|;   (setq n1 (list (nth n cRd) (nth (1+ n) cRd))                           ;|
|;         n2 (list (nth (+ n 2) cRd) (nth (+ n 3) cRd))                    ;|
|;         bn (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) n1 n2)            ;|
|;         ac (angle n1 n2)) (while (>= ac pi) (setq ac (- ac pi)))         ;|
|;   (if (> ac (/ pi 2.0))                                                  ;|
|;     (setq bn (polar bn (- ac (/ pi 2.0)) ds) ac (+ ac pi))               ;|
|;     (setq bn (polar bn (+ ac (/ pi 2.0)) ds)))                           ;|
|;   (setq ms (rtos (* Luf (distance n1 n2)) 2 dp) L (+ L (atof ms)))       ;|
|;   (entmake (list (cons 0 "TEXT") (cons 7 sTy) (cons 10 bn) (cons 40 tx)  ;|
|;                  (cons 1 ms) (cons 50 ac) (cons 72 1) (cons 11 bn))))    ;|
|; (setq L (strcat "L=" (rtos L 2 dp)))                                     ;|
|; (entmake (list (cons 0 "TEXT") (cons 7 sTy) '(10 0.0 0.0 0.0)(cons 40 tx);|
|;                (cons 1 L) (cons 50 0.0) (cons 72 1) '( 11 0.0 0.0 0.0))) ;|
|; (princ "\rToplam Boy için yer seçiniz: ") (setq n1 (list 0.0 0.0 0.0))   ;|
|; (while (and (/= 3 (car (setq n2 (grread T 4 3)))) (/= (car n2) 25))      ;|
|;   (vla-transformby (vlax-ename->vla-object (entlast))                    ;|
|;     (vlax-tmatrix (list (list 1 0 0 (- (car (cadr n2)) (car n1)))        ;|
|;                         (list 0 1 0 (- (cadr (cadr n2)) (cadr n1)))      ;|
|;                         (list 0 0 1 (- (caddr (cadr n2)) (caddr n1)))    ;|
|;                         (list 0 0 0 1)))) (setq n1 (cadr n2)))           ;|
|; (if (= (car n2) 25) (entdel (entlast)))                                  ;|
|; (setq Lufo Luf dpo dp) (command "undo" "e") (prin1))                     ;|
;|___________________________________________________________________________|;

(defun c:mRc (/ cmo *error* cMtxT obj coorX coorY coPnT)
  (command "_.undo" "group") (setq cmo (getvar "cmdecho")) (setvar "cmdecho" 0)
  (defun *error* (er) (setvar "cmdecho" cmo) (princ (strcat "\n" er "\n")))
  (princ "\nKoordinat Yazısını seçiniz: ")
  (while (not (setq cMtxT (ssget ":s" (list (cons 0 "MTEXT"))))))
  (setq cMtxT (cdr (assoc 1 (entget (setq obj (ssname cMtxT 0)))))
        coorX (atof (vl-string-left-trim "Y="
                      (substr cMtxT 1 (vl-string-position 92 cMtxT))))
        coorY (atof (vl-string-left-trim "\\PX="
                      (substr cMtxT (1+ (vl-string-position 92 cMtxT)))))
        coPnT (getpoint "\nKoordinat noktasını seçiniz: "))
  (command "_.move" "aLL" "" coPnT (list coorX coorY (caddr coPnT)))
  (command "_.zoom" "o" obj "") (command "_.zoom" "0.25X")
  (setvar "cmdecho" cmo) (command "_.undo" "end") (prin1))