Tek Mesaj Görüntüle
Eski 16-03-2007, 08:59   #86
orhunkeskinbicak
Arkitera Üyesi
 
orhunkeskinbicak'in Avatar'ı
 
Kayıt Tarihi: 27-12-2005
Mesaj: 501
;;;kesişen birçok line arc circle ve polylineyi sectiğinde kesişim noktalarından kıran bir lisp
;;;vardı ama nerde internetde biryerlerde olacak
;;;bu sadece line ler için ama hepsi için olanıdavardı internet bu araştır!!!!!!!!!!

;|===============================================================|;
;| MBRK.lsp by Michael Bulatovich, 18th Mar., 2004 |;
;| |;
;| Breaks a number of lines at their intersections |;
;| with a number of other lines. Behavior is as if |;
;| EDGEMODE is set to 0. ("MultiBreak") |;
;| |;
;|===============================================================|;




(Defun C:MBRK (/ ss bs cnt bcnt inf beinf pnt1
pnt2 enam bename einf pnt3 pnt4 intr oldemode
)

(setvar "cmdecho" 0)
(setq olderror *error*
oldemode (getvar "edgemode")
)

(defun *mbrk_error* (msg)
(if (or (= msg "Function cancelled")
(= msg "quit / exit abort")
)
(princ "\nFunction cancelled by user.")
(progn
(princ "\nError: ")
(princ msg)
)
)
(setvar "edgemode" oldemode)
(if olderror
(setq *error* olderror
olderror nil
)
)
(princ)
)

(if (not (eq *error* *mbrk_error*))
(setq *error* *mbrk_error*)
)

(setvar "edgemode" 0)
(Setq cnt 0)
(Princ "\nkırılacak çizgileri seçin: ")
(Setq ss (SSGet))

(Princ "\nkıracak çizgileri seçin: ")

(Setq bss (SSGet)
bcnt 0
)

(if bss
(Repeat (SSLength bss)
(Setq cnt 0
benam (SSName bss bcnt)
bcnt (1+ bcnt)
beinf (Entget benam)
pnt1 (Cdr (Assoc 10 beinf))
pnt2 (Cdr (Assoc 11 beinf))
)

(If ss
(Repeat (SSLength ss)

(Setq enam (SSName ss cnt)
cnt (1+ cnt)
einf (Entget enam)
pnt3 (Cdr (Assoc 10 einf))
pnt4 (Cdr (Assoc 11 einf))
intr (inters pnt1 pnt2 pnt3 pnt4)
)
(Command "_.BREAK" enam intr intr)

)
)
)
)

(setvar "edgemode" oldemode)
(setq *error* olderror
olderror nil
)
(Princ)
)
__________________
Ars Longa, Vita Brevis

En son orhunkeskinbicak tarafından düzenlendi : 16-03-2007 09:27.
orhunkeskinbicak offline   Alıntı Yaparak Yanıtla