ehya (06.08.2007 14:05 GMT)

admin (21.01.2018 18:30 GMT)

Alıntı

---

atillaözel6666 :
öncelikle selamun aleykum deyim...
arkadaşlar ben harita teknikeriyim ve netcad kullanıyoruz ama bazen çizimleri netcadden autocade gönderip autocadde çalışmamız gerekiyor...fakat netcadde numaralı olan noktaları autocade dxf olarak ((dönüştürdüğümde nokta numaralarını göremiyorum..)).bu sorunu nasıl çözeriz...

yardımcı olursanız çok sevinirim

---

:yes

Alıntı

---

(Defun myerror (s)
(If (/= "Function cancelled")
(progn
(setvar "aunits" Aun)
(setvar "lunits" Lun)
(setvar "auprec" Aup)
(setvar "luprec" Lup)
(command "Ucs" "W")
(setq *error* olderr)
(princ)
)
)
)
;;; Ana Program Yükleniyor

(defun C:AX (/ olderr Aun Lun Aup
Lup Aks_ESA Hata_ESA Test_ESA Hat_ESA
Tes_ESA Te_ESA Yaz_ESA Ha_ESA H_ESA
SIL_ESA Exp_ESA LISTE_ESA Lsayı_ESA YAYLISTESI_ESA
n_ESA Yaysay_ESA
)


;;; Sistem Değişkenleri Ayarlanıyor

(command "Ucs" "W")
(setq Aun (getvar "aunits"))
(setvar "aunits" 3)
(setq Lun (getvar "lunits"))
(setvar "lunits" 2)
(setq Aup (getvar "auprec"))
(setvar "auprec" 8)
(setq Lup (getvar "luprec"))
(setvar "luprec" 8)
(setvar "cmdecho" 0)
(setq olderr *error*
*error* myerror
)

;;; Ana Proğram Başladı
(Princ "\nYol aksını seçiniz (polyline) :")
(Setq AKS_ESA (Ssget))

;;; ProÄŸram Test Ediliyor (Test 1)
(Setq Hata_ESA "HİÇBİR NESNE SEÇİLEMEDİ...:")
(if (= AKS_ESA nil)
(progn
(princ Hata_ESA)
(exit)
)
)

(Setq TEST_ESA (sslength AKS_ESA))

;;; ProÄŸram Test Ediliyor (Test 2)
(Setq Hat_ESA
(strcat "SEÇTİĞİNİZ NESNE SAYISI BİR VE PLINE OLMALIDIR...:"
(rtos TEST_ESA 2 0)
" DEĞİL"
)
)
(if (/= TEST_ESA 1)
(progn
(Princ "\n Hata..:")
(princ Hat_ESA)
(exit)
)
)

(Setq TES_ESA AKS_ESA)

;;; ProÄŸram Test Ediliyor (Test 3)
(Setq TES_ESA (cdr (cadr (entget (ssname TES_ESA 0)))))
(Setq Yaz_ESA "BLOCK")
(Setq Ha_ESA
(strcase
(strcat "Seçtiğiniz Obje Pline Değil...:" Yaz_ESA '" dir")
)
)
(if (= "INSERT" TES_ESA)
(progn
(terpri)
(princ Ha_ESA)
(s)
)
)

(Setq TE_ESA AKS_ESA)

;;; ProÄŸram Test Ediliyor (Test 4)
(Setq TE_ESA (cdr (cadr (entget (ssname TE_ESA 0)))))
(Setq
H_ESA (strcase
(strcat "Seçtiğiniz Obje Pline Değil...:" TE_ESA '" dir")
)
)
(if (/= "LWPOLYLINE" TE_ESA)
(progn
(terpri)
(princ H_ESA)
(s)
)
)

;;; ProÄŸram Test Ediliyor (Test 5)
(if (= TEST_ESA 1)
(progn
(princ "\n AKS SEÇİMİ BAŞARILI TEBRİKLER...:")
(command "delay" 1)
)
)
(Setq SIL_ESA AKS_ESA)
(Setq EXP_ESA AKS_ESA)

(Command "Copy" EXP_ESA "" "0,0,0" "0,0,0")
(Command "Explode" "l")

;;; Ana Liste Hazırlanıyor
(Setq LISTE_ESA (Ssget "p"))

;;; Ana Liste Eleman Sayısı Hesaplanıyor
(Setq LSAYI_ESA (sslength LISTE_ESA))

;;; Arc'ların Seçimine Başlandı
(Setq YAYLISTESI_ESA (list))
(Setq n_ESA 0)
(Setq YAYSAY_ESA 0)
(repeat LSAYI_ESA
(if (= (cdr (assoc 0 (entget (ssname LISTE_ESA n_ESA)))) "ARC")
(progn
(Setq YAY_ESA (ssname LISTE_ESA n_ESA))
(KURP_ESA YAY_ESA)
(setq yaysay_ESA (1+ yaysay_ESA))
)
)
(Setq n_ESA (+ 1 n_ESA))
)
(Command "Erase" "p" "")
(Setq YAYSAY_ESA
(strcat "AKS UZERINDE <"
(rtos YAYSAY_ESA 2 0)
"> adet KURBUNUZ VAR...:"
)
)
(Princ YAYSAY_ESA)
(princ "\n Program Sona Erdi........:")
(setvar "aunits" 0)
(setvar "lunits" 2)
(setvar "auprec" 3)
(setvar "luprec" 2)
(command "UCS" "W")
(setvar "cmdecho" 1)
(setq *error* olderr)
(princ)
)


;;; Ana Destek Programı Yüklendi

(Defun KURP_ESA (YAY_ESA / olderr Aun Lun
Aup Lup Lis_ESA R_ESA Cor_ESA
Sa_ESA Ea_ESA L_ESA To_ESA Tf_ESA
T_ESA Te_ESA Some_ESA Delta_ESA Cx_ESA
Cy_ESA Sx_ESA Sy_ESA L_Name p1_ESA
p2_ESA p3_ESA p4_ESA p5_ESA p6_ESA
pp1_ESA pp2_ESA pp3_ESA pp4_ESA pp5_ESA
pp6_ESA T1_ESA T2_ESA T3_ESA T4_ESA
T5_ESA T6_ESA Merx_ESA Mery_ESA Meri_ESA
Merye_ESA Yer_ESA
)

(Setq Lis_ESA (entget YAY_ESA))
(Setq R_ESA (cdr (assoc 40 Lis_ESA)))
(Setq Cor_ESA (cdr (assoc 10 Lis_ESA)))
(Setq Sa_ESA (cdr (assoc 50 Lis_ESA)))
(Setq Ea_ESA (cdr (assoc 51 Lis_ESA)))
(cond
((< Sa_ESA Ea_ESA) (Setq Delta_ESA (- Ea_ESA Sa_ESA)))
((> Sa_ESA Ea_ESA)
(Setq Delta_ESA (- (* 2 pi) (- Sa_ESA Ea_ESA)))
)
)

;;; Hesaplama İşlemleri Başlıyor

(Setq L_ESA (* Delta_ESA R_ESA))
(Setq TO_ESA (Polar Cor_ESA Ea_ESA R_ESA))
(Setq TF_ESA (Polar Cor_ESA Sa_ESA R_ESA))

(If (< Delta_ESA Pi)
(Progn
(Setq T_ESA
(* R_ESA (/ (sin (/ Delta_ESA 2)) (cos (/ Delta_ESA 2))))
)
(Setq TE_ESA (Sqrt (+ (Expt R_ESA 2) (Expt T_ESA 2))))
(Setq SOME_ESA (Polar Cor_ESA (+ (/ Delta_ESA 2) SA_ESA) TE_ESA))
)
(Progn
(princ "girdi")
(Setq T_ESA (* R_ESA
(/ (sin (- Pi (/ Delta_ESA 2)))
(cos (- Pi (/ Delta_ESA 2)))
)
)
)
(Setq TE_ESA (Sqrt (+ (Expt R_ESA 2) (Expt T_ESA 2))))
(Setq
SOME_ESA (Polar Cor_ESA (+ (/ Delta_ESA 2) SA_ESA Pi) TE_ESA)
)
)
)

;;;Dönüştürme İşlemleri Başlıyor

(Setq Delta_ESA (/ (* Delta_ESA 200) pi))
(Setq Delta_ESA (Strcat "D= " (rtos Delta_ESA 2 4) "g"))
(Setq L_ESA (Strcat "L= " (rtos L_ESA 2 3) "m"))
(Setq R_ESA (Strcat "R= " (rtos R_ESA 2 3) "m"))
(Setq T_ESA (Strcat "T= " (rtos T_ESA 2 3) "m"))
(Setq SX_ESA (car some_ESA))
(Setq SX_ESA (Strcat "E= " (rtos SX_ESA 2 3)))
(Setq SY_ESA (cadr some_ESA))
(Setq SY_ESA (Strcat "N= " (rtos SY_ESA 2 3)))
(Setq Cx_ESA (Strcat "E=" (rtos (car cor_ESA) 2 3)))
(Setq Cy_ESA (Strcat "N=" (rtos (cadr cor_ESA) 2 3)))

;;;Tanjant ve Yarıçapların Çizdilmesi

(LAYER_ESA "RTL_ESA")
(Command "Line" TO_ESA Some_ESA TF_ESA Cor_ESA "c")

;;;Tablo Çizdirilmeye Başlıyor (Tablo Layer 'ı Açılıyor)

(LAYER_ESA "TABLO_ESA")
(Terpri)
(Setq p1_ESA "0.0,4.16666667"
pp1_ESA "26.95768449,4.16666667"
p2_ESA "0.0,8.33333333"
pp2_ESA "26.95768449,8.33333333"
p3_ESA "0.0,12.50000000"
pp3_ESA "26.95768449,12.50000000"
p4_ESA "0.0,16.66666667"
pp4_ESA "26.95768449,16.66666667"
p5_ESA "0.0,20.83333333"
pp5_ESA "26.95768449,20.83333333"
p6_ESA "5.49139018,0.00"
pp6_ESA "5.49139018,25.00"
)

;;;Merkez Kordinatı Yazım İçin Hesaplanıyor

(Setq Merx_ESA (car Cor_ESA))
(Setq Mery_ESA (cadr Cor_ESA))
(Setq Meri_ESA (- Mery_ESA 4))
(Setq Meri_ESA (List Merx_ESA Meri_ESA))
(Setq Merye_ESA (- Mery_ESA 7))
(Setq Merye_ESA (List Merx_ESA Merye_ESA))

;;;Tablo Çizimi Başladı
(Command "OSNAP" "NONE")
(setq Yer_ESA Some_ESA)
(Command "ucs" "O" Yer_ESA)
(Command "Line" p1_ESA pp1_ESA "")
(Command "Line" p2_ESA pp2_ESA "")
(Command "Line" p3_ESA pp3_ESA "")
(Command "Line" p4_ESA pp4_ESA "")
(Command "Line" p5_ESA pp5_ESA "")
(Command "Line" p6_ESA pp6_ESA "")
(Command "Rectang" "0,0" "26.95768449,25")
(Setq T1_ESA "0.72585523,1.12841021")
(Setq T2_ESA "0.72585523,5.29507688")
(Setq T3_ESA "0.72585523,9.46174354")
(Setq T4_ESA "0.72585523,13.62841021")
(Setq T5_ESA "0.72585523,17.79507688")
(Setq T6_ESA "0.72585523,21.96174354")
(Command "Text" T1_ESA 2 "" SX_ESA)
(Command "Text" T2_ESA 2 "" SY_ESA)
(Command "Text" T3_ESA 2 "" Delta_ESA)
(Command "Text" T4_ESA 2 "" T_ESA)
(Command "Text" T5_ESA 2 "" L_ESA)
(Command "Text" T6_ESA 2 "" R_ESA)
(Command "UCS" "W")

;;;Merkez Koordinatları İçin Layer Ataması

(LAYER_ESA "MERKEZ_ESA")
(Command "Text" Meri_ESA 2 "" Cy_ESA)
(Command "Text" Merye_ESA 2 "" Cx_ESA)
)
(Defun Layer_ESA (LNAME_ESA / LO_ESA LF_ESA)
(If (Tblsearch "Layer" LNAME_ESA)
(Progn
(Setq LF_ESA
(Cdr (Assoc 70 (Entget (Tblobjname "Layer" LNAME_ESA))))
)
(Setq LO_ESA
(Cdr (Assoc 62 (Entget (Tblobjname "Layer" LNAME_ESA))))
)
(If (Or (= LF_ESA 1) (= LF_ESA 3) (= LF_ESA 5) (= LF_ESA 7))
(Progn
(COMMAND "LAYER" "THAW" LNAME_ESA "")
(COMMAND "-LAYER" "ON" LNAME_ESA "")
(Command "-Layer" "U" LNAME_ESA "")
)
)
(If (Minusp LO_ESA)
(Progn
(COMMAND "LAYER" "THAW" LNAME_ESA "")
(COMMAND "-LAYER" "ON" LNAME_ESA "")
(Command "-Layer" "U" LNAME_ESA "")
)
)
(If (>= LF_ESA 4)
(Progn
(COMMAND "LAYER" "THAW" LNAME_ESA "")
(COMMAND "-LAYER" "ON" LNAME_ESA "")
(Command "-Layer" "U" LNAME_ESA "")
)
)
(Setvar "Clayer" LNAME_ESA)
)
(Command "-LAYER" "M" LNAME_ESA "")
)
)

---

Alıntı

---

sasmaz71 :
arkadaşlar birde ben bişey sorcam bu windows 7 64 bit olduğu için netcad de uyumsuz bu konuda bilgisi olan varmı. ben netcadi yükleyemedim windows 7 ye. yardımlarınız için şimdiden tşk. ederim.

---