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 tăng dần

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 tăng dần   Mon Oct 17, 2011 9:28 pm

Lệnh sau đây cho phép bạn copy nhiều text, mỗi text nếu có chứa số ở cuối chuỗi sẽ được tăng lên 1 đơn vị khi copy.
Download file dưới đây và dùng lệnh ap để load lên trước khi sử dụng.
Lệnh: c+
Code:

[color=#006000]; copy text +
; www.vietlisp.com
;-------------------------------------------------------------------------------
(defun c:c+ (/ copy+ ss sslst i k p1 p2 )

(defun copy+ (ename p1 p2 add / ent i number str)[/color]

[color=#006000](command "copy" ename "" p1 p2)[/color]
[color=#006000](setq ent (entget (entlast)))[/color]
[color=#006000](if (setq str (cdr (assoc 1 ent)))[/color]
[color=#006000](progn[/color]
[color=#006000](setq i 1)[/color]
[color=#006000](while (<= i (strlen str))[/color]
[color=#006000](if (not (wcmatch (substr str i) "*@*"))[/color]
[color=#006000](progn[/color]
[color=#006000](setq number (substr str i))[/color]
[color=#006000](setq i 10000)[/color]
[color=#006000])[/color]
[color=#006000](setq i (1+ i))[/color]
[color=#006000])[/color]
[color=#006000])[/color]
[color=#006000](if number (setq str (strcat (substr str 1 (- (strlen str) (strlen number)))
(if (vl-string-search " " number) " " "")
(itoa (+ (atoi number) add)))))[/color]

[color=#006000](setq ent (subst (cons 1 str) (assoc 1 ent) ent))
(entmod ent)
)
)
)[/color]

[color=#006000](setq ss (ssget))
(if ss
(progn
(setq sslist (append))
(setq i 0)[/color]

[color=#006000](while (setq ename (ssname ss i))[/color]
[color=#006000](setq sslst (append sslst (list ename)))[/color]
[color=#006000](setq i (1+ i))[/color]
[color=#006000])[/color]

[color=#006000](setq k 1)[/color]
[color=#006000](setq p1 (getpoint"\nSpecify base point or [Displacement/mOde] <Displacement>:"))
(while
(setq p2 (getpoint p1 "\nSpecify second point or <use first point as displacement>:"))
(mapcar '(lambda (x) (copy+ x p1 p2 k)) sslst)
(setq k (1+ k))
)
))
(princ)
)[/color]
Về Đầu Trang Go down
http://xaydungit.forumvi.com
 
[Lisp]Copy tăng dần
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