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 | 
 

 [Sưu tầm]Lisp căn lề chữ

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 đề: [Sưu tầm]Lisp căn lề chữ    Sun Oct 16, 2011 3:49 pm



Code:
[font=Courier New]********************CAN DONG TEXT*************************
;Sap xep cac dong text deu nhau theo 1 kieu canh le, lay text goc lam chuan.
(defun c:CLT ( / oldos lst1 ss ki ki0 ki1 ki2 lst ddau dcuoi eget)
(setq oldos (getvar "osmode")) (setvar "osmode" 0)
(prompt "Chon nhom Text: ")
(setq ss (ssget '((0 . "TEXT"))))
(if (not tyledong) (setq tyledong 1.5))
(setq tyledong1 (getreal (strcat "\nVao ty le dong khoang cach dong <" (rtos tyledong 2 2) ">: ")))
(if tyledong1 (setq tyledong tyledong1))
(setq lst1 '(("L" 0 0) ("C" 1 0) ("R" 2 0)))
(initget 1 "C L R")
(setq ki (getkword "Enter an option [Center/Left/Right]: "))
(setq tch (car (entsel "Chon Text chuan: ")))
(if (= 0 (cdr (assoc 72 (entget tch))))
(setq vt (cdr (assoc 10 (entget tch))))
(setq vt (cdr (assoc 11 (entget tch)))))
(setq ki1 (cadr (setq ki0 (assoc ki lst1)))
ki2 (last ki0)
lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
lst (vl-sort lst '(lambda (e1 e2) (> (caddr (assoc 10 (entget e1))) (caddr (assoc 10 (entget e2))))))
linespc (* (cdr (assoc 40 (entget (car lst)))) tyledong)
yht (+ (* linespc (- (length lst) (length (member tch lst)) -1)) (cadr vt)))
(command "undo" "begin")
(foreach e lst
(setq eget (entget e)
dtiep (list (car vt) (setq yht (- yht linespc)) 0)
eget (subst (cons 72 ki1) (assoc 72 eget) eget)
eget (subst (cons 73 ki2) (assoc 73 eget) eget)
eget (if (and (zerop ki1) (zerop ki2))
(subst (cons 10 dtiep) (assoc 10 eget) eget)
(subst (cons 11 dtiep) (assoc 11 eget) eget)))
(entmod eget))
(command "undo" "end")
(setvar "osmode" oldos)
(princ))[/font]
Về Đầu Trang Go down
http://xaydungit.forumvi.com
 
[Sưu tầm]Lisp căn lề chữ
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