Admin Thượng úy
Tổng số bài gửi : 103 Điểm : 291 Reputation : 34 Join date : 15/01/2011
| Tiêu đề: Lisp copy cao độ - đánh cos Sun Oct 16, 2011 3:55 pm | |
| - Code:
-
[font=Courier New](defun c:dc (/ lstSS txtstr p1 p2 listname txt txt1 ss)
(vl-load-com)
(defun dowith(lstSS / lstSS en str)
(cond ((setq en (car (vl-remove-if-not '(lambda(x)(wcmatch (cdadr (entget x))"*TEXT")) lstSS)))(setq str (acet-dxf 1 (entget en)) en (vlax-ename->vla-object en)))
((setq en (car (vl-remove-if-not '(lambda(x)(and (wcmatch (cdadr (entget x))"INSERT")(= (acet-dxf 66 (entget x)) 1))) lstSS)))
(setq str (vla-get-textstring (setq en(car (vlax-invoke (vlax-ename->vla-object en) 'GetAttributes)))))
)
)
(cons en str)
)
(grtext -1 "Free lisp from Cadviet @Ketxu")
(setq lstSS (acet-ss-to-list (setq ss (ssget)))
obj (car (setq en (dowith lstSS)))
str (cdr en)
p1 (getpoint "\nBasepoint :")
eL (entlast)
oDz (getvar "Dimzin")
)
(setvar "DIMZIN" 0)
(while (setq p2 (getpoint p1 "\nTo point :"))
(command "copy" ss "" p1 p2)
(while (setq EL (entnext EL)) (setq Listname (cons EL Listname)))
(setq Txt1 (car (dowith listName))
eL (entlast)
)
(vla-put-textstring txt1
(strcat (cond ((> (setq num (+ (atof str) (/ (- (cadr p2)(cadr p1)) 1000))) 0) "+")
((= num 0) "%%p")
(T "")
)
(rtos num 2 3))
)
)
(setvar "DIMZIN" oDZ)
)[/font]
Tác giả : Ketxu | |
|