;;;  3D_POLYLINE Araçları
;;;_______________________

;;; 3D_POLYLINE koordinatlarını dosyaya yazar...
(defun c:3dpyaz()
(setq da (getfiled "Text Dosyasi" (getvar "DWGPREFIX") "txt" 1) ad (open da "w"))
(princ "\nDosyaya yazılacak Polyline 'ı Seçin:")
(if (setq pl1 nil pl1list nil sset1 (ssget ":S" '((0 . "POLYLINE")))) (setq pl1 (ssname sset1 0)))
(setq ename pl1 etype nil)
(while (/= etype "SEQEND")
  (setq ename (entnext ename) etype (cdr(assoc 0 (setq elist (entget ename)))))
  (if (/= etype "SEQEND") (setq xyz (strcat (rtos (nth 1 (assoc 10 elist))) "\t" (rtos (nth 2 (assoc 10 elist))) "\t" (rtos (nth 3 (assoc 10 elist))) "\n")))
  (princ xyz ad)
)
(close ad)
)
;----------------------------------------------------------------------------------------------------
;;; seçilen LINE objelerini 3D_POLYLINE'a çevirir...
(defun c:3dpy()
(princ "\nBirleştirilecek 3D line elemanları Seçin:")
(setq lset1 (ssget '((0 . "LINE"))) lset2 (ssadd) devam 1)
(setq Baseleman (car(entsel "\nBaşlangıç doğrusunu seçin:\n" )) basent baseleman lset1 (ssdel Baseleman lset1) lset2 (ssadd basent lset2))
(setq komsu (komsubul Basent lset1))
(if komsu
(progn
   (if (= uc "tt") (setq topliste (list (ass 11 basent) (ass 10 basent))))
   (if (= uc "td") (setq topliste (list (ass 11 basent) (ass 10 basent))))
   (if (= uc "dd") (setq topliste (list (ass 10 basent) (ass 11 basent))))
   (if (= uc "dt") (setq topliste (list (ass 10 basent) (ass 11 basent))))
);progn
(exit)
)
(while devam
  (setq kent (komsubul Basent lset1))
  (if kent
      (setq lset1    (ssdel kent lset1)
            lset2    (ssadd kent lset2)
            topliste (append topliste (list (if (= (substr uc 2 1) "d") (ass 11 kent) (ass 10 kent))))
            Basent   kent
      )
      (setq devam nil)
  );if
);while
(d3dpoly topliste)
(redraw (entlast) 3)
(command "erase" lset2 "")
);defun c:3dpy
;----------------------------------------------------------------------
;;; iki noktanın eşit olup olmadığını kontrol eder...
(defun esitp(p1 p2)(if (< (distance p1 p2) 0.02) p2 nil))
;;; listeleri satır satır ekrana yazar...
(defun lol(liste)(setq count 0)(repeat (length liste)(princ"\n")(princ (nth count liste))(setq count (1+ count)))(princ))
;----------------------------------------------------------------------
;;; bir line objesine komşu (bir koordinatları aynı) başka bir line ara
(defun komsubul(entname selset)
(setq count 0 newname nil uc nil dongusayisi (sslength selset))
(repeat dongusayisi
(setq ename (ssname selset count) count (1+ count))
(if (esitp (cdr(assoc 10 (entget entname))) (cdr(assoc 10 (entget ename))))
    (setq newname ename uc "td" dongusayisi (1+ count))
);if
(if (esitp (cdr(assoc 10 (entget entname))) (cdr(assoc 11 (entget ename))))
    (setq newname ename uc "tt" dongusayisi (1+ count))
);if
(if (esitp (cdr(assoc 11 (entget entname))) (cdr(assoc 10 (entget ename))))
    (setq newname ename uc "dd" dongusayisi (1+ count))
);if
(if (esitp (cdr(assoc 11 (entget entname))) (cdr(assoc 11 (entget ename))))
    (setq newname ename uc "dt" dongusayisi (1+ count))
);if
);repeat
(setq sonuc newname)
);defun
;----------------------------------------------------------------------
;;; obje özellikleri listesinden istenen özelliği çeker...
(defun ass(nl ename)(cdr(assoc nl (entget ename))))
;----------------------------------------------------------------------
;;; verilen liste içindeki koordinatları kullanarak 3D_POLYLINE çizer..
(defun d3dpoly(liste)
(entmake '((0 . "POLYLINE") (70 . 8)))
(setq count 0)
(repeat (length liste)
(setq elist (list '(0 . "VERTEX") (cons 10 (nth count liste)) '(70 . 32)) count (1+ count))
(entmake elist)
)
(entmake '((0 . "SEQEND")))
)
;----------------------------------------------------------------------
;;; 3D_POLYLINE 'ı ters çevirir (ilk nokta son nokta olur, tam ters)...
(defun c:3dpt()
(princ "\nTers çevrilecek Polyline 'ı Seçin:")
(if (setq pl1 nil pl1list nil sset1 (ssget ":S" '((0 . "POLYLINE")))) (setq pl1 (ssname sset1 0)))
(setq ename pl1 etype nil)
(while (/= etype "SEQEND")
  (setq ename (entnext ename) etype (cdr(assoc 0 (setq elist (entget ename)))))
  (if (/= etype "SEQEND") (setq xyz (list(cdr(assoc 10 elist))) pl1list (append pl1list xyz)))
)
(setq pl1list (reverse pl1list))
(entdel pl1)
(d3dpoly pl1list)
)
;----------------------------------------------------------------------
;;; iki 3D_POLYLINE 'ı birleştirir, aynı yönde olmalarına dikkat, değilse 3DPT kullanın...
(defun c:3dpj()
(princ "\nBirinci Polyline 'ı Seçin:")
(if (setq pl1 nil pl1list nil sset1 (ssget ":S" '((0 . "POLYLINE")))) (setq pl1 (ssname sset1 0)))
(princ "\nİkinci  Polyline 'ı Seçin:")
(if (setq pl2 nil pl2list nil sset1 (ssget ":S" '((0 . "POLYLINE")))) (setq pl2 (ssname sset1 0)))
(if (and pl1 pl2) nil (exit))
(setq ename pl1 etype nil)
(while (/= etype "SEQEND")
  (setq ename (entnext ename) etype (cdr(assoc 0 (setq elist (entget ename)))))
  (if (/= etype "SEQEND") (setq xyz (list(cdr(assoc 10 elist))) pl1list (append pl1list xyz)))
)
(setq ename pl2 etype nil)
(while (/= etype "SEQEND")
  (setq ename (entnext ename) etype (cdr(assoc 0 (setq elist (entget ename)))))
  (if (/= etype "SEQEND") (setq xyz (list(cdr(assoc 10 elist))) pl2list (append pl2list xyz)))
)
;(if (or (esitp (car pl1list) (car pl2list)) (esitp (car pl1list) (last pl2list)) (esitp (last pl1list) (car pl2list)) (esitp (last pl1list) (last pl2list)))(progn (princ"\n   Polyline'lar birleşmiyor...") (exit)))
(if (or (esitp (car pl1list) (car pl2list)) (esitp (car pl1list) (last pl2list))) (setq pl1list (reverse pl1list)))
(if (esitp (last pl1list) (last pl2list)) (setq pl2list (reverse pl2list)))
(setq count 0)
(repeat (length pl2list)
(setq pl1list (append pl1list (list (nth count pl2list))) count (1+ count))
)
(entdel pl1)
(entdel pl2)
(d3dpoly pl1list)
);c:3dpj
;----------------------------------------------------------------------
;;; 3D_POLYLINE 'ın ofsetini alır...
(defun c:3dpo()
  (setq pllist (pointlisty "...Ofset Alınacak 3DPOLYLINE seçiniz :") count -1 plnlist nil)
  (setq omesafe (getdist "\nNe Kadar:") oyon (getpoint "\nNereye:"))
  (d2dpoly pllist)
  (setq ename1 (entlast))
  (command "offset" omesafe ename1 oyon "")
  (setq ename2 (entlast))
  (setq plist (lwplist ename2) count -1)
  (entdel ename1)
  (entdel ename2)
  (repeat (length pllist)
     (setq count (1+ count) xyz (nth count pllist) xy (nth count plist))
     (setq plnlist (append plnlist (list (list (car xy) (cadr xy) (nth 2 xyz)))))
  )
  (d3dpoly plnlist)
);defun c:3dpo
;----------------------------------------------------------------------
;;; verilen liste içindeki koordinatları kullanarak LW_POLYLINE çizer..
(defun d2dpoly(listesi)
(setq elist (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 (length listesi))
'(70 . 0)
'(43 . 0.0)
'(38 . 0.0)
'(39 . 0.0)
     )
       count -1
)
(repeat (length listesi)
   (setq count (1+ count) xy0 (nth count listesi))
   (setq elist (append elist (list (list 10 (car xy0) (cadr xy0)))))
)
(setq ename (entmake elist))
);defun
;----------------------------------------------------------------------
; 3dpoly koordinat listesi hazırlar
(defun pointlisty(mesaj)
(princ "\n")(princ mesaj)
(if (setq pl1 nil pl1list nil sset1 (ssget ":S" '((0 . "POLYLINE")))) (setq pl1 (ssname sset1 0)))
(setq ename pl1 etype nil)
(while (/= etype "SEQEND")
  (setq ename (entnext ename) etype (cdr(assoc 0 (setq elist (entget ename)))))
  (if (/= etype "SEQEND") (setq xyz (list(cdr(assoc 10 elist))) pl1list (append pl1list xyz)))
)
(setq pllist pl1list)
);defun
;----------------------------------------------------------------------
; lwpoly koordinat listesi hazırlar
(defun-q lwplist(enm / plist psay elist enm p )
(setq psay -1 plist '())
(if (= (cdr(assoc 0 (setq elist (entget enm)))) "LWPOLYLINE")
(repeat (length elist)
  (setq psay (1+ psay))
  (if (= 10 (car(nth psay elist)))
   (setq p  (cdr(nth psay elist))
         plist (append plist (list p))
   );setq
  );if
);repeat
);if
(setq plist plist)
)
;----------------------------------------------------------------------
(princ"\n\t\t3DPY komutu seçilen line elemanlarından bir 3Dpoly yaratır...")
(princ"\nDiğerleri 3DPJ, 3DPT ve 3DPYAZ")
(princ)
; KOMUTLAR
;__________
; 3DPYAZ 3D_POLYLINE koordinatlarını dosyaya yazar...
; 3DPY seçilen LINE objelerini 3D_POLYLINE'a çevirir...
; 3DPT 3D_POLYLINE 'ı ters çevirir (ilk nokta son nokta olur, tam ters)...
; 3DPJ iki 3D_POLYLINE 'ı birleştirir, aynı yönde olmalarına dikkat, değilse 3DPT kullanın...
; 3DPO 3D_POLYLINE 'ın ofsetini alır...
; ass obje özellikleri listesinden istenen özelliği çeker...
; d3dpoly verilen liste içindeki koordinatları kullanarak 3D_POLYLINE çizer..
; d2dpoly verilen liste içindeki koordinatları kullanarak LW_POLYLINE çizer..
; komsubul bir line objesine komşu (bir koordinatları aynı) başka bir line ara
; esitp iki noktanın eşit olup olmadığını kontrol eder...