Đến nội dung


Hình ảnh
- - - - -

Yêu cầu lisp căn chỉnh vị trí Text !


  • Please log in to reply
12 replies to this topic

#1 hhhhgggg

hhhhgggg

    biết dimedit

  • Members
  • PipPipPipPipPip
  • 393 Bài viết
Điểm đánh giá: 30 (tàm tạm)

Đã gửi 15 October 2008 - 11:31 AM

Tôi muốn có 1 lisp căn chỉnh được vị trí của các dòng text (viết bằng các lệnh khác nhau )cho thẳng lề...Theo trục X:trái,phải, giữa ,Căn được theo trục Y, Z .Nếu có lisp này sẽ phục vụ rất hữu ích cho việc làm Thiết kế của các kỹ sư .
Ví dụ : Yêu cầu lisp phải làm được việc sau :
Trước khi căn chỉnh : tôi có 3 dòng chữ viết bằng 3 lệnh như sau :
''''''''''''''''''Dòng1

''''''''''''''''''''''''''''''''''''''''''''''''''''''Dòng2
dòng3
Sau căn chỉnh:Ví dụ tôi chọn căn trái:
Dòng1
Dòng2
dòng3

Nếu bác nào viết được thì thông báo giúp mình qua Mail để mình bit vào Down về dùng nhé : KS_Giang@yahoo.com hoặc KS_Giang 0985.136.988
  • 0
Hoàng Giang

#2 meohoang

meohoang

    biết lệnh adcenter

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

Đã gửi 15 October 2008 - 12:30 PM

Tôi muốn có 1 lisp căn chỉnh được vị trí của các dòng text (viết bằng các lệnh khác nhau )cho thẳng lề...Theo trục X:trái,phải, giữa ,Căn được theo trục Y, Z .Nếu có lisp này sẽ phục vụ rất hữu ích cho việc làm Thiết kế của các kỹ sư .
Ví dụ : Yêu cầu lisp phải làm được việc sau :
Trước khi căn chỉnh : tôi có 3 dòng chữ viết bằng 3 lệnh như sau :
Dòng1

Dòng2
dòng3
Sau căn chỉnh:Ví dụ tôi chọn căn trái:
Dòng1
Dòng2
dòng3

Nếu bác nào viết được thì thông báo giúp mình qua Mail để mình bit vào Down về dùng nhé : KS_Giang@yahoo.com hoặc KS_Giang 0985.136.988

lệnh Mtext làm được hết mà bạn, cái gì Cad có lệnh thì ko nên viết lisp
  • 0

#3 Snowman

Snowman

    biết lệnh mirror

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

Đã gửi 15 October 2008 - 12:59 PM

Đây là lisp để bạn tham khảo và có thể phát triển thêm, trước đây tôi viết chơi nhưng chẳng mấy khi dùng đến.
Lệnh rt: căn lề phải (cho các text xếp theo dạng cột)
lft: căn lề trái ( "" "" )
cct : căn giữa cho cột text
crt : căn giữa cho hàng text
Bạn có thể chỉnh sửa lại tuỳ theo yêu cầu sử dụng (căn theo x, y, z ...)
(defun myerror (s)
(cond
((= s "quit / exit abort") (princ))
((/= s "Function cancelled") (princ (strcat "\nError: " s)))
)
(setvar "cmdecho" CMD) ; Restore saved modes
(setvar "osmode" OSM)
(setq *error* OLDERR) ; Restore old *error* handler
(princ)
)




;;;==============================================================
;;; Can le fai text
;;;==============================================================
(defun c:rt (/ P1)
(setq olderr *error*
*error* myerror
)
(setvar "cmdecho" 0)

(command "UCS" "W" "")

(setq sstxt (ssget '((-4 . "<and")
(-4 . "<OR")
(0 . "text")
(0 . "Mtext")
(-4 . "OR>")
(50 . 0)
(-4 . "and>")
)
) ;chon text
P1 (getpoint "\nChon diem canh le phai cho text")
XRtxt (car P1)
)

(if (not (null sstxt))
(progn
(setq sslen (sslength sstxt) ;dem so doi tuong chon
ctr 0 ;Dat bien dem = 0
)
(command ".undo" "begin")
(while (< ctr sslen) ;Neu bien dem < so doi tuong
(setq object (entget (ssname sstxt ctr))
altxt (cdr (assoc 72 object))
)

(setq object (subst (cons 72 2) (assoc 72 object) object))
(setq object (entmod object))
(setq object (subst (cons 73 1) (assoc 73 object) object))
(setq object (entmod object))
(setq Ptxt (cdr (assoc 11 object))
NPtxt (list XRtxt (cadr Ptxt) ) ;(cadr Ptxt)
object (subst (cons 11 NPtxt) (assoc 11 object) object)
)
(setq object (entmod object))



(setq ctr (1+ ctr))
)

(command ".undo" "end")

)
)

(setq *error* olderr)

(setvar "cmdecho" 1)
(princ)
)

;;;=====================================================
;;; Can le trai text
(defun c:lft (/ P1)
(setq olderr *error*
*error* myerror
)
(setvar "cmdecho" 0)
(command "UCS" "W" "")
(setq sstxt (ssget '((-4 . "<and")
(-4 . "<OR")
(0 . "text")
(0 . "Mtext")
(-4 . "OR>")
(50 . 0)
(-4 . "and>")
)
) ;chon text
P1 (getpoint "\nChon diem canh le trai cho text")
XRtxt (car P1)
)

