19.12.2019 06:10    

Selam arkadaşlar.
İşinize yarar belki. Yazdirma işiniz çok oluyorsa zamanı kısaltan kendi yaptığım lispi sizle paylaşmak istiyorum.
Bu lisple yazdırcağınız resimlerin koordinatlarını ekrana kaydedebilir ve ihtiyacınız oldukça girip sadece kaydettiğiniz koordinat yazıları secerek hizlica çikti alabilirsiniz. Yada normal Köşe noktaları ile çıktı alabilirsiniz.
Bir kaç değişiklik yapmanız gerekebilir onlarıda programda belirttim. Atladığım yerleride aynı mantıkla düzeltirsiniz...

;;***********************************************************************************
( Defun c:plotsetxx ( / os1 ols cl vaziyet n m z secim pnt1 pnt2 pnt3 c_adet sor z s islem sor_1 nn deg1 deg2 sor_2 mrk1 deg3 deg4 ustx usty altx alty txt yaz_bul pllt stil kagt kgat drum
obje r k_text mod1 sor_3 cikti hafiza kagit durum nodd )
( setq os1 ( getvar "osmode" ) ols ( getvar "dimscale" ) cl ( getvar "cecolor" ) )

;;D=Secenegi ile Çıktısı alınacak resimlerin koordinatlarını ekrana yazdırır bir köşede durur ve çikti gerektikçe "P" Seçeneği ile direk yazdırırsınız...
;;P=Yukarda belirttiğim gibi hazır kodları yazdırır... N=Normal yazdırma köşe noktadan diğer köşe noktasını işaretleme ile yazdırma...

( initget 3 "D P N" )
( setq vaziyet ( strcase ( getkword "\nDATA YAZMA => <D>...\nDATA YAZDIRMA => <P>...\nNORMAL YAZDIRMA => <N>...giriniz... ? " ) ) )
( if ( or ( = vaziyet "D" ) ( = vaziyet "N" ) ) ( progn
( setq n 1 m 1 z 1 secim ( ssadd )
hafiza ( list ( list nil nil ) ) cikti ( list ( list nil nil ) ) kagit ( list ( list nil nil ) ) durum ( list ( list nil nil ) ) nodd ( list ( list nil nil ) ) )
( setvar "osmode" 33 )
( While ( setq pnt1 ( getpoint "\nCercevenin ust kismi isaretleyiniz...........? " ) )
( setq pnt2 ( getcorner pnt1 "\nCercevenin alt kismini isaretleyiniz...? " ) )
( setvar "osmode" 0 )
( setq pnt3 ( polar pnt1 ( angle pnt1 pnt2 ) ( / ( distance pnt1 pnt2 ) 2.0 ) ) )
( setvar "cecolor" "1" )
( command "text" "J" "MC" pnt3 ( / ( distance pnt1 pnt2 ) 3.0 ) "0" ( itoa m ) "" )
( setq secim ( ssadd ( entlast ) secim ) )
( setvar "cecolor" cl )
( setq hafiza ( append hafiza ( list ( list n pnt1 ) ) ) n ( + n 1 )
hafiza ( append hafiza ( list ( list n pnt2 ) ) ) n ( + n 1 )
cikti ( append cikti ( list ( list m "H-02.ctb" ) ) ) ;;ctb dosyanızı giriniz...
kagit ( append kagit ( list ( list m "A3" ) ) ) ;;Yazıcınızın kağıt girişini giriniz bazen "ISO A3(420*297)" gibi olabiliyor.
durum ( append durum ( list ( list m "Landscape" ) ) )
nodd ( append nodd ( list ( list m "YOK" ) ) ) m ( + m 1 ) )
( setvar "osmode" 33 ) )
( setq c_adet ( - m 1 ) )

;; Butun çıktılarınız A3 ve Landscape olarak hafızaya alındı. doğru ise <K> Arada başka formatlar varsa <D> seçmelisiniz...

( initget 3 "K D" )
( setq sor ( strcase ( getkword "\nHafizaya alinan degerler => "H-02"..."A3"..."Landscape"...Not."YOK"...
\nDegerler dogru ise "K" Duzeltmek icin "D" seceneklerden birini giriniz...? " ) ) )
( if ( = sor "D" ) ( progn
( While ( = z 1 )
( setq s 1 )
( While ( = s 1 ) ( setq islem ( strcase ( getstring "\nCikti Kalitesi Komple Degisecekse "CK" Bazilari degisecekse "CP"
\nKagit Cesidi Komple Degisecekse.. "KK" Bazilari degisecekse "KP"
\nKagit Yon Hali Komple Degisecekse "DK" Bazilari degisecekse "DP"
\nNot durumu Komple Degisecekse.... "NK" Bazilari degisecekse "NP"
\nCikmak icin "X" giriniz...? " ) ) )
( if ( or ( = islem "CK" ) ( = islem "CP" ) ( = islem "KK" ) ( = islem "KP" ) ( = islem "DK" ) ( = islem "DP" ) ( = islem "NK" ) ( = islem "NP" ) ( = islem "X" ) ) ( setq s 0 ) ) )
( if ( = islem "X" ) ( setq z 0 ) ( progn
( if ( = "CK" islem ) ( progn
( initget 3 "H M A" )
( setq sor_1 ( strcase ( getkword "\nH-02 icin "H"...MONOCORME icin "M"..........\nACAD icin "A"...........
\nSeceneklerden birini seciniz...? " ) ) cikti ( list ( list nil nil ) ) nn 1 )
( if ( = "M" sor_1 ) ( setq deg1 "monochrome.ctb" ) )
( if ( = "H" sor_1 ) ( setq deg1 "H-02.ctb" ) ) ;;kendi ctb niz
( if ( = "A" sor_1 ) ( setq deg1 "acad.ctb" ) )
( repeat ( - m 1 ) ( setq cikti ( append cikti ( list ( list nn deg1 ) ) ) nn ( + nn 1 ) ) ) ) )
( if ( = "KK" islem ) ( progn
( initget 3 "A B" )
( setq sor_1 ( strcase ( getkword "\nA3 Kagit icin "A"..........\nA4 Kagit icin "B"..........
\nSeceneklerden birini seciniz...? " ) ) kagit ( list ( list nil nil ) ) nn 1 )
( if ( = "A" sor_1 ) ( setq deg1 "A3" ) ) ;;Yazıcınızın kağıt girişi
( if ( = "B" sor_1 ) ( setq deg1 "A4" ) ) ;;Yazıcınızın kağıt girişi
( repeat ( - m 1 ) ( setq kagit ( append kagit ( list ( list nn deg1 ) ) ) nn ( + nn 1 ) ) ) ) )
( if ( = "DK" islem ) ( progn
( initget 3 "L P" )
( setq sor_1 ( strcase ( getkword "\nLANDSPACE icin "L"..........\nPOTRAIT icin "P"..........
\nSeceneklerden birini seciniz...? " ) ) durum ( list ( list nil nil ) ) nn 1 )
( if ( = "L" sor_1 ) ( setq deg1 "Landscape" ) )
( if ( = "P" sor_1 ) ( setq deg1 "Portrait" ) )
( repeat ( - m 1 ) ( setq durum ( append durum ( list ( list nn deg1 ) ) ) nn ( + nn 1 ) ) ) ) )
( if ( = "NK" islem ) ( progn
( setq deg1 ( strcase ( getstring T "\nNotunuzu giriniz...? " ) ) nodd ( list ( list nil nil ) ) nn 1 )
( repeat ( - m 1 ) ( setq nodd ( append nodd ( list ( list nn deg1 ) ) ) nn ( + nn 1 ) ) ) ) )
( if ( = "CP" islem ) ( progn
( setq n 1 deg2 nil )
( While ( = n 1 )
( setq sor_2 ( strcase ( getstring "\nIslem yapacaginiz numara ile birlikte.Assagidaki seceneklerden birini giriniz.
\nH-02 icin "Rakam + H"..........\nMONOCORME icin "Rakam + M"..........\nACAD icin "Rakam + A"...........
\nCikmak icin "X"..........giriniz...? " ) ) )
( if ( = "X" sor_2 ) ( setq n 0 ) ( progn
( cond
( ( or ( = "H" ( substr sor_2 2 1 ) ) ( = "M" ( substr sor_2 2 1 ) ) ( = "A" ( substr sor_2 2 1 ) ) ) ( setq degs ( substr sor_2 1 1 ) deg1 ( substr sor_2 2 ) ) )
( ( or ( = "H" ( substr sor_2 3 1 ) ) ( = "M" ( substr sor_2 3 1 ) ) ( = "A" ( substr sor_2 3 1 ) ) ) ( setq degs ( substr sor_2 1 2 ) deg1 ( substr sor_2 3 ) ) )
( ( or ( = "H" ( substr sor_2 4 1 ) ) ( = "M" ( substr sor_2 4 1 ) ) ( = "A" ( substr sor_2 4 1 ) ) ) ( setq degs ( substr sor_2 1 3 ) deg1 ( substr sor_2 4 ) ) ) )
( if ( = "M" deg1 ) ( setq deg2 "monochrome.ctb" ) )
( if ( = "H" deg1 ) ( setq deg2 "H-02.ctb" ) ) ;; Kendi ctb niz
( if ( = "A" deg1 ) ( setq deg2 "acad.ctb" ) )
( if ( null deg2 ) ( progn ( alert "\nDEGER BULUNAMADI!!!" ) ( setvar "osmode" os1 ) ( exit ) ) )
( setq cikti ( subst ( list ( atoi degs ) deg2 ) ( assoc ( atoi degs ) cikti ) cikti ) ) ) ) ) ) )
( if ( = "KP" islem ) ( progn
( setq n 1 deg2 nil )
( While ( = n 1 )
( setq sor_2 ( strcase ( getstring "\nIslem yapacaginiz numara ile birlikte.Assagidaki seceneklerden birini giriniz.
\nA3 Kagit icin "RAKAM + A"..........\nA4 Kagit icin "RAKAM + B"..........
\nCikmak icin "X"...........giriniz...? " ) ) )
( if ( = "X" sor_2 ) ( setq n 0 ) ( progn
( cond
( ( or ( = "A" ( substr sor_2 2 1 ) ) ( = "B" ( substr sor_2 2 1 ) ) ) ( setq degs ( substr sor_2 1 1 ) deg1 ( substr sor_2 2 ) ) )
( ( or ( = "A" ( substr sor_2 3 1 ) ) ( = "B" ( substr sor_2 3 1 ) ) ) ( setq degs ( substr sor_2 1 2 ) deg1 ( substr sor_2 3 ) ) )
( ( or ( = "A" ( substr sor_2 4 1 ) ) ( = "B" ( substr sor_2 4 1 ) ) ) ( setq degs ( substr sor_2 1 3 ) deg1 ( substr sor_2 4 ) ) ) )
( if ( = "A" deg1 ) ( setq deg2 "A3" ) )
( if ( = "B" deg1 ) ( setq deg2 "A4" ) )
( if ( null deg2 ) ( progn ( alert "\nDEGER BULUNAMADI!!!" ) ( setvar "osmode" os1 ) ( exit ) ) )
( setq kagit ( subst ( list ( atoi degs ) deg2 ) ( assoc ( atoi degs ) kagit ) kagit ) ) ) ) ) ) )
( if ( = "DP" islem ) ( progn
( setq n 1 deg2 nil )
( While ( = n 1 )
( setq sor_2 ( strcase ( getstring "\nIslem yapacaginiz numara ile birlikte.Assagidaki seceneklerden birini giriniz.
\nLANDSPACE icin "RAKAM + L"..........\nPOTRAIT icin "RAKAM + P"..........
\nCikmak icin "X"...giriniz...? " ) ) )
( if ( = "X" sor_2 ) ( setq n 0 ) ( progn
( cond
( ( or ( = "L" ( substr sor_2 2 1 ) ) ( = "P" ( substr sor_2 2 1 ) ) ) ( setq degs ( substr sor_2 1 1 ) deg1 ( substr sor_2 2 ) ) )
( ( or ( = "L" ( substr sor_2 3 1 ) ) ( = "P" ( substr sor_2 3 1 ) ) ) ( setq degs ( substr sor_2 1 2 ) deg1 ( substr sor_2 3 ) ) )
( ( or ( = "L" ( substr sor_2 4 1 ) ) ( = "P" ( substr sor_2 4 1 ) ) ) ( setq degs ( substr sor_2 1 3 ) deg1 ( substr sor_2 4 ) ) ) )
( if ( = "L" deg1 ) ( setq deg2 "Landscape" ) )
( if ( = "P" deg1 ) ( setq deg2 "Portrait" ) )
( if ( null deg2 ) ( progn ( alert "\nDEGER BULUNAMADI!!!" ) ( setvar "osmode" os1 ) ( exit ) ) )
( setq durum ( subst ( list ( atoi degs ) deg2 ) ( assoc ( atoi degs ) durum ) durum ) ) ) ) ) ) )
( if ( = "NP" islem ) ( progn
( setq n 1 deg1 nil )
( While ( = n 1 )
( setq sor_2 ( strcase ( getstring "\nIslem yapacaginiz numarayi giriniz.
\nCikmak icin "X"..........giriniz...? " ) ) )
( if ( = "X" sor_2 ) ( setq n 0 ) ( progn
( setq sor_3 ( strcase ( getstring T "\nNotunuzu giriniz...? " ) ) )
( setq nodd ( subst ( list ( atoi sor_2 ) sor_3 ) ( assoc ( atoi sor_2 ) nodd ) nodd ) ) ) ) ) ) ) ) ) ) ) )
( command "ERASE" secim "" ) ) )
( if ( = vaziyet "D" ) ( progn
( setq mrk1 ( getpoint "\nBir nokta isaretleyiniz...? " ) n 1 m 1 )
( repeat c_adet
( setq pnt1 ( cadr ( assoc n hafiza ) ) n ( + n 1 )
pnt2 ( cadr ( assoc n hafiza ) ) n ( + n 1 )
deg1 ( cadr ( assoc m cikti ) )
deg2 ( cadr ( assoc m kagit ) )
deg3 ( cadr ( assoc m durum ) )
deg4 ( cadr ( assoc m nodd ) ) m ( + m 1 ) )
( setq ustx ( rtos ( car pnt1 ) 2 4 ) usty ( rtos ( cadr pnt1 ) 2 4 ) )
( setq altx ( rtos ( car pnt2 ) 2 4 ) alty ( rtos ( cadr pnt2 ) 2 4 ) )
( setq txt ( strcat ustx "#" usty "#" altx "#" alty "#" deg1 "#" deg2 "#" deg3 "#" deg4 "#" ) )
( setvar "cecolor" "232" )
( command "text" mrk1 ( * ols 3.0 ) "0" txt "" )
( setvar "cecolor" cl )
( setq mrk1 ( polar mrk1 ( aci 90.0 ) ( * ols 5.0 ) ) ) ) ) )
( if ( = vaziyet "N" ) ( progn
;; yaz_bul girişine kendi yazıcılarınızı girin... ve pllt girişlerine yazıcınızın tam adlarını girin...
( initget 3 "W P X B" )
( setq yaz_bul ( strcase ( getkword "\nWORKCENTRE."W"...\nP-3521 MFP."P"...\n256 KX."X"...\nBROTHER."B"...Yazicilardan birini seciniz...? " ) ) )
( if ( = "W" yaz_bul ) ( progn
( setq pllt "WorkCentre 5330 PCL6" n 1 m 1 )
( repeat c_adet
( setq pnt1 ( cadr ( assoc n hafiza ) ) n ( + n 1 )
pnt2 ( cadr ( assoc n hafiza ) ) n ( + n 1 )
stil ( cadr ( assoc m cikti ) )
kagt ( cadr ( assoc m kagit ) )
drum ( cadr ( assoc m durum ) ) m ( + m 1 ) )
( if ( = "A3" kagt ) ( setq kgat "A3 (297 x 420 mm)" ) )
( if ( = "A4" kagt ) ( setq kgat "A4 (210 x 297 mm)" ) )
( command "-plot" "Yes" "Model" pllt kgat "Millimeters" drum "Yes" "window" pnt1 pnt2 "fit" "Center" "Yes" stil "Yes" "" "No" "No" "Yes" ) ) ) )
( if ( = "P" yaz_bul ) ( progn
( setq pllt "P-3521 MFP" n 1 m 1 )
( repeat c_adet
( setq pnt1 ( cadr ( assoc n hafiza ) ) n ( + n 1 )
pnt2 ( cadr ( assoc n hafiza ) ) n ( + n 1 )
stil ( cadr ( assoc m cikti ) )
kagt ( cadr ( assoc m kagit ) )
drum ( cadr ( assoc m durum ) ) m ( + m 1 ) )
( if ( = "A3" kagt ) ( setq kagt "A4" ) )
( command "-plot" "Yes" "Model" pllt kagt "Millimeters" drum "Yes" "window" pnt1 pnt2 "fit" "Center" "Yes" stil "Yes" "" "No" "No" "Yes" ) ) ) )
( if ( = "X" yaz_bul ) ( progn
( setq pllt "256i KX" n 1 m 1 )
( repeat c_adet
( setq pnt1 ( cadr ( assoc n hafiza ) ) n ( + n 1 )
pnt2 ( cadr ( assoc n hafiza ) ) n ( + n 1 )
stil ( cadr ( assoc m cikti ) )
kagt ( cadr ( assoc m kagit ) )
drum ( cadr ( assoc m durum ) ) m ( + m 1 ) )
( command "-plot" "Yes" "Model" pllt kagt "Millimeters" drum "Yes" "window" pnt1 pnt2 "fit" "Center" "Yes" stil "Yes" "" "No" "No" "Yes" ) ) ) )
( if ( = "B" yaz_bul ) ( progn
( setq pllt "Brother MFC-6490CW Printer" n 1 m 1 )
( repeat c_adet
( setq pnt1 ( cadr ( assoc n hafiza ) ) n ( + n 1 )
pnt2 ( cadr ( assoc n hafiza ) ) n ( + n 1 )
stil ( cadr ( assoc m cikti ) )
kagt ( cadr ( assoc m kagit ) )
drum ( cadr ( assoc m durum ) ) m ( + m 1 ) )
( command "-plot" "Yes" "Model" pllt kagt "Millimeters" drum "Yes" "window" pnt1 pnt2 "fit" "Center" "Yes" stil "Yes" "" "No" "No" "Yes" ) ) ) ) ) )
( if ( = vaziyet "P" ) ( progn
( initget 3 "W P X B" )
( setq yaz_bul ( strcase ( getkword "\nWORKCENTRE."W"...\nP-3521 MFP."P"...\n256 KX."X"...\nBROTHER."B"...Yazicilardan birini seciniz...? " ) ) )
( if ( = yaz_bul "W" ) ( setq pllt "WorkCentre 5330 PCL6" ) )
( if ( = yaz_bul "P" ) ( setq pllt "P-3521 MFP" ) )
( if ( = yaz_bul "X" ) ( setq pllt "256i KX" ) )
( if ( = yaz_bul "B" ) ( setq pllt "Brother MFC-6490CW Printer" ) )
( princ "Çıktı alınacak dataları seçiniz..." )
( setq obje ( ssget ) r 0 )
( Repeat ( sslength obje )
( if ( and ( = "TEXT" ( cdr ( assoc 0 ( entget ( ssname obje r ) ) ) ) ) ( = 232 ( cdr ( assoc 62 ( entget ( ssname obje r ) ) ) ) ) ) ( progn
( setq k_text ( cdr ( assoc 1 ( entget ( ssname obje r ) ) ) ) n 0 m 1 mod1 1 )
( repeat ( strlen k_text )
( setq n ( + n 1 ) )
( cond
( ( and ( = mod1 1 ) ( = ( substr k_text n 1 ) "#" ) ) ( setq ustx ( substr k_text m ( - n m ) ) mod1 ( + mod1 1 ) m ( + n 1 ) ) )
( ( and ( = mod1 2 ) ( = ( substr k_text n 1 ) "#" ) ) ( setq usty ( substr k_text m ( - n m ) ) mod1 ( + mod1 1 ) m ( + n 1 ) ) )
( ( and ( = mod1 3 ) ( = ( substr k_text n 1 ) "#" ) ) ( setq altx ( substr k_text m ( - n m ) ) mod1 ( + mod1 1 ) m ( + n 1 ) ) )
( ( and ( = mod1 4 ) ( = ( substr k_text n 1 ) "#" ) ) ( setq alty ( substr k_text m ( - n m ) ) mod1 ( + mod1 1 ) m ( + n 1 ) ) )
( ( and ( = mod1 5 ) ( = ( substr k_text n 1 ) "#" ) ) ( setq stil ( substr k_text m ( - n m ) ) mod1 ( + mod1 1 ) m ( + n 1 ) ) )
( ( and ( = mod1 6 ) ( = ( substr k_text n 1 ) "#" ) ) ( setq kagt ( substr k_text m ( - n m ) ) mod1 ( + mod1 1 ) m ( + n 1 ) ) )
( ( and ( = mod1 7 ) ( = ( substr k_text n 1 ) "#" ) ) ( setq drum ( substr k_text m ( - n m ) ) mod1 ( + mod1 1 ) m ( + n 1 ) ) ) ) )
( setq pnt1 ( list ( atof ustx ) ( atof usty ) )
pnt2 ( list ( atof altx ) ( atof alty ) )
kgat kagt )
( if ( = yaz_bul "W" ) ( progn
( if ( = "A3" kagt ) ( setq kgat "A3 (297 x 420 mm)" ) )
( if ( = "A4" kagt ) ( setq kgat "A4 (210 x 297 mm)" ) ) ) )
( if ( = yaz_bul "P" ) ( if ( = "A3" kagt ) ( setq kgat "A4" ) ) )
( command "-plot" "Yes" "Model" pllt kgat "Millimeters" drum "Yes" "window" pnt1 pnt2 "fit" "Center" "Yes" stil "Yes" "" "No" "No" "Yes" ) ) )
( setq r ( + r 1 ) ) ) ) )
( setvar "osmode" os1 )
)

Umarım isinize yarar.