Copyright © 2004-2022 SQL: 1.354 saniye - Sorgu: 76 - Ortalama: 0.01781 saniye
 |
 |
 |
 |
|
|
|
|
07.12.2012 14:48
 k005
|
|
Merhaba arkadaşlar;
Kod: ; KUTU ÇİZİMİ ; (defun c:kt () (setvar "cmdecho" 0) (setq plkx (getint "\n Kutu Boyu ? : " )) (setq plky (getint "\n Kutu Eni ? : " )) (setq yr (getpoint "\n Yerlestirme yeri")) (command "color" "1") ; renk kırmızı (command "Rectangle" yr "D" plkx plky yr) (setvar "cmdecho" 1 ) (princ) ) Göndermiş olduğum bu lisp te istenilen ebatta bir kutu çizimi yapılıyor.. yerleştirme noktası olarak kutunun sol alt köşesi referans olarak alınmakta.. yapmak istediğim referans noktasının, kutunun ağırlık merkezinin olması... yardımcı arkadaşa şimdiden teşekkürler..
|
|
07.12.2012 15:30
 Travaci
|
|
Kod: (defun c:kt (/)
(command "undo" "group") (setvar "cmdecho" 0) (Setq oSm (getvar "osmode"))(setq cClr (getvar "cecolor")) (defun *error* (er)(setvar "osmode" oosm) (setvar "cecolor" cclr)(command "undo" "e")(princ er)) (setq Boy (getint "\nKutu Boyu ? : ") En (getint "\nKutu Eni ? : ") Ym (getpoint "\nYerlestirme yeri") M1 (/ Boy 2) M2 (/ En 2) N1 (polar Ym (/ pi 2) m1) N2 (polar Ym (-(/ pi 2)) m1) P1 (polar N1 0 (- m2)) P2 (polar n2 0 m2) ) (setvar "osmode" 0)(setvar "cecolor" "1") (command "Rectangle" p1 p2) (setvar "osmode" oSm)(setvar "cecolor" cclr) (command "_.undo" "e")(princ) )
|
|
07.12.2012 16:00
k005
|
Alıntı
|
|
08.12.2012 16:55
 ProhibiT