(if (not (null sstxt))
(progn
(setq sslen (sslength sstxt) ;dem so doi tuong chon
ctr 0 ;Dat bien dem = 0
)
(command ".undo" "begin")
(while (< ctr sslen) ;Neu bien dem < so doi tuong
(setq object (entget (ssname sstxt ctr))
altxt (cdr (assoc 72 object))
)

(setq object (subst (cons 72 0) (assoc 72 object) object))
(setq object (entmod object))
(setq object (subst (cons 73 1) (assoc 73 object) object))
(setq object (entmod object))
(setq Ptxt (cdr (assoc 11 object))
NPtxt (list XRtxt (cadr Ptxt) ) ;(cadr Ptxt)
object (subst (cons 11 NPtxt) (assoc 11 object) object)
)
(setq object (entmod object))



(setq ctr (1+ ctr))
)
(command ".undo" "end")

)
)

(setq *error* olderr)

(setvar "cmdecho" 1)
(princ)
)
;;;=====================================================
;;; Can giua cot text
(defun c:cct (/ P1)
(setq olderr *error*
*error* myerror
)
(setvar "cmdecho" 0)
(command "UCS" "W" "")
(setq sstxt (ssget '((-4 . "<and")
(-4 . "<OR")
(0 . "text")
(0 . "Mtext")
(-4 . "OR>")
(50 . 0)
(-4 . "and>")
)
) ;chon text
P1 (getpoint "\nChon diem canh le trai cho text")
XRtxt (car P1)
)

(if (not (null sstxt))
(progn
(setq sslen (sslength sstxt) ;dem so doi tuong chon
ctr 0 ;Dat bien dem = 0
)
(command ".undo" "begin")
(while (< ctr sslen) ;Neu bien dem < so doi tuong
(setq object (entget (ssname sstxt ctr))
altxt (cdr (assoc 72 object))
)

(setq object (subst (cons 72 1) (assoc 72 object) object))
(setq object (entmod object))
(setq object (subst (cons 73 2) (assoc 73 object) object))
(setq object (entmod object))
(setq Ptxt (cdr (assoc 11 object))
NPtxt (list XRtxt (cadr Ptxt) ) ;(cadr Ptxt)
object (subst (cons 11 NPtxt) (assoc 11 object) object)
)
(setq object (entmod object))



(setq ctr (1+ ctr))
)
(command ".undo" "end")

)
)

(setq *error* olderr)

(setvar "cmdecho" 1)
(princ)
)

;;;=====================================================
;;; Can giua hang text
(defun c:crt (/ P1)
(setq olderr *error*
*error* myerror
)
(setvar "cmdecho" 0)
(command "UCS" "W" "")
(setq sstxt (ssget '((-4 . "<and")
(-4 . "<OR")
(0 . "text")
(0 . "Mtext")
(-4 . "OR>")
(50 . 0)
(-4 . "and>")
)
) ;chon text
P1 (getpoint "\nChon diem can giua cho hang text")
XRtxt (car P1)
YRtxt (cadr P1)
)

(if (not (null sstxt))
(progn
(setq sslen (sslength sstxt) ;dem so doi tuong chon
ctr 0 ;Dat bien dem = 0
)
(command ".undo" "begin")
(while (< ctr sslen) ;Neu bien dem < so doi tuong
(setq object (entget (ssname sstxt ctr))
altxt (cdr (assoc 72 object))
)

(setq object (subst (cons 72 1) (assoc 72 object) object))
(setq object (entmod object))
(setq object (subst (cons 73 2) (assoc 73 object) object))
(setq object (entmod object))
(setq Ptxt (cdr (assoc 11 object))
NPtxt (list (car Ptxt) YRtxt ) ;(cadr Ptxt)
object (subst (cons 11 NPtxt) (assoc 11 object) object)
)
(setq object (entmod object))



(setq ctr (1+ ctr))
)
(command ".undo" "end")

)
)

(setq *error* olderr)

(setvar "cmdecho" 1)
(princ)
)


Dạo này vào quý IV, các bác nhà mình bận Tổng kết với ...đi đòi nợ hay sao mà thấy diễn đàn ... vắng vẻ (Ít có những yêu cầu kích thích sáng tạo )
:leluoi:
  • 0

. - ' * ' - .. - ... "Sống trong đời sống cần có một tấm lòng..." . - ' * ' - .. -
-----------------------------------------------------------------------------------

Hình đã gửi Hình đã gửi


#4 hhhhgggg

hhhhgggg

    biết dimedit

  • Members
  • PipPipPipPipPip
  • 393 Bài viết
Điểm đánh giá: 30 (tàm tạm)

Đã gửi 27 October 2008 - 10:12 AM

Đây là lisp để bạn tham khảo và có thể phát triển thêm, trước đây tôi viết chơi nhưng chẳng mấy khi dùng đến.
Lệnh rt: căn lề phải (cho các text xếp theo dạng cột)
lft: căn lề trái ( "" "" )
cct : căn giữa cho cột text
crt : căn giữa cho hàng text
Bạn có thể chỉnh sửa lại tuỳ theo yêu cầu sử dụng (căn theo x, y, z ...)

Dạo này vào quý IV, các bác nhà mình bận Tổng kết với ...đi đòi nợ hay sao mà thấy diễn đàn ... vắng vẻ (Ít có những yêu cầu kích thích sáng tạo )
:leluoi:



