Chuyển đến nội dung
Diễn đàn CADViet
congvan

NHỜ VIẾT KIỂM TRA CHỈNH SỬA LISP TẠO KHUNG CHO TEXT

Các bài được khuyến nghị

Mình có 1 autolisp tạo khung cho text:

Nhưng khi sử dụng cho text là tiếng việt thì bị lỗi font, và không sử dung cho Mtext được.

Nhờ mọi người kiểm tra và sửa giúp mình.

Cảm ơn mọi người đã xem qua và hỗ trợ

Nội dung Autolisp:

 


(defun c:T2T ( / pt1 numrows numcolumns rowheight colwidth ent doc curspace obj objtable col) 
(vl-load-com)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(setq curspace (vla-get-modelspace doc))
; now do table 
(setq pt1 (vlax-3d-point (getpoint "\nChon diem cho phia tren ben trai cua bang:  ")))
(setq numcolumns (getint "Co bao nhieu cot:"))
(setq txtsz (getreal "Chieu cao text:"))

(setq numrows 2)
(setq rowheight (* 1.5 txtsz))
(setq colwidth (* 10 txtsz))
(setq objtable (vla-addtable curspace pt1 numrows numcolumns rowheight colwidth))
(vla-settext objtable 0 0 "TABLE")
(setq x 1)
(repeat numcolumns
    (vla-settext objtable 1 (- x 1) (strcat "COLUMN " (rtos x 2 0)))
    (setq x (+ x 1))
)

(setq objtable (vlax-ename->vla-object (entlast)))
(vla-InsertRows objtable numrows txtsz 1)
(setq col 0)
(while (setq ent  (entsel "Chon Text:"))
    (setq obj (vlax-ename->vla-object (car ent)))
    (if (= (vla-get-objectname obj) "AcDbText")
        (progn
            (vla-settext objtable numrows col  (vla-get-textstring obj))
            (setq col (+ col 1))
            (if (= col numcolumns)
                (progn
                (setq col 0)
                (setq numrows (+ numrows 1))
                (vla-InsertRows objtable numrows (* txtsz 1.5) 1)
                )
            )
        )
    )
)
(vla-SetTextHeight objtable (+ acDataRow acHeaderRow acTitleRow) txtsz)
(vla-SetAlignment objtable acDataRow acMiddleCenter)
(vlax-release-object objtable)
(princ)
)

(c:T2T)

 

Tao khung cho text (T2T).lsp

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
24 phút trước, congvan đã nói:

Mình có 1 autolisp tạo khung cho text:

Nhưng khi sử dụng cho text là tiếng việt thì bị lỗi font, và không sử dung cho Mtext được.

Nhờ mọi người kiểm tra và sửa giúp mình.

Cảm ơn mọi người đã xem qua và hỗ trợ

Nội dung Autolisp:

 


(defun c:T2T ( / pt1 numrows numcolumns rowheight colwidth ent doc curspace obj objtable col) 
(vl-load-com)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(setq curspace (vla-get-modelspace doc))
; now do table 
(setq pt1 (vlax-3d-point (getpoint "\nChon diem cho phia tren ben trai cua bang:  ")))
(setq numcolumns (getint "Co bao nhieu cot:"))
(setq txtsz (getreal "Chieu cao text:"))

(setq numrows 2)
(setq rowheight (* 1.5 txtsz))
(setq colwidth (* 10 txtsz))
(setq objtable (vla-addtable curspace pt1 numrows numcolumns rowheight colwidth))
(vla-settext objtable 0 0 "TABLE")
(setq x 1)
(repeat numcolumns
    (vla-settext objtable 1 (- x 1) (strcat "COLUMN " (rtos x 2 0)))
    (setq x (+ x 1))
)

(setq objtable (vlax-ename->vla-object (entlast)))
(vla-InsertRows objtable numrows txtsz 1)
(setq col 0)
(while (setq ent  (entsel "Chon Text:"))
    (setq obj (vlax-ename->vla-object (car ent)))
    (if (= (vla-get-objectname obj) "AcDbText")
        (progn
            (vla-settext objtable numrows col  (vla-get-textstring obj))
            (setq col (+ col 1))
            (if (= col numcolumns)
                (progn
                (setq col 0)
                (setq numrows (+ numrows 1))
                (vla-InsertRows objtable numrows (* txtsz 1.5) 1)
                )
            )
        )
    )
)
(vla-SetTextHeight objtable (+ acDataRow acHeaderRow acTitleRow) txtsz)
(vla-SetAlignment objtable acDataRow acMiddleCenter)
(vlax-release-object objtable)
(princ)
)

(c:T2T)

 

Tao khung cho text (T2T).lsp

Sửa chỗ bôi xanh thành: (wcmatch (vla-get-objectname obj) "*Text")

Sửa chỗ bôi đỏ thành: (cdr (assoc 1 (entget (Car ent)))) 

là oke nhé

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Cảm ơn anh Đoàn Nguyễn Văn

Mình đã sửa và chạy rất tốt


(defun c:T2T ( / pt1 numrows numcolumns rowheight colwidth ent doc curspace obj objtable col) 
(vl-load-com)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(setq curspace (vla-get-modelspace doc))
; now do table 
(setq pt1 (vlax-3d-point (getpoint "\nChon diem cho phia tren ben trai cua bang:  ")))
(setq numcolumns (getint "Co bao nhieu cot:"))
(setq txtsz (getreal "Chieu cao text:"))

(setq numrows 2)
(setq rowheight (* 1.5 txtsz))
(setq colwidth (* 10 txtsz))
(setq objtable (vla-addtable curspace pt1 numrows numcolumns rowheight colwidth))
(vla-settext objtable 0 0 "TABLE")
(setq x 1)
(repeat numcolumns
    (vla-settext objtable 1 (- x 1) (strcat "COLUMN " (rtos x 2 0)))
    (setq x (+ x 1))
)

(setq objtable (vlax-ename->vla-object (entlast)))
(vla-InsertRows objtable numrows txtsz 1)
(setq col 0)
(while (setq ent  (entsel "Chon Text:"))
    (setq obj (vlax-ename->vla-object (car ent)))
    (if (wcmatch (vla-get-objectname obj) "*Text")
        (progn
            (vla-settext objtable numrows col  (cdr (assoc 1 (entget (car ent)))))
            (setq col (+ col 1))
            (if (= col numcolumns)
                (progn
                (setq col 0)
                (setq numrows (+ numrows 1))
                (vla-InsertRows objtable numrows (* txtsz 1.5) 1)
                )
            )
        )
    )
)
(vla-SetTextHeight objtable (+ acDataRow acHeaderRow acTitleRow) txtsz)
(vla-SetAlignment objtable acDataRow acMiddleCenter)
(vlax-release-object objtable)
(princ)
)

(c:T2T)

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

×