Đến nội dung


Hình ảnh
- - - - -

[Nhờ chỉnh sửa] lisp sắp xếp text


  • Please log in to reply
17 replies to this topic

#1 hugo75

hugo75

    biết vẽ polygon

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

Đã gửi 10 July 2011 - 02:04 PM

Mình thấy trên diễn đàn có 1 lisp sắp xếp text rất hay nhưng mình sử dụng thì không cần nhiều chức năng như trong lisp nên nhờ các bác sửa lại giùm e như sau:
Sau khi nhập khoảng cách dòng thì chỉ cần 3 lựa chọn LEFT,RIGHT,CENTER,Sau khi lựa chọn xong thì thêm chức năng chọn text chuẩn,sau khi chọn xong thì nó sẽ sắp xếp dựa vào text chuẩn này.Chân thành cảm ơn trước.
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=205&st=2160
(defun c:st1 ( / oldos lst1 ss ki ki0 ki1 ki2 lst ddau dcuoi eget)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)

(prompt "Chon 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) ("M" 4 0)
("TL" 0 3) ("TC" 1 3) ("TR" 2 3)
("ML" 0 2) ("MC" 1 2) ("MR" 2 2)
("BL" 0 1) ("BC" 1 1) ("BR" 2 1)))

(initget 1 "C L M R TL TC TR ML MC MR BL BC BR")
(setq ki (getkword "Enter an option [Center/Left/Middle/Right/TL/TC/TR/ML/MC/MR/BL/BC/BR]:")
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))))))
vt (cdr (assoc 10 (entget (car lst))))
yht (cadr vt)
linespc (* (cdr (assoc 40 (entget (car lst)))) tyledong)
)

(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)
)

  • 0

#2 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 10 July 2011 - 04:07 PM

Mình thấy trên diễn đàn có 1 lisp sắp xếp text rất hay nhưng mình sử dụng thì không cần nhiều chức năng như trong lisp nên nhờ các bác sửa lại giùm e như sau:
Sau khi nhập khoảng cách dòng thì chỉ cần 3 lựa chọn LEFT,RIGHT,CENTER,Sau khi lựa chọn xong thì thêm chức năng chọn text chuẩn,sau khi chọn xong thì nó sẽ sắp xếp dựa vào text chuẩn này.Chân thành cảm ơn trước.

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=205&st=2160
(defun c:st1 ( / oldos lst1 ss ki ki0 ki1 ki2 lst ddau dcuoi eget)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)

(prompt "Chon 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) ("M" 4 0)
("TL" 0 3) ("TC" 1 3) ("TR" 2 3)
("ML" 0 2) ("MC" 1 2) ("MR" 2 2)
("BL" 0 1) ("BC" 1 1) ("BR" 2 1)))

(initget 1 "C L M R TL TC TR ML MC MR BL BC BR")
(setq ki (getkword "Enter an option [Center/Left/Middle/Right/TL/TC/TR/ML/MC/MR/BL/BC/BR]:")
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))))))
vt (cdr (assoc 10 (entget (car lst))))
yht (cadr vt)
linespc (* (cdr (assoc 40 (entget (car lst)))) tyledong)
)

(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)
)

Bạn sửa lại như sau xem có ưng cái bụng không.

(defun c:st1 ( / 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]: "))
(prompt "Chon Text chuan: ")
(setq vt (cdr (assoc 10 (entget (car (entsel))))))
(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))))))
; vt (cdr (assoc 10 (entget (car lst))))
yht (cadr vt)
linespc (* (cdr (assoc 40 (entget (car lst)))) tyledong))
(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))

  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#3 hugo75

hugo75

    biết vẽ polygon

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

Đã gửi 10 July 2011 - 04:25 PM

Cơ bản là được nhưng mình muốn khi chọn text chuẩn thì text này đứng yên tại vị trí ban đầu mấy text kia sẽ sắp xếp theo text chuẩn,tiện thể bạn sửa giùm khi hiện dòng kêu chọn text chuẩn từ SELECT OBJECT thành CHỌN TEXT CHUẨN giùm mình luôn nhe.Thanks.
  • 0

#4 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 10 July 2011 - 04:36 PM

Cơ bản là được nhưng mình muốn khi chọn text chuẩn thì text này đứng yên tại vị trí ban đầu mấy text kia sẽ sắp xếp theo text chuẩn,tiện thể bạn sửa giùm khi hiện dòng kêu chọn text chuẩn từ SELECT OBJECT thành CHỌN TEXT CHUẨN giùm mình luôn nhe.Thanks.

