IndexCalendarGalleryTrợ giúpThành viênĐăng kýĐăng Nhập
Đăng Nhập
Tên truy cập:
Mật khẩu:
Đăng nhập tự động mỗi khi truy cập: 
:: Quên mật khẩu
Top posters
Admin
 
tvgs
 
HotroAcad
 
ksphanle
 
engineer0405
 
quangthinh01
 
sumakho
 
quoctoa
 
M@trixs
 
tvgtyb08
 
Latest topics
Thống Kê
Hiện có 1 người đang truy cập Diễn Đàn, gồm: 0 Thành viên, 0 Thành viên ẩn danh và 1 Khách viếng thăm

Không

Số người truy cập cùng lúc nhiều nhất là 9 người, vào ngày Sun Aug 28, 2016 7:30 am
December 2016
MonTueWedThuFriSatSun
   1234
567891011
12131415161718
19202122232425
262728293031 
CalendarCalendar
Tìm kiếm
 
 

Display results as :
 
Rechercher Advanced Search

Share | 
 

 Lisp copy cao độ - đánh cos

Xem chủ đề cũ hơn Xem chủ đề mới hơn Go down 
Tác giảThông điệp
Admin
Thượng úy
Thượng úy


Tổng số bài gửi : 103
Điểm : 291
Reputation : 34
Join date : 15/01/2011

Bài gửiTiê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
Về Đầu Trang Go down
http://xaydungit.forumvi.com
 
Lisp copy cao độ - đánh cos
Xem chủ đề cũ hơn Xem chủ đề mới hơn Về Đầu Trang 
Trang 1 trong tổng số 1 trang

Permissions in this forum:Bạn không có quyền trả lời bài viết
 :: Phần mềm xây dựng - Giao thông - Hạ tầng kỹ thuật :: Chuyên về lisp [Sưu tầm]-
Chuyển đến