Text ghi chú kích thước đa giác

[NgọcH 1]

E chào mọi người. Nhờ các cao nhân giúp đỡ lisp.

Có các đa giác là pline kín. E muốn ghi được text kích thước như trong ảnh thì có cách nào ko ạ, kích thước là chiều dài dim đoạn thằng lớn nhất của đa giác

Text xoay theo chiều cạnh dài

Kiểu text là layer là layer hiện hành, chiều cao chữ chọn 1 lần đầu tiên.

Và có thể quét chọn 1 lần nhiều đa giác được ko.

E cảm ơn ạ.

 

[NTHAHT 124]

2 giờ trước, NgọcH đã nói:

E chào mọi người. Nhờ các cao nhân giúp đỡ lisp.

Có các đa giác là pline kín. E muốn ghi được text kích thước như trong ảnh thì có cách nào ko ạ, kích thước là chiều dài dim đoạn thằng lớn nhất của đa giác

Text xoay theo chiều cạnh dài

Kiểu text là layer là layer hiện hành, chiều cao chữ chọn 1 lần đầu tiên.

Và có thể quét chọn 1 lần nhiều đa giác được ko.

E cảm ơn ạ.

Có vẻ như đây là chọn kích thước tấm nhỏ nhất kể cắt được như hình, vậy thì đoạn chữ tô màu diễn giải không chính xác. Xem hình thứ 2 và cuối ở cột bên trái thì sẽ thấy rõ.

[conghoa 141]

Đoạn đó bị thừa thôi, mục đích là viết lại giá trị dim Rộng x Dài vào trong hình.

[cuongtk2 500]

Trong Lee-Mac cũng có  hàm (LM:minboundingbox sel tol) để lấy vùng bao tối thiểu cho tập hợp. Bằng cách rotate liên tục theo tol + 0->pi để tính bound có diện tích nhỏ nhất. 

[NgọcH 1]

18 giờ trước, NTHAHT đã nói:

Có vẻ như đây là chọn kích thước tấm nhỏ nhất kể cắt được như hình, vậy thì đoạn chữ tô màu diễn giải không chính xác. Xem hình thứ 2 và cuối ở cột bên trái thì sẽ thấy rõ.

e muốn xuất ra đường bao kích thước 2 cạnh lớn nhất thôi ah

[NgọcH 1]

cảm ơn a nhưng e ko biết xuất ra text như trên yêu cầu như nào ah với lại e xem thì nó vẽ luôn đường bao nhưng e ko muốn có đường bao chỉ xuất text thôi. a có thể giúp e không ạ

15 giờ trước, cuongtk2 đã nói:

Trong Lee-Mac cũng có  hàm (LM:minboundingbox sel tol) để lấy vùng bao tối thiểu cho tập hợp. Bằng cách rotate liên tục theo tol + 0->pi để tính bound có diện tích nhỏ nhất. 

 

[NgọcH 1]

 

16 giờ trước, conghoa đã nói:

Đoạn đó bị thừa thôi, mục đích là viết lại giá trị dim Rộng x Dài vào trong hình.

đúng rồi giống như a Cường nói ạ. chỉ là e không biết viết hàm này cho nó ra theo nhu cầu như nào

[cuongtk2 500]

DimMinBox.zip Netload, Dùng lệnh đó luôn.

[NgọcH 1]

9 phút trước, cuongtk2 đã nói:

DimMinBox.zip Netload, Dùng lệnh đó luôn.

e muốn xuất ra text như hình cớ chứ ko phải dim a ah

 

[conghoa 141]