Bạn nói rõ hơn chút xíu:
1. Có muốn xóa text chuẩn rồi sắp xếp bắt đầu từ đó, hay giữ text chuẩn và xem nó là thành phần thứ 1?
2. Bạn muốn canh lề theo bạn chọn hay canh lề theo text chuẩn?
Đợi bạn đây.
P/S: đợi bạn đến 5h14' mà không thấy. Tôi bận chút xíu. Nhờ các bác khác giúp vậy, thông cảm.
  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#5 hugo75

hugo75

    biết vẽ polygon

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

Đã gửi 10 July 2011 - 05:32 PM

Ý là như thế này bạn ah:Theo như lisp đầu bạn sửa là được nhưng khi chọn text chuẩn thì các text khác sẽ căn theo text chuẩn,text chuẩn đứng yên xem nó là thành phần thứ 1.Khi chọn căn trái thì các text khác căn trái theo text chuẩn....Thanks.
  • 0

#6 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 10 July 2011 - 06:00 PM

Bác ĐVH hãy sửa luôn text đầu (ssname 0) làm text chuẩn thì sẽ nhanh hơn 1 thao tác :)
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#7 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 10 July 2011 - 09:21 PM

khi chọn text chuẩn thì các text khác sẽ căn theo text chuẩn,text chuẩn đứng yên xem nó là thành phần thứ 1.Khi chọn căn trái thì các text khác căn trái theo text chuẩn....Thanks.

Hơi khó hiểu bạn ạ!
Text chuẩn đứng yên (VD: nó đang căn phải) nhưng các text khác căn trái theo text chuẩn? Vậy text chuẩn có căn trái luôn không? Các y/c của bạn và đề nghị của Ketxu đều làm được, nhưng tôi chưa hiểu rõ ràng. Mong bạn giải thích thêm.
@Ketxu: thực ra, sửa 1 lsp của người khác là không nên và thường vất vả. Tôi chỉ sửa theo y/c chứ không đụng đến ý tưởng của tác giả, thành ra có nhiều vấn đề để bàn. Cám ơn góp ý của Ketxu!
  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#8 hugo75

hugo75

    biết vẽ polygon

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

Đã gửi 11 July 2011 - 07:05 AM

Ví dụ có nhiều dòng text nằm ở vị trí khác nhau,nếu chọn text nào làm chuẩn thì tất cả các text khác sẽ căn theo text chuẩn LEFT,RIGHT,CENTER text chuẩn không cần căn trái mà chỉ đứng yên các text khác căn theo nằm bên trái,phải giữa của text chuẩn.Thanks.
  • 0

#9 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 11 July 2011 - 09:00 AM

...tất cả các text khác sẽ căn theo text chuẩn LEFT,RIGHT,CENTER. text chuẩn không cần căn trái mà chỉ đứng yên các text khác căn theo nằm bên trái,phải giữa của text chuẩn.Thanks.

Hỏi thêm 1 chút nữa cho chắc: bạn nói tất cả các text khác sẽ căn lề theo text chuẩn thì cần gì phải nhập kiểu căn lề của các text khác, vì text chuẩn đã có kiểu căn lề rồi? Còn nếu chọn 1 kiểu căn lề khác thì text chuẩn cũng bị nhảy theo chứ sao đứng yên được?
  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#10 hugo75

hugo75

    biết vẽ polygon

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

Đã gửi 11 July 2011 - 09:13 AM

Các text khác sẽ căn theo text chuẩn vì các text đang nằm ở nhiều vị trí khác nhau,nếu chọn left thì tất cả text sẽ nằm phía trái text chuẩn,phải thì nằm phía phải text chuẩn,giữa thì tương tự.
Nếu chọn text này ĐFSGFSGFGSGGAG là chuẩn thì nếu chọn căn left thì các text khác sẽ sắp như sau:
ĐFSGFSGFGSGGAG
dfsfđfsf
25245tuuuyt
còn căn RIGHT thì:

ĐFSGFSGFGSGGAG
dfsfđfsf
25245tuuuyt

Căn giữa thì:

ĐFSGFSGFGSGGAG
dfsfđfsf
25245tuuuyt

Ý là vậy nhưng do trên này không căn được nên căn phải và giữa thì text chuẩn vẫn nằm yên giống căn trái ở trên.Cảm ơn bạn.
  • 0

#11 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 11 July 2011 - 09:25 AM

Theo đề nghị của Ketxu, tôi chọn luôn text trên cùng làm text chuẩn để đỡ 1 thao tác nhé.

(defun c:st1 ( / 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 vt (cdr (assoc 10 (entget (car (entsel "Chon Text chuan: "))))))
(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))))))
vt (cdr (assoc 11 (entget (car lst))))
yht (+ linespc (cadr vt))
linespc (* (cdr (assoc 40 (entget (car lst)))) tyledong))
(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))

  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#12 hugo75

