fatihuzmezz
09 Şubat 2016
09 Şubat 2016
topla.lps komutu sorunu
arkadaşlar topla komutunu kullanıyorum ama bazi çizgilerde toplama yapmıyor sanırım çizgi korumada vb. bir durum var bunu nasıl düzeltirim bilgisi olan varmı ?Son Cevap: semiyildiz
fatihuzmezz
09 Şubat 2016
09 Şubat 2016
;;; seçilen çizgilerin uzunluklarını toplar ve siler ;;;
;;; 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)
)
Cevap Yaz
Cevap yazabilmeniz için Giriş yapmanız gerekiyor.Benzer Konular
27 Kasım 2007
18 Nisan 2007
Sup marlo
29 Haziran 2006
04 Nisan 2009
16 Mayıs 2006
03 Kasım 2020
28 Mart 2023
18 Ekim 2022
30 Haziran 2011
