ProhibiT (17.08.2011 06:55 GMT)

Alıntı

---

admin :
Nası bir yerde kullandığınızı detaylı anlatabilirseniz (mümkünse resimli) belki başka önerilerde bulunabiliriz.

---

ProhibiT (17.08.2011 08:00 GMT)

Alıntı

---

ProhibiT :
Öncelikle "Lips" yazmayın, başlıkta ve mesajlarınızda yazdığınız "Lips" leri "Lisp" olarak düzeltmek zorunda kaldım.

sorumluluk sahibi bir yazar, sizin bahsettiğiniz gibi sorgusuz sualsiz obje silen fonksiyon yazmak istemez. yazar, kullanıcıya rağmen kullanıcı için yazan insandır. basit hatalarla kayıplar yaşamasına sebep olabilecek şeyler yazmak istemez.

verdiğim ilk fonksiyon (totl), seçtiğiniz ve uzunluklarını hesapladığınız objeleri ekrandan yok eder, ama silmez. yalnızca autocad ortamında sizin göremeyeceğiniz ve ulaşamayacağınız bir şekle dönüştürür. işinizi bitirdikten sonra, gizlenen objelerinizi tekrar görünür ve ulaşılır hale getirmek için verdiğim ikinci fonksiyonu (vsble) kullanabilirsiniz.

kolay gelsin.

Kod:

;;;================================================;;;
;;;   Prepared by: M. Şahin Güvercin (ProhibiT)    ;;;
;;;       17/08/2011  www.autocadokulu.com         ;;;
;;;================================================;;;
(defun c:TotL (/ sSeT L n ToT PvT oTyp ctx a)
  (setvar "cmdecho" 0) (command "_.undo" "group")
  (setvar "modemacro" "M.Sahin Guvercin") (vl-load-com)
  (if (not
    (setq sSeT (ssget (list (cons 0 "LINE,*POLYLINE,ARC,ELLIPSE,SPLINE,CIRCLE")
                            (cons -4 "!=") (cons 60 1))))) (exit))
  (setq L (sslength sSeT) n -1 ToT 0)
  (while (< (setq n (1+ n)) L)
    (setq PvT (ssname sSeT n) oTyp (cdr (assoc 0 (entget PvT))))
    (cond ((= oTyp "ARC")
           (setq ToT (+ ToT (vla-get-arclength (vlax-ename->vla-object PvT)))))
          ((or (= oTyp "LINE") (= oTyp "LWPOLYLINE") (= oTyp "POLYLINE"))
           (setq ToT (+ ToT (vla-get-length (vlax-ename->vla-object PvT)))))
          ((= oTyp "CIRCLE") (setq ToT (+ ToT
                        (vla-get-circumference (vlax-ename->vla-object PvT)))))
          ((or (= oTyp "ELLIPSE") (= oTyp "SPLINE"))
           (command "._area" "e" PvT) (setq ToT (+ ToT (getvar "perimeter")))))
    (setq PvT (entget PvT))
    (if (assoc 60 PvT) (entmod (subst (cons 60 1) (assoc 60 PvT) PvT))
                       (entmod (append PvT (list (cons 60 1)))))
    (entupd (cdr (assoc -1 PvT))))
  (entmake (list (cons 0 "TEXT") (cons 10 (list 0.0 0.0 0.0))
                 (cons 11 (list 0.0 0.0 0.0)) (cons 40 (getvar "textsize"))
                 (cons 1 (rtos ToT)) (cons 50 0.0) (cons 72 0)))
  (setq dro (entlast) sp0 (list 0.0 0.0 0.0) a nil)
  (while (and (/= 3 (car (setq sp (grread T 4 2)))) (/= (car sp) 25))
    (if a (redraw (ssname a 0) 4)) (TrnsLt dro sp sp0) (entdel dro)
    (setq sp0 (cadr sp)) (if (setq a (ssget sp0 (list (cons 0 "*text"))))
                           (redraw (ssname a 0) 3)) (entdel dro))
  (if (= (car sp) 3)
    (progn (TrnsLt dro sp sp0) (entdel dro)
      (if (setq tp (ssget sp0 (list (cons 0 "*text"))))
        (progn (setq ctx (entget (ssname tp 0))
                     ctx (subst (cons 1 (rtos ToT)) (assoc 1 ctx) ctx))
          (entmod ctx) (entupd (cdr (assoc -1 ctx)))))) (entdel dro))
  (if ToT (princ (strcat "\nToplam Uzunluk: " (rtos ToT))))
  (setvar "modemacro" "") (command "_.undo" "e") (princ)
)
(defun TrnsLt (pr1 pr2 pr3 /)
  (vla-transformby (vlax-ename->vla-object pr1) (vlax-tmatrix
      (list (list 1 0 0 (- (car (cadr pr2)) (car pr3)))
            (list 0 1 0 (- (cadr (cadr pr2)) (cadr pr3)))
            (list 0 0 1 (- (caddr (cadr pr2)) (caddr pr3)))
            (list 0 0 0 1))))
)

;;;================================================;;;
;;;   Prepared by: M. Şahin Güvercin (ProhibiT)    ;;;
;;;       17/08/2011  www.autocadokulu.com         ;;;
;;;================================================;;;
(defun c:VsbLe (/ sSeT L PvT)
  (setvar "cmdecho" 0) (command "_.undo" "group")
  (setvar "modemacro" "M.Sahin Guvercin")
  (if (not (setq sSeT (ssget "x"
                      (list (cons 0 "LINE,*POLYLINE,ARC,ELLIPSE,SPLINE,CIRCLE")
                            (cons 60 1))))) (exit))
  (repeat (setq L (sslength sSeT)) (setq L (1- L) PvT (entget (ssname sSet L)))
    (entmod (subst (cons 60 0) (assoc 60 PvT) PvT))
    (entupd (cdr (assoc -1 PvT))))
  (setvar "modemacro" "") (command "_.undo" "e") (princ)
)

---

ProhibiT (20.08.2011 09:15 GMT)

Alıntı

---

ProhibiT :
Kod içinde bazı harfler küçük harf olarak çevrilmiş,
"LINE,*POLYLINE,ARC,ELLIPSE,SPLINE,CIRCLE" olması gerekn bölüm,
"lıne,*polylıne,arc,ellıpse,splıne,cırcle" şeklinde yanlış aktarılmış.
hata bundan kaynaklanıyor. fonksiyonun doğru kodunu yeniden yükledim.
tekrar alıp denerseniz çalışacaktır.

---

Beğenmek için anlamak lazım...

Beğenmek için anlamak lazım...

Beğenmek için anlamak lazım...