hugo75

    biết vẽ polygon

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

Đã gửi 11 July 2011 - 09:30 AM

Vậy nếu cần text dưới làm chuẩn thì sao bác?
  • 0

#13 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 11 July 2011 - 09:40 AM

Vậy nếu cần text dưới làm chuẩn thì sao bác?

Bác ĐVH hiểu nhầm ý mình rồi, Text đầu tiên trong tập chọn trước khi sắp xếp cơ. Như vậy, để lấy text dưới cùng làm chuẩn thì kích 1 phát vào thằng dưới cùng, rồi lại chọn tiếp như thường
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#14 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 11 July 2011 - 01:51 PM

Vậy nếu cần text dưới làm chuẩn thì sao bác?

Hy vọng cái này đúng ý của bạn: Sắp xếp các dòng text cách đều nhau, theo 1 kiểu canh lề, lấy text gốc làm chuẩn.

;Sap xep cac dong text deu nhau theo 1 kieu canh le, lay text goc lam chuan.
(defun c:st1 ( / 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))

  • 3

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#15 intelligent

intelligent

    biết vẽ circle

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

Đã gửi 30 November 2013 - 07:26 PM

em làm thử  rồi thấy rất hay, nhưng cấu trúc lệnh là ST1 hơi dài các anh có thể rút ngắn hơn được ko? cảm ơn các anh đã chia sẻ để em biết mình thật nhỏ bé!


  • -1

#16 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 30 November 2013 - 09:34 PM

em làm thử  rồi thấy rất hay, nhưng cấu trúc lệnh là ST1 hơi dài các anh có thể rút ngắn hơn được ko? cảm ơn các anh đã chia sẻ để em biết mình thật nhỏ bé!

Thấy ST1 là dài thì bạn có thể sửa theo tùy thích. Bằng cách mở lisp ra và:

1). Tìm và thay ST1 bằng OBAMA. Cách này dùng để khoe với mọi người là "dù tao gọi tổng thống Mỹ nhưng lisp vẫn hiểu".

2). Tìm và thay ST1 bằng chỉ 1 chữ A, B, C.... Cách này kết quả không đoán được.

3). Tìm và thay ST1 bằng 1 ký tự trống, tức là khỏi nhập lệnh mà lisp vẫn hiểu. Cách này hậu quả thấy ngay.


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#17 nhatphong

nhatphong

    biết vẽ circle

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

Đã gửi 02 April 2014 - 08:09 AM

cho mình hỏi khi mình sửa lại nội dung thành Mtext để căn chỉnh thì vẫn chỉnh được theo lisp trên,sao nó lại nhẩy vị trí mà kg đứng yên

Nhờ các bác sửa lại cho nó đứng yên tại vị trí được không ? thank các bác :D

;Sap xep cac dong text deu nhau theo 1 kieu canh le, lay mtext goc lam chuan.
(defun c:clmt ( / oldos lst1 ss ki ki0 ki1 ki2 lst ddau dcuoi eget)
  (setq oldos (getvar "osmode")) (setvar "osmode" 0)
  (prompt "Chon nhom MText can chinh: ")
  (setq ss (ssget '((0 . "MTEXT"))))
  (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 MText 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")


  • 0

#18 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 02 April 2014 - 10:57 AM

Hề hề hề,

cho mình hỏi khi mình sửa lại nội dung thành Mtext để căn chỉnh thì vẫn chỉnh được theo lisp trên,sao nó lại nhẩy vị trí mà kg đứng yên

Nhờ các bác sửa lại cho nó đứng yên tại vị trí được không ? thank các bác :D

Bởi vì mã dxf của text và mtext là khác nhau. Mã dxf 72 của text chỉ vệc căn text theo phương ngang so với điểm chèn. còn của mtext chỉ hướng viết text. Với text thì mã dxf 11 chỉ điểm chèn của text khi mã dxf 72 hoặc 73 khác 0, còn với mtext thì mã dxf 11 không phải là điểm chèn text nữa mà là 1 trong các véc tơ chỉ hướng của text. Với mtext thì điểm chèn text luôn là mã dxf 10 bất kể giá trị của các mã dxf 72, 73.

Bạn hãy xem lại các mã dxf này của text và mtext rồi hiệu chỉnh vào lisp. Vì bạn đã biết chút chút về lisp nên hãy tự làm xem sao nhé. Không quá khó đâu chỉ cần bạn hiểu rõ cấu trúc mã dxf của mtext là được.

Chúc thành công.


  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.