;; Minimum Bounding Box  -  Lee Mac (modified)
(defun LM:minboundingbox ( sel tol / ang box bx1 bx2 cen idx lst obj rtn wid len pts edges)
    (if (and sel (< 0.0 tol 1.0))
        (progn
            (repeat (setq idx (sslength sel))
                (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
                (if (and (vlax-method-applicable-p obj 'getboundingbox)
                         (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'a 'b))))
                    )
                    (setq lst (cons (vla-copy obj) lst))
                )
            )
            (if lst
                (progn
                    (setq box (LM:objlstboundingbox lst)
                          tol (* tol pi)
                          cen (apply 'mapcar (cons '(lambda ( a b ) (/ (+ a b) 2.0)) box))
                          bx1 (* (- (caadr box) (caar box)) (- (cadadr box) (cadar box)))
                          rtn (list 0.0 box)
                          ang 0.0
                    )
                    (while (< (setq ang (+ ang tol)) pi)
                        (foreach obj lst (vlax-invoke obj 'rotate cen tol))
                        (setq box (LM:objlstboundingbox lst)
                              bx2 (* (- (caadr box) (caar box)) (- (cadadr box) (cadar box)))
                        )
                        (if (< bx2 bx1)
                            (setq bx1 bx2
                                  rtn (list ang box))
                        )
                    )
                    (foreach obj lst (vla-delete obj))
                    (setq pts (LM:rotatepoints
                                (mapcar '(lambda ( a ) (mapcar '(lambda ( b ) (apply b (cdr rtn))) a))
                                    '(
                                        (caar   cadar)
                                        (caadr  cadar)
                                        (caadr cadadr)
                                        (caar  cadadr)
                                    )
                                )
                                cen (- (car rtn))
                              )
                    )
                    (setq edges (list
                                    (distance (nth 0 pts) (nth 1 pts))
                                    (distance (nth 1 pts) (nth 2 pts))
                                    (distance (nth 2 pts) (nth 3 pts))
                                    (distance (nth 3 pts) (nth 0 pts))
                                )
                    )
                    (setq len (apply 'max edges))
                    (setq wid (apply 'min edges))
                    (list pts len wid)
                )
            )
        )
    )
)

;; Object List Bounding Box  -  Lee Mac
(defun LM:objlstboundingbox ( lst / llp ls1 ls2 urp )
    (foreach obj lst
        (vla-getboundingbox obj 'llp 'urp)
        (setq ls1 (cons (vlax-safearray->list llp) ls1)
              ls2 (cons (vlax-safearray->list urp) ls2)
        )
    )
    (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2))
)

;; Rotate Points  -  Lee Mac
(defun LM:rotatepoints ( lst bpt ang / mat vec )
    (setq mat
        (list
            (list (cos ang) (sin (- ang)) 0.0)
            (list (sin ang) (cos ang)     0.0)
           '(0.0 0.0 1.0)
        )
    )
    (setq vec (mapcar '- bpt (mxv mat bpt)))
    (mapcar '(lambda ( x ) (mapcar '+ (mxv mat x) vec)) lst)
)