|
|
Merhaba arkadaşlar, izninizle lüzumsuz bilgiler ansiklopedimize bir kaç madde daha ekleyelim. :)
Konuşurken, yazarken ve hatta düşünürken doğru kavramlar kullanınız. "En/Genişlik" (genelde dörtgen şekilli) bir objenin kısa kenarını, "Boy/Uzunluk" ise uzun kenarını ifade eder. Yanlış kavramlarla düşünürken, genelde yanlış yollara sapmaktan kurtulamayız. "Ben öyle yazdım ama, böyle düşündüm" kaçamak bakış açısından kurtulmanızı tavsiye ederim. Doğru tanımlayamadığınız bir şeyi bilmiyorsunuz demektir. Bu durumda, yukarıda ele aldığınız örnekte, oluşturulan dikdörtgenin X boyutu, daima Y boyutundan küçük müdür? Öyle olmasa gerek... Böyle bir fonksiyonu ben olsam şu şekilde yazardım; Kod: (defun c:DpR (/ dX dY iP p1 p2 p3 p4) (setq dX (getreal "\nDikdörtgen X boyutu: ") dY (getreal "\nDikdörtgen Y boyutu: ") iP (cadr (grread T)) p1 (list (- (car iP) (/ dX 2.0)) (- (cadr iP) (/ dY 2.0)) (caddr iP)) p2 (list (+ (car p1) dX) (cadr p1) (caddr p1)) p3 (list (car p2) (+ (cadr p2) dY) (caddr p2)) p4 (list (car p1) (cadr p3) (caddr p3))) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 1) (cons 10 p1) (cons 10 p2) (cons 10 p3) (cons 10 p4))) (command "_.Move" (entlast) "" iP Pause) (command "_.undo" "e") (princ)) (grread T) ile Cursor'ın o andaki konumunun okunmasına, ve "Command" fonksiyonunda kullanıcı girişi (User Input) için (pre defined) "PAUSE" sembolünün kullanımına dikkat ediniz. Böyle bir uygulamada, object snap değerleri ile oynamamanızı tavsiye ederim. Oluşturulan dikdörtgen, belkide object snap (nesene kenetlenme) kullanılarak yerleştirilecek! Kolay gelsin.
|
|
08.12.2012 22:11
k005
|
Alıntı
|
|
08.12.2012 23:46
Travaci
|
|
Teşekkürler güzel örnek oldu.
|
|
13.12.2012 11:00
ProhibiT
|
|
Takıntılı olan benim galiba, örneğimizi bir adım daha geliştirirsek;
Kod: ;|***************************************************************************| :)| DdpR: Draw-Drag&Place-Rectangular | | M. Şahin Güvercin www.cizimokulu.com 12.12.2012 | |---------------------------------------------------------------------------|; (defun c:DdpR (/ dX dY iP p1 p2 p3 p4) (if (setq dX (getreal "\n Dikdörtgen X Boyutu:\n[Köşeler için ENTER]: ")) (setq dY (getreal "\n Dikdörtgen Y boyutu: ") iP (cadr (grread T)) p1 (list (- (car iP) (/ dX 2.0)) (- (cadr iP) (/ dY 2.0)) (caddr iP)) p2 (list (+ (car p1) dX) (+ (cadr p1) dY) (caddr p1))) (setq p1 (getpoint "\r Birinci köşe: ") p2 (getcorner p1 "\n İkinci köşe: ") iP (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p1 p2))) (setq p3(list(car p2)(cadr p1)(caddr ip))p4(list(car p1)(cadr p2)(caddr ip))) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 1) (cons 10 p1) (cons 10 p3) (cons 10 p2) (cons 10 p4))) (command "_.Move" (entlast) "" iP Pause) (command "_.undo" "e") (princ)) Dörtgenimizi kenar uzunluklarını girerek çizebileceğimiz gibi, köşe noktalarını seçerek te çizip istenen noktaya yerleştirebiliyoruz.
|
|
13.12.2012 13:00
Travaci
|
|
Çok güzel olmuş : ) Elinize sağlık.
|
|
16.12.2012 12:05
k005
|
Alıntı
|
|
antepnet
|
|
üstadım bu kutuları excelden genişlik ve yusekligini alıp yazdırmak istiyorum
excelde no en yuksekluk 1 5 10 2 7 8 bu şekil bir lsipi yukardaki programla yazımıyla nasıl birleştiriz ben aşagıdaki kodala deneme yaptım olmadı Kod: ;;;--- Program to demonstrate the usage for the getCellsFunction
;;; Version 2.0 ;;; Last updated 5/1/2013 4:20PM CST ;;; By JefferyPSanders.com (defun C:GetCells() ;;;--- Function to retrieve values for a cell or a range of cells ;;; ;;; To retrieve a cells value: ;;; Usage (getCellFunction "C:\\MYFILE.XLS" "Sheet1" "A3") ;;; ;;; To retrieve values for a range of cells ;;; Usage (getCellFunction "C:\\MYFILE.XLS" "Sheet1" "A2:A4") ;;; (vl-load-com) (defun getCellsFunction(fileName sheetName cellName / myXL myBook mySheet myRange cellValue) (setq myXL(vlax-get-or-create-object "Excel.Application")) (vla-put-visible myXL :vlax-false) (vlax-put-property myXL 'DisplayAlerts :vlax-false) (setq myBook (vl-catch-all-apply 'vla-open (list (vlax-get-property myXL "WorkBooks") fileName))) (setq mySheet (vl-catch-all-apply 'vlax-get-property (list (vlax-get-property myBook "Sheets") "Item" sheetName))) (vlax-invoke-method mySheet "Activate") (setq myRange (vlax-get-property (vlax-get-property mySheet 'Cells) "Range" cellName)) (setq cellValue(vlax-variant-value (vlax-get-property myRange 'Value2))) (vl-catch-all-apply 'vlax-invoke-method (list myBook "Close")) (vl-catch-all-apply 'vlax-invoke-method (list myXL "Quit")) (if (not (vlax-object-released-p myRange))(progn(vlax-release-object myRange)(setq myRange nil))) (if (not (vlax-object-released-p mySheet))(progn(vlax-release-object mySheet)(setq mySheet nil))) (if (not (vlax-object-released-p myBook))(progn(vlax-release-object myBook)(setq myBook nil))) (if (not (vlax-object-released-p myXL))(progn(vlax-release-object myXL)(setq myXL nil))) (if(= 'safearray (type cellValue)) (progn (setq tempCellValue(vlax-safearray->list cellValue)) (setq cellValue(list)) (if(= (length tempCellValue) 1) (progn (foreach a tempCellValue (if(= (type a) 'LIST) (progn (foreach b a (if(= (type b) 'LIST) (setq cellValue(append cellValue (list (vlax-variant-value (car b))))) (setq cellValue(append cellValue (list (vlax-variant-value b)))) ) ) ) (setq cellValue(append cellValue (list (vlax-variant-value a)))) ) ) ) (progn (foreach a tempCellValue (setq tmpList(list)) (foreach b a (setq tmp(vlax-variant-value b)) (setq tmpList(append tmpList (list tmp))) ) (setq cellValue(append cellValue tmpList)) ) ) ) ) ) cellValue ) ;;;--- Get the excel file (setq fileName(getfiled "Select Excel File" "" "*" 16)) ;;;--- Get the sheet name (setq sheetName(getstring T "\nName of sheet: ")) ;;;--- Cycle while the user enters cell addresses (while(/= "" (setq cellName(getstring "\nCell address to retrieve? [ Examples: A2 or A1:B4 ]:"))) ;;;--- Get the value of the cell or cells (setq cellValue(getCellsFunction fileName sheetName cellName)) ;;;--- Display the value of the cell(s) (princ (strcat "\n The value of address " cellName " is: "))(princ cellValue) ) (princ) )
|