Đến nội dung


Hình ảnh
* * * - - 2 Bình chọn

Viết Lisp theo yêu cầu


  • Chủ đề bị khóa Chủ đề bị khóa
2780 replies to this topic

#161 xaydung

xaydung

    biết lệnh trim

  • Members
  • PipPipPip
  • 191 Bài viết
Điểm đánh giá: 12 (tàm tạm)

Đã gửi 18 August 2007 - 02:28 PM

Cac bac oi, cai lenh mcaltext nay bi loi, toi dung CAD 2004, khi copy ma lenh ve va ghi ra file lisp, sau do load file va thuc thi thi truong trinh thong bao:
mcaltext
; error: bad character read (octal): 0
Cac bac giup em voi !


trước khi chạy lisp bạn gõ lệnh CAL là OK mà
Công trình thủy Đại Học Hàng Hải À- làm quen đê!
  • 0

#162 xaydung

xaydung

    biết lệnh trim

  • Members
  • PipPipPip
  • 191 Bài viết
Điểm đánh giá: 12 (tàm tạm)

Đã gửi 18 August 2007 - 02:59 PM

mình đang cần 1 lisp có nội dung như sau:
trên màn hình 3D có 2 rectang như nhau nhưng 1 cái nằm trong mặt phẳng XY
1 cái song song với mặt phẳng XY nhưng có toạ độ Z.
khi chạy lisp hỏi chọn các hình vẽ, lisp sẽ tự động vẽ các đường line nối 4 góc
của các rectang tạo thành 1 hình hộp dạng mô hình 3D khung dây.
[/quote]
  • 0

#163 ssg

ssg

    biết lệnh adcenter

  • Vip
  • PipPipPipPipPipPipPip
  • 1228 Bài viết
Điểm đánh giá: 1087 (rất tốt)

Đã gửi 18 August 2007 - 03:47 PM

Cám ơn SSg, tui đang cần 1 lisp nữa có nội dung như sau:
trên màn hình 3D có 2 rectang như nhau nhưng 1 cái nằm trong mặt phẳng XY
1 cái song song với mặt phẳng XY nhưng có toạ độ Z.
khi chạy lisp hỏi chọn các hình vẽ, lisp sẽ tự động vẽ các đường line nối 4 góc
của các rectang tạo thành 1 hình hộp dạng mô hình 3D khung dây.