;; Matrix x Vector - Vladimir Nesterovsky
(defun mxv ( m v )
    (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

(defun C:Test (/ sel plines text txtstyle txtheight i pline cen result len wid txtdim pts edge1 edge2 long_edge text_angle box_ents)
    (vl-load-com)
    (setvar "CMDECHO" 0) ; Tat echo lenh

    (princ "\nChon nhieu Pline kin de tinh bounding box va ghi kich thuoc: ")
    (if (setq plines (ssget '((0 . "LWPOLYLINE") (70 . 1))))
        (progn
            (princ "\nChon text mau de lay kieu chu va chieu cao: ")
            (while (not (setq text (ssget ":S" '((0 . "TEXT")))))
                (princ "\nVui long chon mot doi tuong Text!"))

            (setq text (ssname text 0))
            (setq text_obj (vlax-ename->vla-object text))
            (setq txtstyle (vla-get-StyleName text_obj))
            (setq txtheight (vla-get-Height text_obj))
            (setvar "TEXTSTYLE" txtstyle)

            (setq box_ents '())
            (setq i 0)
            (repeat (sslength plines)
                (setq pline (ssname plines i))
                (setq sel (ssadd))
                (ssadd pline sel)

                (setq result (LM:minboundingbox sel 0.01))
                (if result
                    (progn
                        (setq pts (car result))
                        (setq len (cadr result))
                        (setq wid (caddr result))

                        (vla-GetBoundingBox (vlax-ename->vla-object pline) 'minpt 'maxpt)
                        (setq cen (mapcar '/
                                        (mapcar '+ (vlax-safearray->list minpt) (vlax-safearray->list maxpt))
                                        '(2 2 2)))

                        ; Xac dinh canh dai nhat va tinh goc nghieng, dong bo voi len va wid
                        (setq edge1 (distance (nth 0 pts) (nth 1 pts)))
                        (setq edge2 (distance (nth 1 pts) (nth 2 pts)))
                        (if (> edge1 edge2)
                            (progn
                                (setq long_edge (list (nth 0 pts) (nth 1 pts)))
                                (setq text_angle (angle (nth 0 pts) (nth 1 pts)))
                                (setq len edge1 wid edge2)
                            )
                            (progn
                                (setq long_edge (list (nth 1 pts) (nth 2 pts)))
                                (setq text_angle (angle (nth 1 pts) (nth 2 pts)))
                                (setq len edge2 wid edge1)
                            )
                        )

                        ; Dieu chinh goc text de khong bi nguoc
                        (cond
                            ((and (> text_angle (/ pi 2)) (<= text_angle (* pi 1.5))) ; 90° den 270°
                             (setq text_angle (- text_angle pi))) ; Giam 180°
                            ((> text_angle (* pi 1.5)) ; > 270°
                             (setq text_angle (- text_angle (* 2 pi)))) ; Giam 360° de ve khoang -90° den 90°
                            ((< text_angle (- (/ pi 2))) ; < -90°
                             (setq text_angle (+ text_angle pi))) ; Cong 180°
                        )

                        (setq txtdim (strcat (rtos wid 2 2) "x" (rtos len 2 2)))
                        (command "_TEXT" "_J" "_MC" cen txtheight (* 180 (/ text_angle pi)) txtdim)

                        (entmake
                            (append
                               '(
                                    (000 . "LWPOLYLINE")
                                    (100 . "AcDbEntity")
                                    (100 . "AcDbPolyline")
                                    (090 . 4)
                                    (070 . 1)
                                )
                                (mapcar '(lambda ( p ) (cons 10 p)) pts)
                            )
                        )
                        (setq box_ents (cons (entlast) box_ents))
                    )
                    (princ (strcat "\nKhong the tinh bounding box cho Pline thu " (itoa (1+ i)) "."))
                )
                (setq i (1+ i))
            )

            (foreach ent box_ents
                (if (entget ent) (entdel ent))
            )
            (princ "\nDa ghi kich thuoc vao cac Pline va xoa bounding box!")
        )
        (princ "\nKhong co Pline kin nao duoc chon.")
    )
    (setvar "CMDECHO" 1)
    (princ)
)
(vl-load-com) (princ)

AI kết hợp với leemac, Bạn dùng thử, lưu ý là code của Lee cũng đang bị trường hợp khi cùng 1 hình với các góc xoay khác nhau thì lại ra kết quả khác nhau chút ít.

Tên lệnh là : Test

[NgọcH 1]

1 giờ} trướ}c, conghoa đã nói:

;; Minimum Bounding Box  -  Lee Mac (modified)
(defun LM:minboundingbox ( sel tol / ang box bx1 bx2 cen idx lst obj rtn wid len pts edges)
    (if (and sel (< 0.0 tol 1.0))
        (progn
            (repeat (setq idx (sslength sel))
                (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
                (if (and (vlax-method-applicable-p obj 'getboundingbox)
                         (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'a 'b))))
                    )
                    (setq lst (cons (vla-copy obj) lst))
                )
            )
            (if lst
                (progn
                    (setq box (LM:objlstboundingbox lst)
                          tol (* tol pi)
                          cen (apply 'mapcar (cons '(lambda ( a b ) (/ (+ a b) 2.0)) box))
                          bx1 (* (- (caadr box) (caar box)) (- (cadadr box) (cadar box)))
                          rtn (list 0.0 box)
                          ang 0.0
                    )
                    (while (< (setq ang (+ ang tol)) pi)
                        (foreach obj lst (vlax-invoke obj 'rotate cen tol))
                        (setq box (LM:objlstboundingbox lst)
                              bx2 (* (- (caadr box) (caar box)) (- (cadadr box) (cadar box)))
                        )
                        (if (< bx2 bx1)
                            (setq bx1 bx2
                                  rtn (list ang box))
                        )
                    )
                    (foreach obj lst (vla-delete obj))
                    (setq pts (LM:rotatepoints
                                (mapcar '(lambda ( a ) (mapcar '(lambda ( b ) (apply b (cdr rtn))) a))
                                    '(
                                        (caar   cadar)
                                        (caadr  cadar)
                                        (caadr cadadr)
                                        (caar  cadadr)
                                    )
                                )
                                cen (- (car rtn))
                              )
                    )
                    (setq edges (list
                                    (distance (nth 0 pts) (nth 1 pts))
                                    (distance (nth 1 pts) (nth 2 pts))
                                    (distance (nth 2 pts) (nth 3 pts))
                                    (distance (nth 3 pts) (nth 0 pts))
                                )
                    )
                    (setq len (apply 'max edges))
                    (setq wid (apply 'min edges))
                    (list pts len wid)
                )
            )
        )
    )
)

;; Object List Bounding Box  -  Lee Mac
(defun LM:objlstboundingbox ( lst / llp ls1 ls2 urp )
    (foreach obj lst
        (vla-getboundingbox obj 'llp 'urp)
        (setq ls1 (cons (vlax-safearray->list llp) ls1)
              ls2 (cons (vlax-safearray->list urp) ls2)
        )
    )
    (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2))
)

;; Rotate Points  -  Lee Mac
(defun LM:rotatepoints ( lst bpt ang / mat vec )
    (setq mat
        (list
            (list (cos ang) (sin (- ang)) 0.0)
            (list (sin ang) (cos ang)     0.0)
           '(0.0 0.0 1.0)
        )
    )
    (setq vec (mapcar '- bpt (mxv mat bpt)))
    (mapcar '(lambda ( x ) (mapcar '+ (mxv mat x) vec)) lst)
)

;; Matrix x Vector - Vladimir Nesterovsky
(defun mxv ( m v )
    (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

(defun C:Test (/ sel plines text txtstyle txtheight i pline cen result len wid txtdim pts edge1 edge2 long_edge text_angle box_ents)
    (vl-load-com)
    (setvar "CMDECHO" 0) ; Tat echo lenh

    (princ "\nChon nhieu Pline kin de tinh bounding box va ghi kich thuoc: ")
    (if (setq plines (ssget '((0 . "LWPOLYLINE") (70 . 1))))
        (progn
            (princ "\nChon text mau de lay kieu chu va chieu cao: ")
            (while (not (setq text (ssget ":S" '((0 . "TEXT")))))
                (princ "\nVui long chon mot doi tuong Text!"))

            (setq text (ssname text 0))
            (setq text_obj (vlax-ename->vla-object text))
            (setq txtstyle (vla-get-StyleName text_obj))
            (setq txtheight (vla-get-Height text_obj))
            (setvar "TEXTSTYLE" txtstyle)

            (setq box_ents '())
            (setq i 0)
            (repeat (sslength plines)
                (setq pline (ssname plines i))
                (setq sel (ssadd))
                (ssadd pline sel)

                (setq result (LM:minboundingbox sel 0.01))
                (if result
                    (progn
                        (setq pts (car result))
                        (setq len (cadr result))
                        (setq wid (caddr result))

                        (vla-GetBoundingBox (vlax-ename->vla-object pline) 'minpt 'maxpt)
                        (setq cen (mapcar '/
                                        (mapcar '+ (vlax-safearray->list minpt) (vlax-safearray->list maxpt))
                                        '(2 2 2)))

                        ; Xac dinh canh dai nhat va tinh goc nghieng, dong bo voi len va wid
                        (setq edge1 (distance (nth 0 pts) (nth 1 pts)))
                        (setq edge2 (distance (nth 1 pts) (nth 2 pts)))
                        (if (> edge1 edge2)
                            (progn
                                (setq long_edge (list (nth 0 pts) (nth 1 pts)))
                                (setq text_angle (angle (nth 0 pts) (nth 1 pts)))
                                (setq len edge1 wid edge2)
                            )
                            (progn
                                (setq long_edge (list (nth 1 pts) (nth 2 pts)))
                                (setq text_angle (angle (nth 1 pts) (nth 2 pts)))
                                (setq len edge2 wid edge1)
                            )
                        )

                        ; Dieu chinh goc text de khong bi nguoc
                        (cond
                            ((and (> text_angle (/ pi 2)) (<= text_angle (* pi 1.5))) ; 90° den 270°
                             (setq text_angle (- text_angle pi))) ; Giam 180°
                            ((> text_angle (* pi 1.5)) ; > 270°
                             (setq text_angle (- text_angle (* 2 pi)))) ; Giam 360° de ve khoang -90° den 90°
                            ((< text_angle (- (/ pi 2))) ; < -90°
                             (setq text_angle (+ text_angle pi))) ; Cong 180°
                        )

                        (setq txtdim (strcat (rtos wid 2 2) "x" (rtos len 2 2)))
                        (command "_TEXT" "_J" "_MC" cen txtheight (* 180 (/ text_angle pi)) txtdim)

                        (entmake
                            (append
                               '(
                                    (000 . "LWPOLYLINE")
                                    (100 . "AcDbEntity")
                                    (100 . "AcDbPolyline")
                                    (090 . 4)
                                    (070 . 1)
                                )
                                (mapcar '(lambda ( p ) (cons 10 p)) pts)
                            )
                        )
                        (setq box_ents (cons (entlast) box_ents))
                    )
                    (princ (strcat "\nKhong the tinh bounding box cho Pline thu " (itoa (1+ i)) "."))
                )
                (setq i (1+ i))
            )

            (foreach ent box_ents
                (if (entget ent) (entdel ent))
            )
            (princ "\nDa ghi kich thuoc vao cac Pline va xoa bounding box!")
        )
        (princ "\nKhong co Pline kin nao duoc chon.")
    )
    (setvar "CMDECHO" 1)
    (princ)
)
(vl-load-com) (princ)

AI kết hợp với leemac, Bạn dùng thử, lưu ý là code của Lee cũng đang bị trường hợp khi cùng 1 hình với các góc xoay khác nhau thì lại ra kết quả khác nhau chút ít.

Tên lệnh là : Test

cảm ơn bạn lisp dùng ok nhưng có 1 vấn đề là text xuất ra layer và màu nó k giống với text mình chọn mẫu ý, bạn sửa giúp mình được không 

[conghoa 141]

;; Minimum Bounding Box  -  Lee Mac (modified)
(defun LM:minboundingbox ( sel tol / ang box bx1 bx2 cen idx lst obj rtn wid len pts edges)
    (if (and sel (< 0.0 tol 1.0))
        (progn
            (repeat (setq idx (sslength sel))
                (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
                (if (and (vlax-method-applicable-p obj 'getboundingbox)
                         (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'a 'b))))
                    )
                    (setq lst (cons (vla-copy obj) lst))
                )
            )
            (if lst
                (progn
                    (setq box (LM:objlstboundingbox lst)
                          tol (* tol pi)
                          cen (apply 'mapcar (cons '(lambda ( a b ) (/ (+ a b) 2.0)) box))
                          bx1 (* (- (caadr box) (caar box)) (- (cadadr box) (cadar box)))
                          rtn (list 0.0 box)
                          ang 0.0
                    )
                    (while (< (setq ang (+ ang tol)) pi)
                        (foreach obj lst (vlax-invoke obj 'rotate cen tol))
                        (setq box (LM:objlstboundingbox lst)
                              bx2 (* (- (caadr box) (caar box)) (- (cadadr box) (cadar box)))
                        )
                        (if (< bx2 bx1)
                            (setq bx1 bx2
                                  rtn (list ang box))
                        )
                    )
                    (foreach obj lst (vla-delete obj))
                    (setq pts (LM:rotatepoints
                                (mapcar '(lambda ( a ) (mapcar '(lambda ( b ) (apply b (cdr rtn))) a))
                                    '(
                                        (caar   cadar)
                                        (caadr  cadar)
                                        (caadr cadadr)
                                        (caar  cadadr)
                                    )
                                )
                                cen (- (car rtn))
                              )
                    )
                    (setq edges (list
                                    (distance (nth 0 pts) (nth 1 pts))
                                    (distance (nth 1 pts) (nth 2 pts))
                                    (distance (nth 2 pts) (nth 3 pts))
                                    (distance (nth 3 pts) (nth 0 pts))
                                )
                    )
                    (setq len (apply 'max edges))
                    (setq wid (apply 'min edges))
                    (list pts len wid)
                )
            )
        )
    )
)

;; Object List Bounding Box  -  Lee Mac
(defun LM:objlstboundingbox ( lst / llp ls1 ls2 urp )
    (foreach obj lst
        (vla-getboundingbox obj 'llp 'urp)
        (setq ls1 (cons (vlax-safearray->list llp) ls1)
              ls2 (cons (vlax-safearray->list urp) ls2)
        )
    )
    (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2))
)

;; Rotate Points  -  Lee Mac
(defun LM:rotatepoints ( lst bpt ang / mat vec )
    (setq mat
        (list
            (list (cos ang) (sin (- ang)) 0.0)
            (list (sin ang) (cos ang)     0.0)
           '(0.0 0.0 1.0)
        )
    )
    (setq vec (mapcar '- bpt (mxv mat bpt)))
    (mapcar '(lambda ( x ) (mapcar '+ (mxv mat x) vec)) lst)
)

;; Matrix x Vector - Vladimir Nesterovsky
(defun mxv ( m v )
    (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

(defun C:MinBoxToPline (/ sel plines text text_obj txtstyle txtheight txtlayer i pline cen result len wid txtdim pts edge1 edge2 long_edge text_angle box_ents)
    (vl-load-com)
    (setvar "CMDECHO" 0) ; Tat echo lenh

    (princ "\nChon nhieu Pline kin de tinh bounding box va ghi kich thuoc: ")
    (if (setq plines (ssget '((0 . "LWPOLYLINE") (70 . 1))))
        (progn
            (princ "\nChon text mau de lay thong so: ")
            (while (not (setq text (ssget ":S" '((0 . "TEXT")))))
                (princ "\nVui long chon mot doi tuong Text!"))

            (setq text (ssname text 0))
            (setq text_obj (vlax-ename->vla-object text))
            (setq txtstyle  (vla-get-StyleName text_obj))
            (setq txtheight (vla-get-Height text_obj))
            (setq txtlayer  (vla-get-Layer text_obj)) ; Lay layer cua text goc
            (setvar "TEXTSTYLE" txtstyle)

            (setq box_ents '())
            (setq i 0)
            (repeat (sslength plines)
                (setq pline (ssname plines i))
                (setq sel (ssadd))
                (ssadd pline sel)

                (setq result (LM:minboundingbox sel 0.01))
                (if result
                    (progn
                        (setq pts (car result))
                        (setq len (cadr result))
                        (setq wid (caddr result))

                        (vla-GetBoundingBox (vlax-ename->vla-object pline) 'minpt 'maxpt)
                        (setq cen (mapcar '/
                                        (mapcar '+ (vlax-safearray->list minpt) (vlax-safearray->list maxpt))
                                        '(2 2 2)))

                        ; Xac dinh canh dai nhat va tinh goc nghieng, dong bo voi len va wid
                        (setq edge1 (distance (nth 0 pts) (nth 1 pts)))
                        (setq edge2 (distance (nth 1 pts) (nth 2 pts)))
                        (if (> edge1 edge2)
                            (progn
                                (setq long_edge (list (nth 0 pts) (nth 1 pts)))
                                (setq text_angle (angle (nth 0 pts) (nth 1 pts)))
                                (setq len edge1 wid edge2)
                            )
                            (progn
                                (setq long_edge (list (nth 1 pts) (nth 2 pts)))
                                (setq text_angle (angle (nth 1 pts) (nth 2 pts)))
                                (setq len edge2 wid edge1)
                            )
                        )

                        ; Dieu chinh goc text de khong bi nguoc
                        (cond
                            ((and (> text_angle (/ pi 2)) (<= text_angle (* pi 1.5))) ; 90° den 270°
                             (setq text_angle (- text_angle pi))) ; Giam 180°
                            ((> text_angle (* pi 1.5)) ; > 270°
                             (setq text_angle (- text_angle (* 2 pi)))) ; Giam 360°
                            ((< text_angle (- (/ pi 2))) ; < -90°
                             (setq text_angle (+ text_angle pi))) ; Cong 180°
                        )

                        (setq txtdim (strcat (rtos wid 2 2) "x" (rtos len 2 2)))
                        (command "_TEXT" "_J" "_MC" cen txtheight (* 180 (/ text_angle pi)) txtdim)
                        ; Dat layer cua text moi giong text goc
                        (if (tblobjname "LAYER" txtlayer)
                            (command "_CHPROP" (entlast) "" "_LA" txtlayer "")
                            (princ (strcat "\nLayer '" txtlayer "' khong ton tai!"))
                        )

                        (entmake
                            (append
                               '(
                                    (000 . "LWPOLYLINE")
                                    (100 . "AcDbEntity")
                                    (100 . "AcDbPolyline")
                                    (090 . 4)
                                    (070 . 1)
                                )
                                (mapcar '(lambda ( p ) (cons 10 p)) pts)
                            )
                        )
                        (setq box_ents (cons (entlast) box_ents))
                    )
                    (princ (strcat "\nKhong the tinh bounding box cho Pline thu " (itoa (1+ i)) "."))
                )
                (setq i (1+ i))
            )

            (foreach ent box_ents
                (if (entget ent) (entdel ent))
            )
            (princ "\nDa ghi kich thuoc vao cac Pline va xoa bounding box!")
        )
        (princ "\nKhong co Pline kin nao duoc chon.")
    )
    (setvar "CMDECHO" 1)
    (princ)
)
(vl-load-com) (princ)

Bạn thử lại xem được chưa.

[NgọcH 1]

Nó lỗi luôn rùi b ơi. Với lại có cách nào để bỏ qua hình bên trong không điền kích thước không b 

52 phút trước, conghoa đã nói:

;; Minimum Bounding Box  -  Lee Mac (modified)
(defun LM:minboundingbox ( sel tol / ang box bx1 bx2 cen idx lst obj rtn wid len pts edges)
    (if (and sel (< 0.0 tol 1.0))
        (progn
            (repeat (setq idx (sslength sel))
                (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
                (if (and (vlax-method-applicable-p obj 'getboundingbox)
                         (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'a 'b))))
                    )
                    (setq lst (cons (vla-copy obj) lst))
                )
            )
            (if lst
                (progn
                    (setq box (LM:objlstboundingbox lst)
                          tol (* tol pi)
                          cen (apply 'mapcar (cons '(lambda ( a b ) (/ (+ a b) 2.0)) box))
                          bx1 (* (- (caadr box) (caar box)) (- (cadadr box) (cadar box)))
                          rtn (list 0.0 box)
                          ang 0.0
                    )
                    (while (< (setq ang (+ ang tol)) pi)
                        (foreach obj lst (vlax-invoke obj 'rotate cen tol))
                        (setq box (LM:objlstboundingbox lst)
                              bx2 (* (- (caadr box) (caar box)) (- (cadadr box) (cadar box)))
                        )
                        (if (< bx2 bx1)
                            (setq bx1 bx2
                                  rtn (list ang box))
                        )
                    )
                    (foreach obj lst (vla-delete obj))
                    (setq pts (LM:rotatepoints
                                (mapcar '(lambda ( a ) (mapcar '(lambda ( b ) (apply b (cdr rtn))) a))
                                    '(
                                        (caar   cadar)
                                        (caadr  cadar)
                                        (caadr cadadr)
                                        (caar  cadadr)
                                    )
                                )
                                cen (- (car rtn))
                              )
                    )
                    (setq edges (list
                                    (distance (nth 0 pts) (nth 1 pts))
                                    (distance (nth 1 pts) (nth 2 pts))
                                    (distance (nth 2 pts) (nth 3 pts))
                                    (distance (nth 3 pts) (nth 0 pts))
                                )
                    )
                    (setq len (apply 'max edges))
                    (setq wid (apply 'min edges))
                    (list pts len wid)
                )
            )
        )
    )
)

;; Object List Bounding Box  -  Lee Mac
(defun LM:objlstboundingbox ( lst / llp ls1 ls2 urp )
    (foreach obj lst
        (vla-getboundingbox obj 'llp 'urp)
        (setq ls1 (cons (vlax-safearray->list llp) ls1)
              ls2 (cons (vlax-safearray->list urp) ls2)
        )
    )
    (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2))
)

;; Rotate Points  -  Lee Mac
(defun LM:rotatepoints ( lst bpt ang / mat vec )
    (setq mat
        (list
            (list (cos ang) (sin (- ang)) 0.0)
            (list (sin ang) (cos ang)     0.0)
           '(0.0 0.0 1.0)
        )
    )
    (setq vec (mapcar '- bpt (mxv mat bpt)))
    (mapcar '(lambda ( x ) (mapcar '+ (mxv mat x) vec)) lst)
)

;; Matrix x Vector - Vladimir Nesterovsky
(defun mxv ( m v )
    (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

(defun C:MinBoxToPline (/ sel plines text text_obj txtstyle txtheight txtlayer i pline cen result len wid txtdim pts edge1 edge2 long_edge text_angle box_ents)
    (vl-load-com)
    (setvar "CMDECHO" 0) ; Tat echo lenh

    (princ "\nChon nhieu Pline kin de tinh bounding box va ghi kich thuoc: ")
    (if (setq plines (ssget '((0 . "LWPOLYLINE") (70 . 1))))
        (progn
            (princ "\nChon text mau de lay thong so: ")
            (while (not (setq text (ssget ":S" '((0 . "TEXT")))))
                (princ "\nVui long chon mot doi tuong Text!"))

            (setq text (ssname text 0))
            (setq text_obj (vlax-ename->vla-object text))
            (setq txtstyle  (vla-get-StyleName text_obj))
            (setq txtheight (vla-get-Height text_obj))
            (setq txtlayer  (vla-get-Layer text_obj)) ; Lay layer cua text goc
            (setvar "TEXTSTYLE" txtstyle)

            (setq box_ents '())
            (setq i 0)
            (repeat (sslength plines)
                (setq pline (ssname plines i))
                (setq sel (ssadd))
                (ssadd pline sel)

                (setq result (LM:minboundingbox sel 0.01))
                (if result
                    (progn
                        (setq pts (car result))
                        (setq len (cadr result))
                        (setq wid (caddr result))

                        (vla-GetBoundingBox (vlax-ename->vla-object pline) 'minpt 'maxpt)
                        (setq cen (mapcar '/
                                        (mapcar '+ (vlax-safearray->list minpt) (vlax-safearray->list maxpt))
                                        '(2 2 2)))

                        ; Xac dinh canh dai nhat va tinh goc nghieng, dong bo voi len va wid
                        (setq edge1 (distance (nth 0 pts) (nth 1 pts)))
                        (setq edge2 (distance (nth 1 pts) (nth 2 pts)))
                        (if (> edge1 edge2)
                            (progn
                                (setq long_edge (list (nth 0 pts) (nth 1 pts)))
                                (setq text_angle (angle (nth 0 pts) (nth 1 pts)))
                                (setq len edge1 wid edge2)
                            )
                            (progn
                                (setq long_edge (list (nth 1 pts) (nth 2 pts)))
                                (setq text_angle (angle (nth 1 pts) (nth 2 pts)))
                                (setq len edge2 wid edge1)
                            )
                        )

                        ; Dieu chinh goc text de khong bi nguoc
                        (cond
                            ((and (> text_angle (/ pi 2)) (<= text_angle (* pi 1.5))) ; 90° den 270°
                             (setq text_angle (- text_angle pi))) ; Giam 180°
                            ((> text_angle (* pi 1.5)) ; > 270°
                             (setq text_angle (- text_angle (* 2 pi)))) ; Giam 360°
                            ((< text_angle (- (/ pi 2))) ; < -90°
                             (setq text_angle (+ text_angle pi))) ; Cong 180°
                        )

                        (setq txtdim (strcat (rtos wid 2 2) "x" (rtos len 2 2)))
                        (command "_TEXT" "_J" "_MC" cen txtheight (* 180 (/ text_angle pi)) txtdim)
                        ; Dat layer cua text moi giong text goc
                        (if (tblobjname "LAYER" txtlayer)
                            (command "_CHPROP" (entlast) "" "_LA" txtlayer "")
                            (princ (strcat "\nLayer '" txtlayer "' khong ton tai!"))
                        )

                        (entmake
                            (append
                               '(
                                    (000 . "LWPOLYLINE")
                                    (100 . "AcDbEntity")
                                    (100 . "AcDbPolyline")
                                    (090 . 4)
                                    (070 . 1)
                                )
                                (mapcar '(lambda ( p ) (cons 10 p)) pts)
                            )
                        )
                        (setq box_ents (cons (entlast) box_ents))
                    )
                    (princ (strcat "\nKhong the tinh bounding box cho Pline thu " (itoa (1+ i)) "."))
                )
                (setq i (1+ i))
            )

            (foreach ent box_ents
                (if (entget ent) (entdel ent))
            )
            (princ "\nDa ghi kich thuoc vao cac Pline va xoa bounding box!")
        )
        (princ "\nKhong co Pline kin nao duoc chon.")
    )
    (setvar "CMDECHO" 1)
    (princ)
)
(vl-load-com) (princ)

Bạn thử lại xem được chưa.

 

 

[conghoa 141]

Mình xin dừng lại đây :) , AI mình cũng chỉ bảo nó làm dc như cái đầu tiên thôi :D . Chờ các cao nhân hỗ trợ

[NTHAHT 124]

Test lisp: Vẽ 1 hình chữ nhật có kích thước chính xác, ví dụ: 6000x3000, sau đó copy ra 1 hình mới, xoay hình mới này 1 góc bất kỳ, thử dùng lệnh sẽ có kết quả khác biệt giữa 2 hình.

[conghoa 141]

7 phút trước, NTHAHT đã nói:

Test lisp: Vẽ 1 hình chữ nhật có kích thước chính xác, ví dụ: 6000x3000, sau đó copy ra 1 hình mới, xoay hình mới này 1 góc bất kỳ, thử dùng lệnh sẽ có kết quả khác biệt giữa 2 hình.

Mình có ghi chú ở bên trên rồi mà :) , lisp gốc của Lee cũng bị thế

[NTHAHT 124]

Dùng tool của @cuongtk2 thì xử lý ngon, chỉ là chưa thỏa mãn nhu cầu chủ thớt.

Nhưng lại bị cái này:

[NgọcH 1]

1 giờ} trướ}c, conghoa đã nói:

Mình xin dừng lại đây :) , AI mình cũng chỉ bảo nó làm dc như cái đầu tiên thôi :D . Chờ các cao nhân hỗ trợ

cái của b dùng ngon rồi bị mỗi cái chưa đưa text về layer hiện hành với nó đang đưa cả kích thước của hình bên trong. tiếc quá

[NgọcH 1]

42 phút trước, conghoa đã nói:

Mình có ghi chú ở bên trên rồi mà :) , lisp gốc của Lee cũng bị thế

nếu đặt theo 1 phương X hoặc Y thì mình thấy nó sẽ không bị. hơi khó

[cuongtk2 500]

Đầu tiên mình cũng quay bound en tity mô phỏng lại Lee-Mac , nhưng dim bị lệch do tiêu chí dò góc theo sai số 0.01 radian (tùy đặt). Với pline gồm các đường thẳng thì dùng cái này. Đã sửa lại code, lệnh vẫn thế.

DimMinBox.zip