lisp của bác Snowman ko đúng rùi, Các bác chưa hiểu ý của em rùi , Ở đây em gọi là căn lề nhưng thực ra là Move vị trí của các Text cho thẳng hàng bên trái và thẳng hàng bên phải.Vì ở đây các Text viết bằng các lệnh khác nhau mà.Cho nên chúng là các đối tượng khác nhau.Vậy nên em mong có bác Pro nào viết cho em một cái lisp để có thể move các text thẳng hàng bên trái, bên phải, giữa tim mỗi text...

  • 0
Hoàng Giang

#5 Flex

Flex

    biết lệnh erase

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

Đã gửi 20 October 2008 - 01:23 PM

Bác vào trang www.cad-app.com chọ cadapp.zip download về nhé
+ Căn chỉnh mọi đối tượng Line, Polyline, text....
Lệnh: CANLE
Chọn các đối tượng cần căn chỉnh sau đó nhập:
-1: Căn trái
0: Can giữa
1: Căn phải
Áp dụng cho AutoCAD 2004,2005,2006;
  • 0
Phần mềm và Tiện ích trên AutoCAD
->SHD- Phần mềm TK nhà xưởng thép tiền chế
->Nhận hợp tác thiết kế nhà thép tiền chế
website: www.cad-app.com
email: flexnet@cad-app.com
ym: flex_tools

#6 Sony2007

Sony2007

    biết lệnh copy

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

Đã gửi 10 November 2008 - 08:20 PM

Đây là lisp để bạn tham khảo và có thể phát triển thêm, trước đây tôi viết chơi nhưng chẳng mấy khi dùng đến.
Lệnh rt: căn lề phải (cho các text xếp theo dạng cột)
lft: căn lề trái ( "" "" )
cct : căn giữa cho cột text
crt : căn giữa cho hàng text
Bạn có thể chỉnh sửa lại tuỳ theo yêu cầu sử dụng (căn theo x, y, z ...)

(defun myerror (s)
(cond
((= s "quit / exit abort") (princ))
((/= s "Function cancelled") (princ (strcat "\nError: " s)))
)
(setvar "cmdecho" CMD) ; Restore saved modes
(setvar "osmode" OSM)
(setq *error* OLDERR) ; Restore old *error* handler
(princ)
)
;;;==============================================================
;;; Can le fai text
;;;==============================================================
(defun c:rt (/ P1)
(setq olderr *error*
*error* myerror
)
(setvar "cmdecho" 0)

(command "UCS" "W" "")

(setq sstxt (ssget '((-4 . " (-4 . " (0 . "text")
(0 . "Mtext")
(-4 . "OR>")
(50 . 0)
(-4 . "and>")
)
) ;chon text
P1 (getpoint "\nChon diem canh le phai cho text")
XRtxt (car P1)
)

(if (not (null sstxt))
(progn
(setq sslen (sslength sstxt) ;dem so doi tuong chon
ctr 0 ;Dat bien dem = 0
)
(command ".undo" "begin")
(while (< ctr sslen) ;Neu bien dem < so doi tuong
(setq object (entget (ssname sstxt ctr))
altxt (cdr (assoc 72 object))
)

(setq object (subst (cons 72 2) (assoc 72 object) object))
(setq object (entmod object))
(setq object (subst (cons 73 1) (assoc 73 object) object))
(setq object (entmod object))
(setq Ptxt (cdr (assoc 11 object))
NPtxt (list XRtxt (cadr Ptxt) ) ;(cadr Ptxt)
object (subst (cons 11 NPtxt) (assoc 11 object) object)
)
(setq object (entmod object))
(setq ctr (1+ ctr))
)

(command ".undo" "end")

)
)

(setq *error* olderr)

(setvar "cmdecho" 1)
(princ)
)

;;;=====================================================
;;; Can le trai text
(defun c:lft (/ P1)
(setq olderr *error*
*error* myerror
)
(setvar "cmdecho" 0)
(command "UCS" "W" "")
(setq sstxt (ssget '((-4 . " (-4 . " (0 . "text")
(0 . "Mtext")
(-4 . "OR>")
(50 . 0)
(-4 . "and>")
)
) ;chon text
P1 (getpoint "\nChon diem canh le trai cho text")
XRtxt (car P1)
)

(if (not (null sstxt))
(progn
(setq sslen (sslength sstxt) ;dem so doi tuong chon
ctr 0 ;Dat bien dem = 0
)
(command ".undo" "begin")
(while (< ctr sslen) ;Neu bien dem < so doi tuong
(setq object (entget (ssname sstxt ctr))
altxt (cdr (assoc 72 object))
)

(setq object (subst (cons 72 0) (assoc 72 object) object))
(setq object (entmod object))
(setq object (subst (cons 73 1) (assoc 73 object) object))
(setq object (entmod object))
(setq Ptxt (cdr (assoc 11 object))
NPtxt (list XRtxt (cadr Ptxt) ) ;(cadr Ptxt)
object (subst (cons 11 NPtxt) (assoc 11 object) object)
)
(setq object (entmod object))
(setq ctr (1+ ctr))
)
(command ".undo" "end")

)
)

(setq *error* olderr)

(setvar "cmdecho" 1)
(princ)
)
;;;=====================================================
;;; Can giua cot text
(defun c:cct (/ P1)
(setq olderr *error*
*error* myerror
)
(setvar "cmdecho" 0)
(command "UCS" "W" "")
(setq sstxt (ssget '((-4 . " (-4 . " (0 . "text")
(0 . "Mtext")
(-4 . "OR>")
(50 . 0)
(-4 . "and>")
)
) ;chon text
P1 (getpoint "\nChon diem canh le trai cho text")
XRtxt (car P1)
)

