29.02.2016 14:08

83116    

Merhaba,
Bu siteyi hazırlayan ve kullanan arkadaşlara teşekkürler çok faydalı bilgilere ulaşıyoruz.
Benim sorum aşağıya kopyaladığım lisp için lispten çıkan excel dosyasındaki x ile y koordinatlarının sütunlarını nasıl yer değiştirebiliriz ?
Çok teşekkürler cevabınız için şimdiden

(write-line "Hazэrlayan: M. Юahin Gьvercin - www.cizimokulu.com")
(defun c:PcT (/ *error* Txh num TxH dpn num nn pny fsv fs rfob srk Ptob L nks
p1 tks dLset mVset msf nskX nksY Mtrx pnts pts XLer YLer pvt0 pvt
StrS StnS nksY Nnum Onk Nnk)
(setvar "modemacro" "M.Sahin Guvercin") (setvar "cmdecho" 0) (vl-load-com)
(command "_.undo" "group")
(defun *error* (msg) (setvar "dimzin" edz) (setvar "modemacro" "")
(princ msg) (command "undo" "e") (setq *error* nil) (prin1))
(setq edz (getvar "dimzin"))
(if (= eTxH nil) (setq eTxH (* (getvar "dimtxt") (getvar "dimscale"))))
(if (= (setq TxH (getreal (strcat "\n Yazi yuksekligi <" (rtos eTxH) ">: ")))
nil) (setq TxH eTxH) (setq eTxH TxH)) (if (= dpp nil) (setq dpp 2))
(if (setq dpn (getint (strcat "\n Koordinatlar iзin ondalэk basamak sayэsэ <"
(itoa dpp) ">: "))) (setq dpp dpn))
(if (= enum nil) (setq enum "p1"))
(if (= (setq num (getstring (strcat "\n Baюlangic sayisi <" enum ">: "))) "")
(setq num enum))
(if (> (ascii (substr num 1 1)) 57)
(setq nn (substr num 1 1) num (1- (atoi (substr num 2 (- (strlen num) 1)))))
(setq nn "" num (1- (atoi num))))
(setq kuk (initget 7 "Evet Hayir")
pny (getkword "\n Noktanэn yanэna numara yazэlacak mэ? (E=Evet/H=Hayэr): ")
kuk (initget 7 "Alarga Ortala")
aLoR (getkword "\n Nokta numaralarэnэn yerleюimi A=Alarga/O=Ortala: ")
kuk (initget 7 "Evet Hayir")
fsv (getkword "\n Koordinat Tablosu dosyaya yazэlacak mэ?(E=Evet/H=Hayэr): "))
(if (= fsv "Evet")
(setq fs (open (getfiled "Koordinat Yazэlacak Dosya" "" "txt" 1) "w")))
(princ "\n Koordinatlarэ yazэlacak guruptan bir obje seзiniz...")
(while (not (setq rfob (ssget ":S" (list (cons 0 "POINT,CIRCLE")))))
(princ "\n *** Seзilen obje, ilgili Layer'da POINT veya CIRCLE olmalэ!"))

(setq kuk (initget 7 "Satir Kolon No")
srk (getkword
"\n Nokta numaralama sэra kriteri (Satir=S/Kolon=K/Sэrasэz=N): ")
rfob (entget (ssname rfob 0))
kuk (princ "\nKoordinatэ yazэlacak objeleri (tьm зizim iзin aLL) seзiniz: ")
PtOb (ssget (list (assoc 0 rfob) (assoc 8 rfob)))
L (sslength PtOb) n -1 pnts nil Mtrx nil elv (getvar "elevation")
nks '((0.00 0.00) (40.00 0.00) (20.00 -1.50) (0.00 -2.00) (6.25 -2.00)
(17.50 -2.00) (28.75 -2.00) (40.00 -2.00) (0.75 -3.50)
(8.25 -3.50) (19.50 -3.50) (30.75 -3.50) (0.00 -4.00)
(40.00 -4.00) (0.75 -5.50) (7.25 -5.50) (18.50 -5.50)
(29.75 -5.50) (0.00 -6.00) (6.25 -6.00) (17.50 -6.00)
(28.75 -6.00) (40.00 -6.00))
nks (mapcar '(lambda (xy) (trans (list (* (car xy) TxH)
(* (cadr xy) TxH) elv) 1 0 nil)) nks)
p1 '(0.0 0.0 0.0) tks (mapcar '(lambda (pr) (trans (list (+ (car p1)
(car pr)) (+ (cadr p1) (cadr pr)) (+ (caddr p1) (caddr pr))) 0 1 nil)) nks)
dLset (ssadd) mVset (ssadd) ac (/ pi 2.0) msf (* 2 TxH))
(entmake (list (cons 0 "LINE") (cons 10 (nth 0 tks)) (cons 11 (nth 1 tks))))
(ssadd (entlast) mVset)
(entmake (list (cons 0 "LINE") (cons 10 (nth 3 tks)) (cons 11 (nth 7 tks))))
(ssadd (entlast) mVset)
(entmake (list (cons 0 "LINE") (cons 10 (nth 12 tks)) (cons 11 (nth 13 tks))))
(ssadd (entlast) mVset)
(entmake (list (cons 0 "LINE") (cons 10 (nth 0 tks))
(cons 11 (polar (nth 18 tks) ac msf)))) (ssadd (entlast) dLset)
(ssadd (entlast) mVset)
(entmake (list (cons 0 "LINE") (cons 10 (nth 4 tks))
(cons 11 (polar (nth 19 tks) ac msf)))) (ssadd (entlast) dLset)
(ssadd (entlast) mVset)
(entmake (list (cons 0 "LINE") (cons 10 (nth 5 tks))
(cons 11 (polar (nth 20 tks) ac msf)))) (ssadd (entlast) dLset)
(ssadd (entlast) mVset)
(entmake (list (cons 0 "LINE") (cons 10 (nth 6 tks))
(cons 11 (polar (nth 21 tks) ac msf)))) (ssadd (entlast) dLset)
(ssadd (entlast) mVset)
(entmake (list (cons 0 "LINE") (cons 10 (nth 1 tks))
(cons 11 (polar (nth 22 tks) ac msf)))) (ssadd (entlast) dLset)
(ssadd (entlast) mVset)
(entmake (list (cons 0 "TEXT") (cons 10 (nth 2 tks)) (cons 40 Txh)
(cons 1 "Koordinat Tablosu") (cons 50 0.0) (cons 72 1)
(cons 11 (nth 2 tks)))) (ssadd (entlast) mVset)
(entmake (list (cons 0 "TEXT") (cons 10 (nth 8 tks)) (cons 40 TxH)
(cons 1 "Nokta") (cons 50 0.0))) (ssadd (entlast) mVset)
(entmake (list (cons 0 "TEXT") (cons 10 (nth 9 tks)) (cons 40 TxH)
(cons 1 "x") (cons 50 0.0))) (ssadd (entlast) mVset)
(entmake (list (cons 0 "TEXT") (cons 10 (nth 10 tks)) (cons 40 TxH)
(cons 1 "y") (cons 50 0.0))) (ssadd (entlast) mVset)
(entmake (list (cons 0 "TEXT") (cons 10 (nth 11 tks)) (cons 40 TxH)
(cons 1 "z") (cons 50 0.0))) (ssadd (entlast) mVset)
(if (= fsv "Evet") (write-line "Nokta\tx\ty\tz" fs))
(setq nks (list (nth 12 tks) (nth 13 tks) (polar (nth 8 tks) 0 TxH)
(polar (nth 9 tks) pi TxH) (polar (nth 10 tks) pi TxH)
(polar (nth 11 tks) pi TxH))
nksX (mapcar '(lambda (X) (car X)) nks)
nksY (mapcar '(lambda (Y) (cadr Y)) nks))
(while (< (setq n (1+ n)) L)
(setq pnts (append pnts (list (cdr (assoc 10 (entget (ssname PtOb n))))))))
(if (= srk "No") (setq Mtrx (reverse pnts)) (progn
(setq pts (mapcar '(lambda (xy) (list (car xy) (cadr xy))) pnts)
XLer (mapcar '(lambda (xx) (car xx)) pts)
YLer (mapcar '(lambda (yy) (cadr yy)) pts)
L (length Xler) n -1)
(while (< (setq n (1+ n)) L) (setq pvt0 (nth n XLer)
pvt (vl-remove pvt0 XLer) XLer (append (list pvt0) pvt)
L (length XLer))) (setq L (length YLer) n -1)
(while (< (setq n (1+ n)) L) (setq pvt0 (nth n YLer)
pvt (vl-remove pvt0 YLer) YLer (append (list pvt0) pvt)
L (length YLer)))
(setq XLer (vl-sort XLer '<) YLer (vl-sort YLer '>) StnS (length XLer)
StrS (length YLer) m -1)
(cond ((= srk "Satir") (while (< (setq m (1+ m)) StrS) (setq n -1)
(while (< (setq n (1+ n)) StnS) (setq Mtrx (append Mtrx
(list (list (nth n XLer) (nth m YLer))))))))
((= srk "Kolon") (while (< (setq m (1+ m)) StnS) (setq n -1)
(while (< (setq n (1+ n)) StrS) (setq Mtrx (append Mtrx
(list (list (nth m XLer) (nth n YLer)))))))))
(setq L (length Mtrx) n -1)
(while (< (setq n (1+ n)) L) (if (= (vl-position (nth n Mtrx) pts) nil)
(setq Mtrx (vl-remove (nth n Mtrx) Mtrx) L (length Mtrx) n (1- n))))))
(setq K (length Mtrx) L (length pnts) m -1) (setvar "dimzin" 0)
(while (< (setq m (1+ m)) K) (setq n -1)
(while (< (setq n (1+ n)) L)
(if (and (= (car (nth m Mtrx)) (cadr (assoc 10 (entget (ssname PtOb n)))))
(= (cadr (nth m Mtrx)) (caddr (assoc 10 (entget (ssname PtOb n))))))
(progn
(setq nksY (mapcar '(lambda (Y) (- Y msf)) nksY)
nks (mapcar '(lambda (X Y) (list X Y)) nksX nksY)
nnum (strcat nn (itoa (setq num (1+ num))))
X (car (nth m Mtrx)) Y (cadr (nth m Mtrx))
Z (cadddr (assoc 10 (entget (ssname PtOb n))))
gnok (trans (list x y z) 0 1 nil)
X (car gnok) Y (cadr gnok) Z (caddr gnok) p -1)
(entmake (list (cons 0 "LINE") (cons 10 (nth 0 nks))
(cons 11 (nth 1 nks)))) (ssadd (entlast) mVset)
(entmake (list (cons 0 "TEXT") (cons 10 (nth 2 nks)) (cons 40 TxH)
(cons 1 nnum) (cons 50 0.0))) (ssadd (entlast) mVset)
(if (= pny "Evet")
(if (= aLoR "Alarga")
(entmake (list (cons 0 "TEXT") (cons 40 TxH) (cons 1 nnum)
(cons 10 (trans (list (+ X TxH) (+ Y Txh) Z) 1 0 nil))
(cons 50 0.0)))
(entmake (list (cons 0 "TEXT") (cons 40 TxH) (cons 1 nnum)
(cons 10 (setq kuk (trans (list X Y Z) 1 0 nil)))
(cons 50 0.0) (cons 72 4) (cons 11 kuk)))))
(entmake (list (cons 0 "TEXT") (cons 10 (nth 3 nks)) (cons 40 TxH)
(cons 1 (rtos X 2 dpp)) (cons 50 0.0)))
(ssadd (entlast) mVset)
(entmake (list (cons 0 "TEXT") (cons 10 (nth 4 nks)) (cons 40 TxH)
(cons 1 (rtos Y 2 dpp)) (cons 50 0.0)))
(ssadd (entlast) mVset)
(entmake (list (cons 0 "TEXT") (cons 10 (nth 5 nks)) (cons 40 TxH)
(cons 1 (rtos Z 2 dpp)) (cons 50 0.0)))
(if (= fsv "Evet")
(write-line (strcat nnum "\t" (rtos X 2 dpp) "\t" (rtos Y 2 dpp)
"\t" (rtos Z 2 dpp)) fs))
(ssadd (entlast) mVset)
(while (< (setq p (1+ p)) 5)
(setq pvt (entget (ssname dLset p))
pvt (subst (cons 11 (list (cadr (assoc 11 pvt))
(- (caddr (assoc 11 pvt)) msf) (cadddr (assoc 11 pvt))))
(assoc 11 pvt) pvt))
(entmod pvt) (entupd (cdr (assoc -1 pvt))))))))
(setq onK (list 0.0 0.0 0.0) L (sslength mVset))
(while (/= 3 (car (setq nnK (grread T 4 0))))
(setq nnK (trans (cadr nnK) 1 0 nil) n -1)
(while (< (setq n (1+ n)) L)
(vla-transformby (vlax-ename->vla-object (ssname mVset n)) (vlax-tmatrix
(list (list 1 0 0 (- (car nnK) (car onK)))
(list 0 1 0 (- (cadr nnK) (cadr onK)))
(list 0 0 1 (- (caddr nnK) (caddr onK))) (list 0 0 0 1)))))
(setq onK nnK))

(setq nnum (strcat nn (itoa (setq num (1+ num)))) enum nnum *error* nil)
(close fs) (setvar "dimzin" edz) (command "_.undo" "e") (prin1)
)

%<\AcObjProp Object(%<\_ObjId 8796082700096>%).Coordinates \f "%lu2%pt1%pr2">%
%<\AcObjProp Object(%<\_ObjId 8796082700096>%).Coordinates \f "%lu2%pt2%pr2">%
%<\AcObjProp Object(%<\_ObjId 8796082700096>%).Coordinates \f "%lu2%pt4%pr2">%
%<\AcObjProp Object(%<\_ObjId 8796082602288>%).TextString>%

(vla-addMText
(vla-get-modelspace (vla-get-ActiveDocument (vlax-get-acad-object)))
(vlax-3d-point (getpoint)) 4.
(strcat "%<\\AcObjProp Object(%<\\_ObjId "
(itoa (vla-get-ObjectID (vlax-ename->vla-object (car (entsel)))))
">%).Coordinates \\f "%lu2%pt1%pr2">%"))

admin (17.12.2017 11:44 GMT)

23.03.2016 15:37

83217    

ikincisine aktif katman ile atmasnın sebebi, donut komutunun bitirilmemiş olmasından kaynaklanıyor.
bitirme işleminde ise komut tekrarı için bir bölüm yazmamışsınız.
Ek'te düzenleyerek gönderdim.

24.03.2016 07:31

83219    

Ehya usta Teşekkürler.

Alıntı

---

ehya :
ikincisine aktif katman ile atmasnın sebebi, donut komutunun bitirilmemiş olmasından kaynaklanıyor.
bitirme işleminde ise komut tekrarı için bir bölüm yazmamışsınız.
Ek'te düzenleyerek gönderdim.

...............
...............

---

ehya (24.03.2016 08:40 GMT)

25.03.2016 09:19

83223    

kingfish50

---

ada parsel yazınca otomatik projesini çizen lisp bile var...
sen hiç lisple falan uğraşma.. revit, allplan yada archicad öğren.. o dediklerini otomatik yapar..

26.05.2016 13:31

83486    

Merhaba,UZ lipsi ile bir layeri ölçtükten sonra ölçülen layerin otomatik olarak saklamasını nasıl sağlarız ?

22.09.2016 14:42

83912    

Kolay gelsin,

vlax-get-property kullanarak alınan açı değeri ile koşullu seçim yapmak istiyorum. seçilen line nesneleri içinde sadece yatay olanları silmek istiyorum.

Yardımcı olursanız sevinirim.

23.09.2016 07:52

83915    

26.09.2016 06:27

83926    

Çok teşekkürler..

15.10.2016 16:01

83991    

Alıntı

---

seboli61 :
Merhaba..

Seçtiğim son objenin özelliğini nasıl değiştirebilirim. Mesela son seçtiğim objenin "Blayer" ı değiştirmek istiyorum.
Bunu bir şekilde yaptım ama Clayer değişiyor. Umarım derdimi anlatabildim.

---

Secilen nesnenin rengini bylayer yapar, yaparken de "clayer" i falan degistirmez :)

20.01.2017 08:29

84560    

onuraydin16

---

---

Lisp lerin Autolisp versiyonlarını bulmalı (içinde vla-, vlax-, vlr- ve bazı vl- ile başlamayan kodlar) yada birine yazdırmalısınız.
Sitede büyük ihtimal istediğiniz lisp ler vardır.
Yada BootCamp kullanarak bilgisayara windows işletim sistemini kurup iki işletim sistemi çalıştırabilirsiniz.