;;;---------------------------------------------
(defun comp2 (p1 p2 / x1 y1 x2 y2)
(setq
x1 (car p1) y1 (cadr p1)
x2 (car p2) y2 (cadr p2)
)
(or (< x1 x2) (and (= x1 x2) (< y1 y2)))
)
;;;---------------------------------------------
(defun GetP(Rec / Dat Z L p)
(setq
Dat (entget Rec)
Z (cdr (assoc 38 Dat))
L nil
)
(while (setq Item (assoc 10 Dat))
(setq
p (append (cdr item) (list Z))
L (append L (list p))
Dat (vl-remove Item Dat)
)
)
(vl-sort L 'comp2)
)
;;;-=========================
(defun C:JRE(/ L1 L2 i)
(setq
L1 (getP (car (entsel "\nSelect rectangle 1:")))
L2 (getP (car (entsel "\nSelect rectangle 2:")))
i 0
)
(repeat 4
(entmake (list (cons 0 "LINE") (cons 10 (nth i L1)) (cons 11 (nth i L2))))
(setq i (1+ i))
)
)
;;;-=========================



Lệnh JRE (joint rectangle)
  • 0

#164 xaydung

xaydung

    biết lệnh trim

  • Members
  • PipPipPip
  • 191 Bài viết
Điểm đánh giá: 12 (tàm tạm)

Đã gửi 18 August 2007 - 10:20 PM

Cám ơn ssg nhưng bạn ơi, rectang chỉ là mình ví dụ thôi
chứ thực tế chẳng may explode ra line thì có làm được không bác?
tức là lisp sẽ nhận ra điểm tại đó có 2 line(hoặc 3 line) giao nhau
rồi nối chúng lại theo trục z đó.
ví dụ: có 2 hình chữ thập 1 trên, 1 dưới(chữ thập dưới trong mặt phẳng XY)
có nghĩa là lấy ra điểm giao của chữ thập rồi nối lại thành 1 line
  • 0

#165 kts.ngocquan

kts.ngocquan

    biết vẽ ellipse

  • Members
  • PipPip
  • 59 Bài viết
Điểm đánh giá: 36 (tàm tạm)

Đã gửi 18 August 2007 - 10:56 PM

NH ơi
Ông xem lại cái này tý nhé
http://www.cadviet.com/forum/index.php?showtopic=1544
Lệnh chuyển Layer mà ông viết phải nhập tên Layer , sao không pick luôn vào đối tượng nhỉ :unsure:
Đề nghị chuyển lại ngay nhé :unsure:
  • 0

#166 admin

admin

    Administrator

  • Root Admin
  • PipPipPipPip
  • 280 Bài viết
Điểm đánh giá: 484 (tốt)

Đã gửi 18 August 2007 - 11:02 PM

Cám ơn ssg nhưng bạn ơi, rectang chỉ là mình ví dụ thôi
chứ thực tế chẳng may explode ra line thì có làm được không bác?
tức là lisp sẽ nhận ra điểm tại đó có 2 line(hoặc 3 line) giao nhau
rồi nối chúng lại theo trục z đó.
ví dụ: có 2 hình chữ thập 1 trên, 1 dưới(chữ thập dưới trong mặt phẳng XY)
có nghĩa là lấy ra điểm giao của chữ thập rồi nối lại thành 1 line

Nếu chỉ là ví dụ thì bạn hãy nói rõ từ đầu! Đừng để Ssg mất bao công viết xong lisp rồi mới nói. Việc bạn nói muộn sẽ làm người khác mất công gấp 2. Đừng bao giờ đưa ra những yêu cầu thiếu cân nhắc như vậy nữa.

Nhắn chung mọi người: Việc viết lisp theo yêu cầu là một hành động rất tốt đẹp của diễn đàn. Nhưng không vì thế mà một số thành viên đưa ra những yêu cầu rất bâng quơ, làm người trợ giúp tốn bao công viết xong thì họ bảo là không đúng, đó chỉ là ví dụ,... và lại đưa ra yêu cầu khác.

Để topic này vẫn giữ được sự tốt đẹp trong sáng vốn có của nó, yêu cầu mọi người cần phải tuân thủ những nguyên tắc sau:
- Hãy cân nhắc thật kỹ, thật kỹ, thật kỹ trước khi đưa ra yêu cầu để đảm bảo người trợ giúp sẽ hiểu đúng mục đích của bạn.
- Mỗi khi người trợ giúp đã mất công viết lisp, họ sẽ không được viết lại (cho dù họ muốn). Sự thay đổi code nếu có chỉ là hiệu chỉnh code sai hoặc cải tiến code để đáp ứng một yêu cầu mới của người khác.
- Bài viết nào vi phạm một trong hai điều trên sẽ bị xoá!

Cảm ơn mọi người.
  • 0

#167 xaydung

xaydung

    biết lệnh trim

  • Members
  • PipPipPip
  • 191 Bài viết
Điểm đánh giá: 12 (tàm tạm)

Đã gửi 19 August 2007 - 12:40 AM

Sorry all! Em lần đầu , mong các bác bỏ quá cho!
  • 0

#168 vndesperados

vndesperados

    biết lệnh xref

  • Members
  • PipPipPipPipPipPipPip
  • 547 Bài viết
Điểm đánh giá: 253 (khá)

Đã gửi 19 August 2007 - 07:41 AM

Nếu chỉ là ví dụ thì bạn hãy nói rõ từ đầu! Đừng để Ssg mất bao công viết xong lisp rồi mới nói. Việc bạn nói muộn sẽ làm người khác mất công gấp 2. Đừng bao giờ đưa ra những yêu cầu thiếu cân nhắc như vậy nữa.

Nhắn chung mọi người: Việc viết lisp theo yêu cầu là một hành động rất tốt đẹp của diễn đàn. Nhưng không vì thế mà một số thành viên đưa ra những yêu cầu rất bâng quơ, làm người trợ giúp tốn bao công viết xong thì họ bảo là không đúng, đó chỉ là ví dụ,... và lại đưa ra yêu cầu khác.

Để topic này vẫn giữ được sự tốt đẹp trong sáng vốn có của nó, yêu cầu mọi người cần phải tuân thủ những nguyên tắc sau:
- Hãy cân nhắc thật kỹ, thật kỹ, thật kỹ trước khi đưa ra yêu cầu để đảm bảo người trợ giúp sẽ hiểu đúng mục đích của bạn.
- Mỗi khi người trợ giúp đã mất công viết lisp, họ sẽ không được viết lại (cho dù họ muốn). Sự thay đổi code nếu có chỉ là hiệu chỉnh code sai hoặc cải tiến code để đáp ứng một yêu cầu mới của người khác.
- Bài viết nào vi phạm một trong hai điều trên sẽ bị xoá!

Cảm ơn mọi người.


Chính xác, cảm ơn ban Quản trị đã gãi đúng chỗ ngứa.
Trước đây mình cũng tham gia và hay viết code cùng mọi người song thời gian sau này thấy nhiều người hay đưa ra những yêu cầu không đáng để phải bận tâm nên thôi không viết nữa. Diễn đàn là nơi giao lưu và học hỏi chứ không phải là một "kho công cụ" mà nhiều người cứ lên đây "lục lọi" và nhờ vả...
Có thể nhiều người cho rằng mình không biết thì nhờ người khác giúp, OK, điều này là bình thường nhưng hãy nên dừng lại ở mức học hỏi chứ đừng yêu cầu người khác đến mức phải làm thay mình...
Các bạn không có thời gian thì người khác cũng không có...
Ngay cả bác NguyenHoanh và ssg mình cũng sure là các bác ấy không thể không cần suy nghĩ khi viết code giúp các bạn... Có thể các bác ấy vô tư nhưng các bạn cũng đừng nên vô tâm như thế.
  • 1

#169 congtrinh5

congtrinh5

    biết vẽ line

  • Members
  • PipPip
  • 28 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 19 August 2007 - 04:09 PM

Xin lisp có nội dung như sau:
Fillet (hoặc chamfer) hàng loạt vật thể 3 chiều.
cụ thể, ví dụ trên màn hình là 1 box 3D dạng khối đặc
lisp sẽ hỏi chọn 1 cạnh , sau đó chương trình sẽ nhận ra các cạnh còn
lại nằm trong cùng mặt phẳng song song với mf XY rồi tự động fillet
hàng loạt. (như chức năng cộng thêm Chain nhưng ở đây vừa cộng thêm
vừa phải các cạch cùng 1 mặt phẳng // với XY)
  • 0

#170 conghoa

conghoa

    biết lệnh attdef

  • Members
  • PipPipPipPipPipPip
  • 411 Bài viết
Điểm đánh giá: 88 (tàm tạm)

Đã gửi 19 August 2007 - 04:38 PM

@Admin & vndesperados

Cảm ơn hai bác góp ý, nhưng nói chuyện trong này không tiện, tốt nhất Mod NguyenHoanh nên gom các bài như thế này ra một mục khác để anh em tiện theo dõi.

Mình thấy chương trình CADViet Utility mình thấy rất hay, và topic này là một bước quan trọng để có thể thực hiện được chương trình đó. Đây là nơi đem lại cho người điều hành dự án có thể nắm bắt tốt hơn về nhu cầu của người sử dụng chương trình CVU.

Để chuyên nghiệp hoá CVU (có thể phục vụ được tất cả các lĩnh vực có liên quan tới CAD) mình nghĩ nó mất nhiều thời gian và công sức. Chi bằng chúng ta nên xây dựng 1 cái vừa đủ để ứng dụng (cơ bản, những cái cần thiết giúp mọi người rút ngắn thời gian khi sử dụng CAD mà vẫn đạt hiệu quả mong muốn).
Kiến trúc, điện, kết cấu, PCCC, thoát nước... cần những thao tác gì trong bản vẽ, dựa trên những thao tác nào phải lặp đi lặp lại nhiều lần thì nên có lisp trong chương trình CVU.
Ví dụ:
Trong kiến trúc: Chèn cửa sổ, cửa đi, vẽ bậc cầu thang, chèn cây trong bản quy hoạch...
Trong kết cấu: thống kê lanh tô, vẽ thép đai ...
Trong điện nước, PCCC: Chủ yếu là chèn block, nếu quy định được tên lệnh trùng với tên block (đèn, quạt, ổ cắm, vòi cứu hoả...) thì việc chèn sẽ rất nhanh chóng, thuận tiện.


Ps: Nên có một bài tổng hợp các lisp có trong topic này vì trong này toàn những cái cần thiết cho mọi người cả. Nó sẽ là nơi thu hút mem tới CadViet.
Thanks!
  • 0

#171 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 4105 Bài viết
Điểm đánh giá: 4495 (đỉnh cao)

Đã gửi 19 August 2007 - 04:48 PM

Ps: Nên có một bài tổng hợp các lisp có trong topic này vì trong này toàn những cái cần thiết cho mọi người cả. Nó sẽ là nơi thu hút mem tới CadViet.
Thanks!

Đã có, bạn thử xem: http://www.cadviet.com/sub/hdownload.php?id=lisp
  • 0

#172 xaydung

xaydung

    biết lệnh trim

  • Members
  • PipPipPip
  • 191 Bài viết
Điểm đánh giá: 12 (tàm tạm)

Đã gửi 20 August 2007 - 11:24 AM

Van loi bac a (; error: bad argument type: numberp: nil)khi em go CAl rui, sau do chay lisp, nhung van ko dc
Bac cung hoc cong trinh thuy u, bac chu yeu ve van de gi, em lam chu yeu ve xay dung thuy loi thuy dien thui !

thế là do bác tạo file lisp sai rồi, chú ý các khoảng xuống dòng đó, phải chính xác
  • 0

#173 xaydung

xaydung

    biết lệnh trim

  • Members
  • PipPipPip
  • 191 Bài viết
Điểm đánh giá: 12 (tàm tạm)

Đã gửi 20 August 2007 - 04:14 PM

;Scale the mot chieu
(DEFUN EXCUTE()
(setq oldvalue (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(princ "Chon doi tuong can scale: ")
(setq ss (ssget))
(setq P0 (getpoint "\nChon diem goc: "))
(initget 1 "X Y X S")
(setq C (getkword "\nScale theo [X,Y,Z,Scale]?<X/Y/Z/S> :"))
(setq hs (getreal "Cho biet he so scale: "))
(DELBLOCK "vkc_temp")
(CREATEBLOCK ss P0)
(Command "-Insert" "vkc_temp" C hs P0 "")
(setq dt (entlast))
(Command "Explode" dt)
(setvar "CMDECHO" oldvalue)
(princ)
)
(DEFUN CREATEBLOCK(ss P)
(command "-Block" "vkc_temp" P ss "")
)

(DEFUN DELBLOCK (bname)
(if (IsExistBlock bname)
(Command "-Purge" "B" bname "Y" "Y")
)
)
(DEFUN IsExistBlock(bname / kq)
(setq kq Nil)
(setq n (length LiBlk))
(setq i 0)
(while (< i n)
(if (= bname (nth i LiBlk))
(progn
(setq i n)
(setq kq T)
)
)
(setq i (1+ i))
)
kq
)
(DEFUN CREALIBLK (/ NL)
(setq LiBlk (List))
(setq NL (tblnext "BLOCK" T))
(while NL
(setq LiBlk (append LiBlk (list (cdr (assoc 2 NL)))))
(setq NL (tblnext "BLOCK"))
)
(setq LiBlk (Acad_strlsort LiBlk))
)
(DEFUN C:XSCALE()
(CREALIBLK)
(EXCUTE)
)
(DEFUN C:XSC()
(CREALIBLK)
(EXCUTE)
)
(princ "\nfree lisp from www.cadviet.com")
(princ)



Các bác ơi cho em hỏi 1 chút, cái lisp scale đối tượng theo 1 trục này
sao không dùng được lần thứ hai nhỉ. tức là khi scale đối tượng đó cảm thấy chưa vừa ý muốn scale lại thì không được nữa(vì đã tạo thành cái khối gì gì đó)?các bác xem hộ em chút nha?
  • 0

#174 ts088

ts088

    biết zoom

  • Members
  • Pip
  • 18 Bài viết
Điểm đánh giá: 4 (bình thường)

Đã gửi 22 August 2007 - 02:43 PM

Các pác giúp em một đoạn lisp để khi vẽ một line (hay PLine) cắt qua các đối tượng (là Line) thì nó sẽ lần lượt chọn các đối tượng đó (theo thứ tự) và gán vào một biến. Thank các pác nhìu.
  • 0

#175 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 4105 Bài viết
Điểm đánh giá: 4495 (đỉnh cao)

Đã gửi 22 August 2007 - 03:15 PM

Các pác giúp em một đoạn lisp để khi vẽ một line (hay PLine) cắt qua các đối tượng (là Line) thì nó sẽ lần lượt chọn các đối tượng đó (theo thứ tự) và gán vào một biến. Thank các pác nhìu.

Hàm fselect dưới đây đáp ứng yêu cầu của bạn. lệnh test đi kèm là 1 ví dụ để gọi hàm fselect.

Cách dùng: (fselect ent)
tham số ent là ename của đối tượng PLINE hoặc LINE.
trả về: tập chọn như bạn yêu cầu.


(defun fselect(ent)
(vl-load-com)
(setq tt (entget ent)
tt (vl-remove-if '(lambda (x)
(and (/= (car x) 10)
(/= (car x) 11)
)
)
tt)
tt (mapcar '(lambda (x) (cdr x)) tt)
)
(ssdel ent (ssget "F" tt))
)

(defun c:test()
(setq ss (fselect (car (entsel "\nHay chon doi tuong: "))))
(sssetfirst ss ss)
)

  • 0

#176 conghoa

conghoa

    biết lệnh attdef

  • Members
  • PipPipPipPipPipPip
  • 411 Bài viết
Điểm đánh giá: 88 (tàm tạm)

Đã gửi 22 August 2007 - 11:21 PM

Cho mình xin cái lisp sắp xếp thẳng hàng và cách đều các text.
VD: mình có một hàng text (được viết bằng lệnh dt)
..............ghi chú:
........................hàng 1
........................
..................hàng 2
......hàng 3

Khi dùng lisp nó sẽ được kết quả như sau:

............ghi chú:
............hàng 1
............hàng 2
............hàng 3

(dấu "." ở đầu hàng chỉ để thể hiện sự không thẳng hàng của các text thôi, vì nếu không có nó khi post bài này nó sẽ thẳng hàng hết.)

Yêu cầu: Khoảng cách giữa các text sau khi đã sắp thẳng hàng bằng 2 lần độ cao chữ (và có thể điều chỉnh đựơc trong lisp)

Thanks nhiều!
  • 0

#177 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 4105 Bài viết
Điểm đánh giá: 4495 (đỉnh cao)

Đã gửi 22 August 2007 - 11:51 PM

Cho mình xin cái lisp sắp xếp thẳng hàng và cách đều các text.
VD: mình có một hàng text (được viết bằng lệnh dt)
...........

Lệnh là STEXT (Sắp text). Chương trình sẽ lấy text cao nhất làm gốc.

(defun c:stext ( / sst lstent egoc pgoc xgoc yht zgoc linespc ee tt)

(princ "\nSap xep text © CADViet.com")
(setq sst (ssget '((0 . "TEXT")))
lstent (ss2ent sst)
lstent (vl-sort lstent
'(lambda (e1 e2)
(> (cadr (cdr (assoc 10 (entget e1))))
(cadr (cdr (assoc 10 (entget e2))))
)
)
)
egoc (car lstent)
lstent (cdr lstent)
pgoc (cdr (assoc 10 (entget egoc)))
xgoc (car pgoc)
yht (cadr pgoc)
zgoc (caddr pgoc)
hgoc (cdr (assoc 40 (entget egoc)))
linespc (* hgoc 2.5)

)
(foreach ee lstent
(setq tt (entget ee)
tt (subst (list 10
xgoc
(setq yht (- yht linespc))
zgoc
)
(assoc 10 tt)
tt
)
)
(entmod tt)
(entupd ee)
)
)
(defun ss2ent (ss / sodt index lstent)
(setq
sodt (cond
(ss (sslength ss))
(t 0)
)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)
(princ
"\nSTEXT - Sap xep text - free lisp from www.cadviet.com"
)
(vl-load-com)

  • 0

#178 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 4105 Bài viết
Điểm đánh giá: 4495 (đỉnh cao)

Đã gửi 23 August 2007 - 08:38 AM

Chao cac bac, cai lenh nay bi loi:
Command: STEXT
Select objects: Specify opposite corner: 7 found
Select objects:
Bac xem lai xem !

Dòng thông báo đó không sao cả, chương trình vẫn chạy đúng.
Dòng thông báo đó là do lúc viết chương trình quên một lệnh exit quiet ở cuối thôi. Đoạn mã dưới đây đã thêm dòng mã (princ) để không xuất hiện thông báo đó!
Cảm ơn bạn đã hồi âm!


(defun c:stext ( / sst lstent egoc pgoc xgoc yht zgoc linespc ee tt)

(princ "\nSap xep text © CADViet.com")
(setq sst (ssget '((0 . "TEXT")))
lstent (ss2ent sst)
lstent (vl-sort lstent
'(lambda (e1 e2)
(> (cadr (cdr (assoc 10 (entget e1))))
(cadr (cdr (assoc 10 (entget e2))))
)
)
)
egoc (car lstent)
lstent (cdr lstent)
pgoc (cdr (assoc 10 (entget egoc)))
xgoc (car pgoc)
yht (cadr pgoc)
zgoc (caddr pgoc)
hgoc (cdr (assoc 40 (entget egoc)))
linespc (* hgoc 2.5)

)
(foreach ee lstent
(setq tt (entget ee)
tt (subst (list 10
xgoc
(setq yht (- yht linespc))
zgoc
)
(assoc 10 tt)
tt
)
)
(entmod tt)
(entupd ee)
)
(princ)
)
(defun ss2ent (ss / sodt index lstent)
(setq
sodt (cond
(ss (sslength ss))
(t 0)
)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)
(princ
"\nSTEXT - Sap xep text - free lisp from www.cadviet.com"
)
(vl-load-com)

  • 0

#179 vbao

vbao

    biết lệnh array

  • CADViet Team
  • PipPipPip
  • 184 Bài viết
Điểm đánh giá: 80 (tàm tạm)

Đã gửi 23 August 2007 - 08:42 PM

Dòng thông báo đó không sao cả, chương trình vẫn chạy đúng.
Dòng thông báo đó là do lúc viết chương trình quên một lệnh exit quiet ở cuối thôi. Đoạn mã dưới đây đã thêm dòng mã (princ) để không xuất hiện thông báo đó!
Cảm ơn bạn đã hồi âm!


(defun c:stext ( / sst lstent egoc pgoc xgoc yht zgoc linespc ee tt)

(princ "\nSap xep text © CADViet.com")
(setq sst (ssget '((0 . "TEXT")))
lstent (ss2ent sst)
lstent (vl-sort lstent
'(lambda (e1 e2)
(> (cadr (cdr (assoc 10 (entget e1))))
(cadr (cdr (assoc 10 (entget e2))))
)
)
)
egoc (car lstent)
lstent (cdr lstent)
pgoc (cdr (assoc 10 (entget egoc)))
xgoc (car pgoc)
yht (cadr pgoc)
zgoc (caddr pgoc)
hgoc (cdr (assoc 40 (entget egoc)))
linespc (* hgoc 2.5)

)
(foreach ee lstent
(setq tt (entget ee)
tt (subst (list 10
xgoc
(setq yht (- yht linespc))
zgoc
)
(assoc 10 tt)
tt
)
)
(entmod tt)
(entupd ee)
)
(princ)
)
(defun ss2ent (ss / sodt index lstent)
(setq
sodt (cond
(ss (sslength ss))
(t 0)
)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)
(princ
"\nSTEXT - Sap xep text - free lisp from www.cadviet.com"
)
(vl-load-com)



cảm ơn anh Hoành về tiện ích trên, anh cho hỏi thêm có cách nào tùy biến khoảng cách các dòng text (line spacing) theo yêu cầu của người sử dụng khi nhập từ keyboard vào không?
  • 0

#180 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 4105 Bài viết
Điểm đánh giá: 4495 (đỉnh cao)

Đã gửi 23 August 2007 - 08:58 PM

lisp dưới đây tên lệnh vẫn là STEXT, cải tiến để người sử dụng nhập thêm tỷ lệ khoảng cách dòng. Mặc định là 1.5 tức là khoảng trống cách giữa 2 dòng bằng 1.5 lần chiều cao text. Giá trị này sẽ được lưu trữ cho đến khi close file, nhấn Enter lúc nhập liệu nếu không muốn thay đổi giá trị này.


(defun c:stext ( / sst lstent egoc pgoc xgoc yht zgoc linespc ee tt)
(if (not tyledong)
(setq tyledong 1.5)
)
(princ "\nSap xep text © CADViet.com")
(setq sst (ssget '((0 . "TEXT")))
lstent (ss2ent sst)
tmp (getreal (strcat "\nVao ty le dong khoang cach dong <" (rtos tyledong 2 2) ">: "))
tyledong (cond
(tmp tmp)
(t tyledong)
)
lstent (vl-sort lstent
'(lambda (e1 e2)
(> (cadr (cdr (assoc 10 (entget e1))))
(cadr (cdr (assoc 10 (entget e2))))
)
)
)
egoc (car lstent)
lstent (cdr lstent)
pgoc (cdr (assoc 10 (entget egoc)))
xgoc (car pgoc)
yht (cadr pgoc)
zgoc (caddr pgoc)
hgoc (cdr (assoc 40 (entget egoc)))
linespc (* hgoc (+ 1.0 tyledong))

)
(foreach ee lstent
(setq tt (entget ee)
tt (subst (list 10
xgoc
(setq yht (- yht linespc))
zgoc
)
(assoc 10 tt)
tt
)
)
(entmod tt)
(entupd ee)
)
)
(defun ss2ent (ss / sodt index lstent)
(setq
sodt (cond
(ss (sslength ss))
(t 0)
)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
(princ)
)
(princ
"\nSTEXT - Sap xep text - free lisp from www.cadviet.com"
)
(vl-load-com)


  • 1