(if (not (null sstxt))
(progn
(setq sslen (sslength sstxt) ;dem so doi tuong chon
ctr 0 ;Dat bien dem = 0
)
(command ".undo" "begin")
(while (< ctr sslen) ;Neu bien dem < so doi tuong
(setq object (entget (ssname sstxt ctr))
altxt (cdr (assoc 72 object))
)

(setq object (subst (cons 72 1) (assoc 72 object) object))
(setq object (entmod object))
(setq object (subst (cons 73 2) (assoc 73 object) object))
(setq object (entmod object))
(setq Ptxt (cdr (assoc 11 object))
NPtxt (list XRtxt (cadr Ptxt) ) ;(cadr Ptxt)
object (subst (cons 11 NPtxt) (assoc 11 object) object)
)
(setq object (entmod object))
(setq ctr (1+ ctr))
)
(command ".undo" "end")

)
)

(setq *error* olderr)

(setvar "cmdecho" 1)
(princ)
)

;;;=====================================================
;;; Can giua hang text
(defun c:crt (/ P1)
(setq olderr *error*
*error* myerror
)
(setvar "cmdecho" 0)
(command "UCS" "W" "")
(setq sstxt (ssget '((-4 . " (-4 . " (0 . "text")
(0 . "Mtext")
(-4 . "OR>")
(50 . 0)
(-4 . "and>")
)
) ;chon text
P1 (getpoint "\nChon diem can giua cho hang text")
XRtxt (car P1)
YRtxt (cadr P1)
)

(if (not (null sstxt))
(progn
(setq sslen (sslength sstxt) ;dem so doi tuong chon
ctr 0 ;Dat bien dem = 0
)
(command ".undo" "begin")
(while (< ctr sslen) ;Neu bien dem < so doi tuong
(setq object (entget (ssname sstxt ctr))
altxt (cdr (assoc 72 object))
)

(setq object (subst (cons 72 1) (assoc 72 object) object))
(setq object (entmod object))
(setq object (subst (cons 73 2) (assoc 73 object) object))
(setq object (entmod object))
(setq Ptxt (cdr (assoc 11 object))
NPtxt (list (car Ptxt) YRtxt ) ;(cadr Ptxt)
object (subst (cons 11 NPtxt) (assoc 11 object) object)
)
(setq object (entmod object))
(setq ctr (1+ ctr))
)
(command ".undo" "end")

)
)

(setq *error* olderr)

(setvar "cmdecho" 1)
(princ)
)


Dạo này vào quý IV, các bác nhà mình bận Tổng kết với ...đi đòi nợ hay sao mà thấy diễn đàn ... vắng vẻ (Ít có những yêu cầu kích thích sáng tạo )
-_-


Chào Snowman, vừa rồi tôi có tải đoạn lisp của anh về dùng, nhưng khi sử dụng không hiểu sao các text bị văng đâu mất. Bác Hoành nói là đoạn code viết anh sửa giúp. File cad, file lisp tôi đã thể hiện ở mục http://www.cadviet.com/forum/index.php?showtopic=205&pid=40506&st=1260&#entry40506. Anh giúp tôi với nhé.
  • 0

#7 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 16 November 2008 - 06:02 PM

Mình tìm thấy 3 lisp này, các bạn sài tạm nhé. Thanks tác giả nhiều.

Lệnh cdo
http://www.cadviet.com/upfiles/cdo_Canh_dong_text.fas
Lệnh cha
http://www.cadviet.com/upfiles/cha_Canh_hang_text.fas
Lệnh cle
http://www.cadviet.com/upfiles/cle_Canh_le_text.fas

  • 1

#8 nataca

nataca

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 712 Bài viết
Điểm đánh giá: 553 (tốt)

Đã gửi 16 November 2008 - 08:29 PM

Chào Snowman, vừa rồi tôi có tải đoạn lisp của anh về dùng, nhưng khi sử dụng không hiểu sao các text bị văng đâu mất. Bác Hoành nói là đoạn code viết anh sửa giúp. File cad, file lisp tôi đã thể hiện ở mục http://www.cadviet.com/forum/index.php?showtopic=205&pid=40506&st=1260&#entry40506. Anh giúp tôi với nhé.

Text văng có thể là do bạn dùng Mtext.
Đây là Lisp tôi viết để dùng. Cái này giúp trình bày bản vẽ ngay ngắn hơn.

