Public Sub Rectangle_DivXLen_DivYLen()
''// KOD WCS'DE ÇALIŞIR
Dim Pnt1 As Variant: Dim Pnt2 As Variant
Dim Pnts(0 To 14) As Double
Static XLen As Double: Static YLen As Double
Const XYLen As Double = 2500 ''// DEĞİŞTİREBİLİRSİNİZ
Dim RecObj As AcadPolyline

On Error GoTo ExitSub_Rectangle_DivXLen_DivYLen

''// DİKTÖRTGEN KÖŞELERİ BELİRLİYORUZ ( ÖNCE SOL ÜST, SONRA SAĞ ALT KÖŞE )
Pnt1 = ThisDrawing.Utility.GetPoint(, "Specify upper left corner point (Sol Üst Nokta)")
Pnt2 = ThisDrawing.Utility.GetCorner(Pnt1, "Specify lower right corner (Sağ Alt Nokta)")
If Pnt1(0) >= Pnt2(0) Or Pnt1(1) <= Pnt2(1) Then Exit Sub

''// DİKDÖRTGENİ POLYLINE OLARAK ÇİZDİRİYORUZ
Pnts(0) = Pnt1(0): Pnts(1) = Pnt1(1): Pnts(2) = Pnt1(2)
Pnts(3) = Pnt2(0): Pnts(4) = Pnt1(1): Pnts(5) = Pnt1(2)
Pnts(6) = Pnt2(0): Pnts(7) = Pnt2(1): Pnts(8) = Pnt1(2)
Pnts(9) = Pnt1(0): Pnts(10) = Pnt2(1): Pnts(11) = Pnt1(2)
Pnts(12) = Pnt1(0): Pnts(13) = Pnt1(1): Pnts(14) = Pnt1(2)

Set RecObj = ThisDrawing.ModelSpace.AddPolyline(Pnts)

On Error Resume Next

''// 2500 SABİT ÖLÇÜSÜ YERİNE X VE Y EKSENLERİNDE AYRI AYRI ÖLÇÜLER BELİRLEYEBİLİRİZ
''// EĞER ÖLÇÜLERDEN BİRİ 0-SIFIR YA DA KENAR UZUNLUĞUNDAN FAZLA GİRİLİRSE SABİT SAYI (2500) KULLANILIR
''// KOD HER ÇAĞIRILIŞINDA BİR ÖNCEKİNDE BELİRLENEN DEĞERLER ENTER-SAĞ TUŞ İLE TEKRAR ATANABİLİR
XLen = ThisDrawing.Utility.GetDistance(Pnt1, "Division length on X-axis<" & Format(XLen, "#.##") & ">")
YLen = ThisDrawing.Utility.GetDistance(Pnt1, "Division length on Y-axis<" & Format(YLen, "#.##") & ">")

Dim lnPnt1(0 To 2) As Double: Dim lnPnt2(0 To 2) As Double

If XLen < Pnt2(0) - Pnt1(0) And XLen > 0# Then
    lnPnt1(0) = Pnt1(0) + XLen: lnPnt1(1) = Pnt1(1): lnPnt1(2) = Pnt1(2)
    lnPnt2(0) = lnPnt1(0): lnPnt2(1) = Pnt2(1): lnPnt2(2) = Pnt1(2)
        ThisDrawing.ModelSpace.AddLine lnPnt1, lnPnt2
ElseIf Pnt2(0) - Pnt1(0) > XYLen Then
    lnPnt1(0) = (Pnt1(0) + Pnt2(0)) / 2#: lnPnt1(1) = Pnt1(1): lnPnt1(2) = Pnt1(2)
    lnPnt2(0) = lnPnt1(0): lnPnt2(1) = Pnt2(1): lnPnt2(2) = Pnt1(2)
        ThisDrawing.ModelSpace.AddLine lnPnt1, lnPnt2
End If

If YLen < Pnt1(1) - Pnt2(1) And YLen > 0# Then
    lnPnt1(0) = Pnt1(0): lnPnt1(1) = Pnt1(1) - YLen: lnPnt1(2) = Pnt1(2)
    lnPnt2(0) = Pnt2(0): lnPnt2(1) = lnPnt1(1): lnPnt2(2) = Pnt1(2)
        ThisDrawing.ModelSpace.AddLine lnPnt1, lnPnt2
ElseIf Pnt1(1) - Pnt2(1) > XYLen Then
    lnPnt1(0) = Pnt1(0): lnPnt1(1) = (Pnt1(1) + Pnt2(1)) / 2#: lnPnt1(2) = Pnt1(2)
    lnPnt2(0) = Pnt2(0): lnPnt2(1) = lnPnt1(1): lnPnt2(2) = Pnt1(2)
        ThisDrawing.ModelSpace.AddLine lnPnt1, lnPnt2
End If


ExitSub_Rectangle_DivXLen_DivYLen:
       
End Sub

;;; lips Kesit Kotları
;;; GÖKHAN DOLU
;;; Tüm hakları Dolunay_1071 aittir

(defun KK (/ nokta x y nokta_y yazi aciklama)
(prompt "
10/2005 © Gd  Koordinat yazımı.")
(setvar "CMDECHO" 1)

(while (= nokta nil)
(setq nokta (getpoint "
Koordinatı alınacak noktayı girin: "))
(if (= nokta nil) (princ "Kot noktasını girin..."))
)
(setq Y (car nokta)
X (cadr nokta))
(setq aciklama (strcat "Y:"(rtos x) "_ X:" (rtos y)))
(princ aciklama)
(setq nokta_y (getpoint ( strcat "
Yazının başlangıç noktasını girin /<Koordinat noktası>: ")))
(if (= nokta_y nil) (setq nokta_y nokta))
(command "text" "S" "" nokta_y "15" "0" aciklama)
(princ)
)