;CAN THANG HANG TEXT THEO PHUONG X VA PHUONG Y
(defun C:TX ( / ss pt Lst dem Tj X Pnew Vtriold VtriNew)
(SAVE_MODE)
(INIT)
(setq ss (C_CHU "\n Chon cac hang text can can deu theo phuong X...")
pt (getpoint "\n Chon diem can dat cac dong text /
An enter se chon dong text dau tien lam chuan...")
Lst (SORT_X ss)
dem 0
)
(if (null pt) (setq pt (cdr (POS_L0 Lst 0))))
(repeat (length Lst)
(setq Tj (TEXTJ (nth dem Lst))
Vtriold (POS_L0 Lst dem)
VtriNew (THAYTD Vtriold (cons Tj pt) "x")
)
(entmod (subst VtriNew Vtriold (entget (nth dem Lst))))
(setq dem (1+ dem))
)
(RESTORE)
(DONE)
)

(defun C:TXC ( / ss pt Lst dem Tj X Pnew Vtriold VtriNew le Tnew)
(SAVE_MODE)
(INIT)
(setq ss (C_CHU "\n Chon cac hang text can can deu theo phuong X (can le center)...")
pt (getpoint "\n Chon diem can dat cac dong text /
An enter se chon dong text dau tien lam chuan...")
Lst (SORT_X ss)
dem 0
)
(if (null pt) (setq pt (cdr (POS_L0 Lst 0))))
(repeat (length Lst)
(setq le (assoc 72 (entget (nth dem Lst)))
Vtriold (assoc 10 (entget (nth dem Lst)))
VtriNew (THAYTD Vtriold (cons 11 pt) "Tj")
VtriNew (THAYTD VtriNew (cons 11 pt) "x")
Vtriold (assoc 11 (entget (nth dem Lst)))
Tnew (subst VtriNew Vtriold (entget (nth dem Lst)))
)
(entmod (subst (cons 72 1) le Tnew))
(setq dem (1+ dem))
)
(RESTORE)
(DONE)
)


(defun C:TYH ( / ss1 ss2 pt Lst1 Lst2 Y1 Y2 Yp)
(SAVE_MODE)
(INIT)
(setq ss1 (C_CHU "\n Chon cac hang text thu nhat can can deu theo phuong Y...")
ss2 (C_CHU "\n Chon cac hang text thu 2 can can deu theo phuong Y...")
pt (getpoint "\n Chon diem can dat cac hang text /
An enter se chon dong text dau tien hang chon lan 1 lam chuan...")
Lst1 (SORT_Y ss1)
Lst2 (SORT_Y ss2)
)
(if (null pt) (setq pt (cdr (POS_L0 Lst1 0))))
(setq Y1 (POS_L_Y Lst1 0)
Y2 (POS_L_Y Lst2 0)
Yp (cadr pt)
)
(command "move" ss1 "" pt (strcat "@0," (rtos (- Yp Y1))))
(command "move" ss2 "" pt (strcat "@0," (rtos (- Yp Y2))))
(RESTORE)
(DONE)
)


(defun C:TY ( / ss pt Lst dem Tj X Pnew Vtriold VtriNew Tnew)
(SAVE_MODE)
(INIT)
(setq ss (C_CHU "\n Chon cac hang text can can deu theo phuong Y...")
pt (getpoint "\n Chon diem can dat cac dong text /
An enter se chon dong text dau tien lam chuan...")
Lst (SORT_X ss)
dem 0
)
(if (null pt) (setq pt (cdr (POS_L0 Lst 0))))
(repeat (length Lst)
(setq le (assoc 73 (entget (nth dem Lst)))
Tj (TEXTJ (nth dem Lst))
Vtriold (POS_L0 Lst dem)
VtriNew (THAYTD Vtriold (cons Tj pt) "y")
Tnew (subst VtriNew Vtriold (entget (nth dem Lst)))
)
(entmod (subst (cons 73 0) le Tnew))
(setq dem (1+ dem))
)
(RESTORE)
(DONE)
)

; HAM BAY LOI
(defun INIT ()
(setq OLD_ERROR *error*
*error* MYERROR
)
(command "Undo" "begin")
)

(defun MYERROR (errmsg)

(cond
( (= errmsg "quit / exit abort")
(princ)
)
( (/= errmsg "Function cancelled")
(princ (strcat "\n Co loi: " errmsg))
)
)
(command "Undo" 20)
(setvar "osmode" OLD_OSMODE)
(command "CECOLOR" OLD_CECOLOR)
(DONE)
(prompt "\n Da thuc hien ham error, Reset lai thiet lap ban dau")
(command "Undo" "end")

)

(defun DONE ()
(if OLD_ERROR (setq *error* OLD_ERROR))
)
;;;;;----------------------------------------------------------
; HAM LUU VA TRA LAI CAC THONG SO BAN DAU
(defun SAVE_MODE()

(command "Undo" "begin")
(command "UCS" "W" "")
(setq OLD_OSMODE (getvar "OSMODE")
OLD_CECOLOR (getvar "CECOLOR")
OLD_AUTOSNAP (getvar "AUTOSNAP")
OLD_ORTHOMODE (getvar "ORTHOMODE")
)
(command "cmdecho" 0)

)
(defun RESTORE()

(command "Undo" "end")
(setvar "osmode" OLD_OSMODE)
(setvar "AUTOSNAP" OLD_AUTOSNAP)
(setvar "ORTHOMODE" OLD_ORTHOMODE)
(command "CECOLOR" OLD_CECOLOR)
(command "cmdecho" 1)
(Grtext -1 "Lisp's written by Nataca - 0983.715.333")
)
------------------------------------------
;;; CHON TEXT KEM DONG NHAC (BAT BUOC CHON)
(defun C_CHU (dongnhac / ss)
(while (and (not (prompt dongnhac))
(not (setq ss (ssget
'((-4 . ""))
)
)
)
)
)
ss
)
;------------------------------------------
; SAP XEP LIST THEO THU TU TANG DAN CUA TOA DO X
(defun SORT_X (ss)
(setq lst (SS2LST ss)
lst (vl-sort lst
'(lambda (e1 e2)
(<
(cadr (assoc
(if (and (= (cadr (assoc 11 (entget e1))) 0.0)
(= (caddr (assoc 11 (entget e1))) 0.0)
)
10 11)
(entget e1)))
(cadr (assoc
(if (and (= (cadr (assoc 11 (entget e2))) 0.0)
(= (caddr (assoc 11 (entget e2))) 0.0)
)
10 11)
(entget e2)))
)
)
)
)
)
;------------------------------------------
;;;TOA DO DIEM CUA DOI TUONG TRONG LIST TAP HOP
(defun POS_L0 (Lst c / ob)

(setq ob (entget (nth c Lst)))
(assoc
(if (and (= (cadr (assoc 11 ob)) 0.0)
(= (caddr (assoc 11 ob)) 0.0)
)
10 11
)
ob
)
)
;------------------------------------------
;;;XAC DINH JUSTIFY CUA TEXTS
(defun TEXTJ (ent)
(if (and (= (cadr (assoc 11 (entget ent))) 0.0)
(= (caddr (assoc 11 (entget ent))) 0.0)
)
10 11
)
)
------------------------------------------
;;; DOI TOA DO X HOAC Y HOAC Z
(defun THAYTD (TdOld TdNew vtri / Tj x y z)
(cond ( (= vtri "x")
(setq Tj (car TdOld)
x (cadr TdNew)
y (caddr TdOld)
z (caddr TdOld)
)
(list Tj x y z)
)
( (= vtri "y")
(setq Tj (car TdOld)
x (cadr TdOld)
y (caddr TdNew)
z (caddr TdOld)
)
(list Tj x y z)
)
( (= vtri "z")
(setq Tj (car TdOld)
x (cadr TdOld)
y (caddr TdOld)
z (caddr TdNew)
)
(list Tj x y z)
)
( (= vtri "Tj")
(setq Tj (car TdNew)
x (cadr TdOld)
y (caddr TdOld)
z (caddr TdOld)
)
(list Tj x y z)
)
)
)
; SAP XEP LIST THEO THU TU GIAM DAN CUA TOA DO Y
(defun SORT_Y (ss)
(setq lst (SS2LST ss)
lst (vl-sort lst
'(lambda (e1 e2)
(>
(caddr (assoc
(if (and (= (cadr (assoc 11 (entget e1))) 0.0)
(= (caddr (assoc 11 (entget e1))) 0.0)
)
10 11)
(entget e1)))
(caddr (assoc
(if (and (= (cadr (assoc 11 (entget e2))) 0.0)
(= (caddr (assoc 11 (entget e2))) 0.0)
)
10 11)
(entget e2)))
)
)
)
)
)
;------------------------------------------
;;;TOA DO Y CUA DOI TUONG TRONG LIST TAP HOP
(defun POS_L_Y (Lst c / ob ts nd)

(setq ob (entget (nth c Lst))
ts (assoc
(if (and (= (cadr (assoc 11 ob)) 0.0)
(= (caddr (assoc 11 ob)) 0.0)
)
10 11
) ob)

)
(caddr ts)

)

  • 0

#9 Sony2007

Sony2007

    biết lệnh copy

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

Đã gửi 16 November 2008 - 09:58 PM

Text văng có thể là do bạn dùng Mtext.
Đây là Lisp tôi viết để dùng. Cái này giúp trình bày bản vẽ ngay ngắn hơn.


;CAN THANG HANG TEXT THEO PHUONG X VA PHUONG Y
(defun C:TX ( / ss pt Lst dem Tj X Pnew Vtriold VtriNew)
(SAVE_MODE)
(INIT)
(setq ss (C_CHU "\n Chon cac hang text can can deu theo phuong X...")
pt (getpoint "\n Chon diem can dat cac dong text /
An enter se chon dong text dau tien lam chuan...")
Lst (SORT_X ss)
dem 0
)
(if (null pt) (setq pt (cdr (POS_L0 Lst 0))))
(repeat (length Lst)
(setq Tj (TEXTJ (nth dem Lst))
Vtriold (POS_L0 Lst dem)
VtriNew (THAYTD Vtriold (cons Tj pt) "x")
)
(entmod (subst VtriNew Vtriold (entget (nth dem Lst))))
(setq dem (1+ dem))
)
(RESTORE)
(DONE)
)

(defun C:TXC ( / ss pt Lst dem Tj X Pnew Vtriold VtriNew le Tnew)
(SAVE_MODE)
(INIT)
(setq ss (C_CHU "\n Chon cac hang text can can deu theo phuong X (can le center)...")
pt (getpoint "\n Chon diem can dat cac dong text /
An enter se chon dong text dau tien lam chuan...")
Lst (SORT_X ss)
dem 0
)
(if (null pt) (setq pt (cdr (POS_L0 Lst 0))))
(repeat (length Lst)
(setq le (assoc 72 (entget (nth dem Lst)))
Vtriold (assoc 10 (entget (nth dem Lst)))
VtriNew (THAYTD Vtriold (cons 11 pt) "Tj")
VtriNew (THAYTD VtriNew (cons 11 pt) "x")
Vtriold (assoc 11 (entget (nth dem Lst)))
Tnew (subst VtriNew Vtriold (entget (nth dem Lst)))
)
(entmod (subst (cons 72 1) le Tnew))
(setq dem (1+ dem))
)
(RESTORE)
(DONE)
)
(defun C:TYH ( / ss1 ss2 pt Lst1 Lst2 Y1 Y2 Yp)
(SAVE_MODE)
(INIT)
(setq ss1 (C_CHU "\n Chon cac hang text thu nhat can can deu theo phuong Y...")
ss2 (C_CHU "\n Chon cac hang text thu 2 can can deu theo phuong Y...")
pt (getpoint "\n Chon diem can dat cac hang text /
An enter se chon dong text dau tien hang chon lan 1 lam chuan...")
Lst1 (SORT_Y ss1)
Lst2 (SORT_Y ss2)
)
(if (null pt) (setq pt (cdr (POS_L0 Lst1 0))))
(setq Y1 (POS_L_Y Lst1 0)
Y2 (POS_L_Y Lst2 0)
Yp (cadr pt)
)
(command "move" ss1 "" pt (strcat "@0," (rtos (- Yp Y1))))
(command "move" ss2 "" pt (strcat "@0," (rtos (- Yp Y2))))
(RESTORE)
(DONE)
)
(defun C:TY ( / ss pt Lst dem Tj X Pnew Vtriold VtriNew Tnew)
(SAVE_MODE)
(INIT)
(setq ss (C_CHU "\n Chon cac hang text can can deu theo phuong Y...")
pt (getpoint "\n Chon diem can dat cac dong text /
An enter se chon dong text dau tien lam chuan...")
Lst (SORT_X ss)
dem 0
)
(if (null pt) (setq pt (cdr (POS_L0 Lst 0))))
(repeat (length Lst)
(setq le (assoc 73 (entget (nth dem Lst)))
Tj (TEXTJ (nth dem Lst))
Vtriold (POS_L0 Lst dem)
VtriNew (THAYTD Vtriold (cons Tj pt) "y")
Tnew (subst VtriNew Vtriold (entget (nth dem Lst)))
)
(entmod (subst (cons 73 0) le Tnew))
(setq dem (1+ dem))
)
(RESTORE)
(DONE)
)

; HAM BAY LOI
(defun INIT ()
(setq OLD_ERROR *error*
*error* MYERROR
)
(command "Undo" "begin")
)

(defun MYERROR (errmsg)

(cond
( (= errmsg "quit / exit abort")
(princ)
)
( (/= errmsg "Function cancelled")
(princ (strcat "\n Co loi: " errmsg))
)
)
(command "Undo" 20)
(setvar "osmode" OLD_OSMODE)
(command "CECOLOR" OLD_CECOLOR)
(DONE)
(prompt "\n Da thuc hien ham error, Reset lai thiet lap ban dau")
(command "Undo" "end")

)

(defun DONE ()
(if OLD_ERROR (setq *error* OLD_ERROR))
)
;;;;;----------------------------------------------------------
; HAM LUU VA TRA LAI CAC THONG SO BAN DAU
(defun SAVE_MODE()

(command "Undo" "begin")
(command "UCS" "W" "")
(setq OLD_OSMODE (getvar "OSMODE")
OLD_CECOLOR (getvar "CECOLOR")
OLD_AUTOSNAP (getvar "AUTOSNAP")
OLD_ORTHOMODE (getvar "ORTHOMODE")
)
(command "cmdecho" 0)

)
(defun RESTORE()

(command "Undo" "end")
(setvar "osmode" OLD_OSMODE)
(setvar "AUTOSNAP" OLD_AUTOSNAP)
(setvar "ORTHOMODE" OLD_ORTHOMODE)
(command "CECOLOR" OLD_CECOLOR)
(command "cmdecho" 1)
(Grtext -1 "Lisp's written by Nataca - 0983.715.333")
)
------------------------------------------
;;; CHON TEXT KEM DONG NHAC (BAT BUOC CHON)
(defun C_CHU (dongnhac / ss)
(while (and (not (prompt dongnhac))
(not (setq ss (ssget
'((-4 . ""))
)
)
)
)
)
ss
)
;------------------------------------------
; SAP XEP LIST THEO THU TU TANG DAN CUA TOA DO X
(defun SORT_X (ss)
(setq lst (SS2LST ss)
lst (vl-sort lst
'(lambda (e1 e2)
(<
(cadr (assoc
(if (and (= (cadr (assoc 11 (entget e1))) 0.0)
(= (caddr (assoc 11 (entget e1))) 0.0)
)
10 11)
(entget e1)))
(cadr (assoc
(if (and (= (cadr (assoc 11 (entget e2))) 0.0)
(= (caddr (assoc 11 (entget e2))) 0.0)
)
10 11)
(entget e2)))
)
)
)
)
)
;------------------------------------------
;;;TOA DO DIEM CUA DOI TUONG TRONG LIST TAP HOP
(defun POS_L0 (Lst c / ob)

(setq ob (entget (nth c Lst)))
(assoc
(if (and (= (cadr (assoc 11 ob)) 0.0)
(= (caddr (assoc 11 ob)) 0.0)
)
10 11
)
ob
)
)
;------------------------------------------
;;;XAC DINH JUSTIFY CUA TEXTS
(defun TEXTJ (ent)
(if (and (= (cadr (assoc 11 (entget ent))) 0.0)
(= (caddr (assoc 11 (entget ent))) 0.0)
)
10 11
)
)
------------------------------------------
;;; DOI TOA DO X HOAC Y HOAC Z
(defun THAYTD (TdOld TdNew vtri / Tj x y z)
(cond ( (= vtri "x")
(setq Tj (car TdOld)
x (cadr TdNew)
y (caddr TdOld)
z (caddr TdOld)
)
(list Tj x y z)
)
( (= vtri "y")
(setq Tj (car TdOld)
x (cadr TdOld)
y (caddr TdNew)
z (caddr TdOld)
)
(list Tj x y z)
)
( (= vtri "z")
(setq Tj (car TdOld)
x (cadr TdOld)
y (caddr TdOld)
z (caddr TdNew)
)
(list Tj x y z)
)
( (= vtri "Tj")
(setq Tj (car TdNew)
x (cadr TdOld)
y (caddr TdOld)
z (caddr TdOld)
)
(list Tj x y z)
)
)
)
; SAP XEP LIST THEO THU TU GIAM DAN CUA TOA DO Y
(defun SORT_Y (ss)
(setq lst (SS2LST ss)
lst (vl-sort lst
'(lambda (e1 e2)
(>
(caddr (assoc
(if (and (= (cadr (assoc 11 (entget e1))) 0.0)
(= (caddr (assoc 11 (entget e1))) 0.0)
)
10 11)
(entget e1)))
(caddr (assoc
(if (and (= (cadr (assoc 11 (entget e2))) 0.0)
(= (caddr (assoc 11 (entget e2))) 0.0)
)
10 11)
(entget e2)))
)
)
)
)
)
;------------------------------------------
;;;TOA DO Y CUA DOI TUONG TRONG LIST TAP HOP
(defun POS_L_Y (Lst c / ob ts nd)

(setq ob (entget (nth c Lst))
ts (assoc
(if (and (= (cadr (assoc 11 ob)) 0.0)
(= (caddr (assoc 11 ob)) 0.0)
)
10 11
) ob)

)
(caddr ts)

)


Khi tôi sử dụng lisp của a Nacata thì có báo lỗi như sau. Bác xem lỗi ở đâu nhé. Nghe nói bác có lisp dãn dòng cột của text đã up lên diễn đàn rồi mà tôi tìm không biết ở đâu.Chỉ giúp tôi đường link với.

Chon cac hang text can can deu theo phuong X...
Select objects: Specify opposite corner: 7 found

Select objects:
Chon diem can dat cac dong text / An enter se chon dong text dau tien lam
chuan...
Co loi: no function definition: SS2LST
Da thuc hien ham error, Reset lai thiet lap ban dau

  • 0

#10 nataca

nataca

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 712 Bài viết
Điểm đánh giá: 553 (tốt)

Đã gửi 16 November 2008 - 11:28 PM

Khi tôi sử dụng lisp của a Nacata thì có báo lỗi như sau. Bác xem lỗi ở đâu nhé. Nghe nói bác có lisp dãn dòng cột của text đã up lên diễn đàn rồi mà tôi tìm không biết ở đâu.Chỉ giúp tôi đường link với.

Chon cac hang text can can deu theo phuong X...
Select objects: Specify opposite corner: 7 found

Select objects:
Chon diem can dat cac dong text / An enter se chon dong text dau tien lam
chuan...
Co loi: no function definition: SS2LST
Da thuc hien ham error, Reset lai thiet lap ban dau

Hx. Copy thiếu mất 1 hàm con SS2LST. Phiền bạn thêm dòng code này nữa

; CHUYEN BIEU DIEN TAP HOP DOI TUONG DUOI DANG LIST CHUA ENAME CUA CAC DOI TUONG
(defun SS2LST (ss / sodt index lstent)
(setq
sodt (if ss (sslength ss) 0)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)

Hoặc bạn dùng luôn cái này cho nó đỡ sợ bị copy thiếu.
http://www.mediafire.com/?zjymceyymwz
  • 0

#11 Sony2007

Sony2007

    biết lệnh copy

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

Đã gửi 17 November 2008 - 01:32 PM

Hx. Copy thiếu mất 1 hàm con SS2LST. Phiền bạn thêm dòng code này nữa


; CHUYEN BIEU DIEN TAP HOP DOI TUONG DUOI DANG LIST CHUA ENAME CUA CAC DOI TUONG
(defun SS2LST (ss / sodt index lstent)
(setq
sodt (if ss (sslength ss) 0)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)

Hoặc bạn dùng luôn cái này cho nó đỡ sợ bị copy thiếu.http://www.mediafire.com/?zjymceyymwz


Cám ơn a Nacata, anh đã có lisp DDT (dãn dòng text) rồi, có thể bổ sung thêm tính năng dãn cột text được không. Cám ơn anh nhiều.
  • 0

#12 nataca

nataca

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 712 Bài viết
Điểm đánh giá: 553 (tốt)

Đã gửi 17 November 2008 - 01:38 PM

Cám ơn a Nacata, anh đã có lisp DDT (dãn dòng text) rồi, có thể bổ sung thêm tính năng dãn cột text được không. Cám ơn anh nhiều.

Đã trả lời ở topic này rồi mà :leluoi:
http://www.cadviet.c...o...20&start=20
  • 0

#13 kokono939

kokono939

    biết vẽ line

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

Đã gửi 18 December 2010 - 04:29 PM

Mình tìm thấy 3 lisp này, các bạn sài tạm nhé. Thanks tác giả nhiều.

Lệnh cdo

http://www.cadviet.com/upfiles/cdo_Canh_dong_text.fas
Lệnh cha
http://www.cadviet.com/upfiles/cha_Canh_hang_text.fas
Lệnh cle
http://www.cadviet.com/upfiles/cle_Canh_le_text.fas



Lisp này mình muốn sửa lại lệnh như thế nào?có thể chuyển sang file *.lsp ko har bạn?
  • 0