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

LINK ĐỐI TƯỢNG CHO DIM VÀ TEXT

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

Xin chào các anh, chị trên diễn đàn cadviet.com!

Mình có vấn đề này mong các anh, chị giúp đỡ:

Ví dụ: mình có 1 đoạn thẳng được nhấn (gập) thành các cạnh có chiều dài khác nhau (Mỗi cạnh nhấn điều có dim các kích thước) và 1 text để ghi lại tổng chiều dài của các dim đó. Vần đề ở đây là mình muốn cái text này sẽ thay đổi khi chúng ta thay đổi 1 trong các dim trong các cạnh nhấn đó. Mong các anh, chị giúp đỡ, mình xin cảm ơn. Hình và file cad mình họa

HINH MINH HOA.png

FILE CAD MINH HOA.dwg

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
19 phút trước, Han Tinh đã nói:

Xin chào các anh, chị trên diễn đàn cadviet.com!

Mình có vấn đề này mong các anh, chị giúp đỡ:

Ví dụ: mình có 1 đoạn thẳng được nhấn (gập) thành các cạnh có chiều dài khác nhau (Mỗi cạnh nhấn điều có dim các kích thước) và 1 text để ghi lại tổng chiều dài của các dim đó. Vần đề ở đây là mình muốn cái text này sẽ thay đổi khi chúng ta thay đổi 1 trong các dim trong các cạnh nhấn đó. Mong các anh, chị giúp đỡ, mình xin cảm ơn. Hình và file cad mình họa

HINH MINH HOA.png

FILE CAD MINH HOA.dwg

 

Bài liên quan:
  • Viết Lisp theo yêu cầu - AutoLisp

    1 Tháng Chín 2009 ... Nếu viết lisp cho DIMENSION STYLE MANAGER thì còn các thay đổi khác thì sao. ... Mình có 1 File nền hiện trạng chứa các text cao độ, nhưng các text cao độ ... 2. lệnh quick select và lệnh filter chỉ làm việc với những đối tượng có màu là ... là đường link của lisp.http://www.cadviet.com/upfiles/3/pl2spl.lsp ...

  • [yêu cầu] Lisp thay đổi chiều cao text của dimstyle cực nhanh ...

    30 Tháng Tám 2011 ... Nếu bạn phải làm nhiều và thường xuyên động đến vấn đề này thì liên hệ trực tiếp ... lisp hdima thì ok ạ lisp hdimb sau khi thực hiện lệnh chọn đối tượng đầu tiên thì toàn bộ dim trong bản vẽ đều bị đổi ... đường link video ạ.

  • Viết lisp theo yêu cầu [phần 2] - AutoLisp - Diễn đàn ...

    2 Tháng Tám 2010 ... Có vậy mới có cái cho bạn chạy lisp, bằng không nó dễ ngoẻo lắm. ... Hoặc là đối tượng (text và các thứ linh tinh kia) là 1 block thì lấy điểm ...

  • Share-Video học Cad 2008 - File thư viện - Diễn đàn ...

    22 Tháng Năm 2009 ... Thể theo nguyện vọng và yêu cầu của anh em trên diễn đàn,tucdrom xin next tiếp ... -Video 11:Working with Text and MText ... Đã Up lại link cho bác Đầuto,bác xem có được ko nhé? ... đến nâng cao,giành cho mọi đối tượng của Cadviet từ: người mới học Cad cho đến những người biết và thành thạo Cad.

  • Viết lisp theo yêu cầu [phần 2] - AutoLisp - Diễn đàn ...

    9 Tháng 4 2011 ... day là hình boeing :link: http://www.cadviet.com/upfiles/B787_HCB.dwg ... Các anh cho e hỏi có lisp nào có thể đổi tên Block thuộc tính và khi m sửa font ... tâm quay của đối tượng là điểm chèn của text hoặc mtext đã chọn.

 

Insert Field vào Text nhé bạn 

  • 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

Bạn edit Text, chuột phải chọn Insert Field-> ở ô Formula lại insert field tiếp, chọn object dim rồi chọn measureament của nó làm giá trị cộng, cộng dần cho đến hết các dim.

Nếu bạn chưa biết vè field thì nên tìm gg trc có khá nhiều bài hướng dẫn chi tiết

  • Like 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
6 giờ trước, Doan Nguyen Van đã nói:

Bạn edit Text, chuột phải chọn Insert Field-> ở ô Formula lại insert field tiếp, chọn object dim rồi chọn measureament của nó làm giá trị cộng, cộng dần cho đến hết các dim.

Nếu bạn chưa biết vè field thì nên tìm gg trc có khá nhiều bài hướng dẫn chi tiết

Thanks bạn đã hướng dẫn, tuy nhiên sau khi làm thử thì thấy là: nó chỉ thay đổi text khi ta thay đổi chiều dài dim (phải vẽ tỉ lệ 1:1) nếu ta vẽ phi tỉ lệ thì nó không được. Bạn có thể viết giúp mình 1 lisp dùng cho trường hợp này được không vậy bạn. Gõ lệnh xong, sau đó chọn tất cả các dim rồi chọn text (hình vẽ có thể là phi tỉ lệ hoặc đúng tỉ lệ). Thanks bạn!

HINH LAM THU.png

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

@HANTINH Vẽ phi tỉ lệ là răng ^^ Edit text Dim ? Cái phi tỉ lệ của bạn là cái j ??
Quá trình bạn tham gia diễn đàn từ ngày xưa đến giờ nhận được hơi nhiều vote - thì phải. Qua mấy đợt Reset rồi miết vẫn thấy danh tiếng âm. Vậy phải xét lại xem tại sao mọi người lại đánh giá - cho mình mà viết bài cho tốt lên chứ. Tất cả các nội dung bạn đã từng đăng đều là xin lisp, nhờ fix lỗi, chưa một lần thấy tặng hoa cho người viết / fix cả, người ta nhọc lắm bạn ơi ^^

  • Like 4
  • Vote tăng 4

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
18 giờ trước, Han Tinh đã nói:

Thanks bạn đã hướng dẫn, tuy nhiên sau khi làm thử thì thấy là: nó chỉ thay đổi text khi ta thay đổi chiều dài dim (phải vẽ tỉ lệ 1:1) nếu ta vẽ phi tỉ lệ thì nó không được. Bạn có thể viết giúp mình 1 lisp dùng cho trường hợp này được không vậy bạn. Gõ lệnh xong, sau đó chọn tất cả các dim rồi chọn text (hình vẽ có thể là phi tỉ lệ hoặc đúng tỉ lệ). Thanks bạn!

 

Lisp đã có rồi mà bạn, phiền các bạn khác phải mắc công viết lại làm chi, lisp liên quan đến Field và  Formula cũng toát mồ hôi hột ra ấy chứ ^^

Bạn tham khảo video này , thay vì chọn Rectang bạn có thể chọn đối tượng là Dim

 

  • Like 2

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
5 giờ trước, Biet ve CAD đã nói:

Lisp đã có rồi mà bạn, phiền các bạn khác phải mắc công viết lại làm chi, lisp liên quan đến Field và  Formula cũng toát mồ hôi hột ra ấy chứ ^^

Bạn tham khảo video này , thay vì chọn Rectang bạn có thể chọn đối tượng là Dim

 

Thanks bạn!

Theo hướng dẫn của bạn @ Doan Nguyen Van mình cũng làm được rồi, tuy nhiên chỉ làm được với các chi tiết có kích thước thật. Trường hợp của mình là các chi tiết có các kích thước na ná nhau, do đó mình edit các kích thước này (edit dim) thì nó không được. Vậy mình nhờ các bạn giúp đỡ cho trường hợp các kích thước này bị edit.

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
12 giờ trước, Han Tinh đã nói:

Thanks bạn!

Theo hướng dẫn của bạn @ Doan Nguyen Van mình cũng làm được rồi, tuy nhiên chỉ làm được với các chi tiết có kích thước thật. Trường hợp của mình là các chi tiết có các kích thước na ná nhau, do đó mình edit các kích thước này (edit dim) thì nó không được. Vậy mình nhờ các bạn giúp đỡ cho trường hợp các kích thước này bị edit.

Lisp mình tự nhận text override của dim mà, chắc bạn chưa thử ^^

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
Vào lúc 1/4/2020 tại 13:50, Han Tinh đã nói:

Xin chào các anh, chị trên diễn đàn cadviet.com!

Mình có vấn đề này mong các anh, chị giúp đỡ:

Ví dụ: mình có 1 đoạn thẳng được nhấn (gập) thành các cạnh có chiều dài khác nhau (Mỗi cạnh nhấn điều có dim các kích thước) và 1 text để ghi lại tổng chiều dài của các dim đó. Vần đề ở đây là mình muốn cái text này sẽ thay đổi khi chúng ta thay đổi 1 trong các dim trong các cạnh nhấn đó. Mong các anh, chị giúp đỡ, mình xin cảm ơn. Hình và file cad mình họa

HINH MINH HOA.png

FILE CAD MINH HOA.dwg

Đề bài đặt ra tuy diễn tả lộn xộn, nhưng ý tưởng lạ. Lisp sẽ cộng các textdim, giá trị tổng sẽ được đưa ra 1 text cũng là field của tổng textdim này. Một trong các text dim này thay đổi thì, text tổng cũng thay đổi. Đúng là @Biet ve CADnói: đụng tới field là toát mồ hôi. Hồi giờ, mỗi 1 đối tượng sẽ có 1 field với 1 hay nhiều đối tượng khác, ở đây nhiều đối tượng sẽ gộp tạo 1 field với 1 đối tượng. Rất khó.

Hy vọng sẽ có lisp.

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
;| LISP  FIELD SUM DIMENSIONS TO A TEXT|;
(defun DXF (code en) (cdr (assoc code (entget en))))
(defun getIDobject (obj)
    (if (vlax-method-applicable-p *util* 'GetObjectIdString)
        (vla-GetObjectIdString *util* obj :vlax-false)
        (itoa (vla-get-ObjectId obj))
    )
)
(defun c:fdt (/ ApCad    ActDoc   *Model*  *util*       ssdim
                ent_T    Obj_Text tz       po       ent-lst  len      n
                Obj_DIM  str      rowtypes objTab acm prec
               )
    (vl-load-com)
    (command "undo" "be")
    (defun *error* (msg)
        (and doc (_EndUndo doc))
        (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
            (princ (strcat "\n** Error: " msg " **"))
        )
        (acet-sysvar-restore)
        (command "undo" "en")
        (princ)
    )
    (if (< (substr (getvar "ACADVER") 1 2) "15")
        (progn
            (acet-ui-message
                (strcat
                    "Lisp này ch\U+1EC9 ch\U+1EA1y \U+0111\U+01B0\U+1EE3c t\U+1EEB autoCad 2007 tr\U+1EDF lên."
                    "\nB\U+1EA1n nên nâng c\U+1EA5p autoCad và có menu Express"
                )
                "Warning"
                4144
            )
            (exit)
        )
    )
    (acet-sysvar-set '("cmdecho" 0 "osmode" 0 "dimpost" "."))
    (setq ApCad   (vlax-get-acad-object)
          ActDoc  (vla-get-ActiveDocument ApCad)
          *Model* (vla-get-ModelSpace ActDoc)
          *util*  (vla-get-Utility ActDoc)
    )
    
    (setq acm (vla-GetInterfaceObject
                  ApCad
                  (strcat "AutoCAD.AcCmColor." (substr (getvar 'acadver) 1 2))
              )
    )
    (acet-ui-status "Select DIMENSIONs" "Prompt")
    (setq ssdim (ssget '((0 . "DIMENSION"))))
    (acet-ui-status)
    (while (OR (NOT (setq ent_T
                             (car (entsel "\nPick a Text object for set sum dimensions"))
                    )
               )
               (NOT (eq (DXF 0 ent_T) "TEXT"))
           )
        (prompt "\nPick not right TEXT object, please pick again")
    )
    (setq Obj_Text (vlax-ename->vla-object ent_T))
    (setq tz (dxf 40 ent_T))
    (setq po (getvar "Extmin")
          po (list (- (car po) (* tz 20)) (cadr po) 0.0)
    )
    (if (null (setq prec (getint (acet-str-format
                                     "\nEnter number of decimal places: <%1> "
                                     (itoa (getvar "useri1"))
                                 )
                         )
              )
        )
        (setq prec (getvar "useri1"))
    )
    (setvar "useri1" prec)
    (if ssdim
        (progn
            (setq ent-lst (acet-ss-to-list ssdim))
            (setq len (length ent-lst))
            (setq objTab (vla-AddTable *Model*
                                       (vlax-3D-point po)
                                       len
                                       1
                                       (* tz 3.5)
                                       (* tz 8)
                         )
            )
            (vla-put-layer objTab (vla-get-layer Obj_Text))
            
            (vla-setrgb acm 0 0 0)
            (vla-put-truecolor objTab  acm)

            (setq n 0)
            (foreach entD ent-lst
                (setq Obj_DIM (vlax-ename->vla-object entD))
                (if (eq (vla-get-TextOverride Obj_DIM) "")
                    (vla-setText
                        objTab
                        n
                        0
                        (acet-str-format
                            "%<\\AcObjProp Object(%<\\_ObjId %1>%).%3 \\f \"%llu2%pr%2%\">%"
                            (getIDobject Obj_DIM)
                            (itoa prec)
                            "Measurement"
                        )
                    )
                    (vla-setText
                        objTab
                        n
                        0
                        (acet-str-format
                            "%<\\AcObjProp Object(%<\\_ObjId %1>%).%2>%"
                            (getIDobject Obj_DIM)
                            "TextOverride"
                        )
                    )
                )
                (setq n (+ n 1))
            )
            (setq str
                     (acet-str-format
                         "%<\\AcExpr (Table(%<\\_ObjId %1>%).Evaluate(Sum(A1:A%2))) \\f \"%lu2%pr%3\">%"
                         (getIDobject objTab)
                         (itoa len)
                         (itoa prec)
                     )
            )
            (vla-put-TextString Obj_Text str)
        )
    )
    (vla-put-Visible objTab acfalse)
    (ACET-SYSVAR-RESTORE)
    (command "undo" "en")
    (princ "ok")
    (PRINC)
)

Lisp tính tổng các text dimension, tạo field giá trị tổng đưa vào 1 đối tượng TEXT có sẵn. Text dimension có thể bị chỉnh sửa hay không bị chỉnh sửa cũng được cộng. Khi 1 hay nhiều dimension thay đổi thì text tổng cũng thay đổi.

  • Like 1
  • Vote tăng 2

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
44 phút trước, thiep đã nói:

;| LISP  FIELD SUM DIMENSIONS TO A TEXT|;
(defun DXF (code en) (cdr (assoc code (entget en))))
(defun getIDobject (obj)
    (if (vlax-method-applicable-p *util* 'GetObjectIdString)
        (vla-GetObjectIdString *util* obj :vlax-false)
        (itoa (vla-get-ObjectId obj))
    )
)
(defun c:fdt (/ ApCad    ActDoc   *Model*  *util*       ssdim
                ent_T    Obj_Text tz       po       ent-lst  len      n
                Obj_DIM  str      rowtypes objTab acm prec
               )
    (vl-load-com)
    (command "undo" "be")
    (defun *error* (msg)
        (and doc (_EndUndo doc))
        (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
            (princ (strcat "\n** Error: " msg " **"))
        )
        (acet-sysvar-restore)
        (command "undo" "en")
        (princ)
    )
    (if (< (substr (getvar "ACADVER") 1 2) "15")
        (progn
            (acet-ui-message
                (strcat
                    "Lisp này ch\U+1EC9 ch\U+1EA1y \U+0111\U+01B0\U+1EE3c t\U+1EEB autoCad 2007 tr\U+1EDF lên."
                    "\nB\U+1EA1n nên nâng c\U+1EA5p autoCad và có menu Express"
                )
                "Warning"
                4144
            )
            (exit)
        )
    )
    (acet-sysvar-set '("cmdecho" 0 "osmode" 0 "dimpost" "."))
    (setq ApCad   (vlax-get-acad-object)
          ActDoc  (vla-get-ActiveDocument ApCad)
          *Model* (vla-get-ModelSpace ActDoc)
          *util*  (vla-get-Utility ActDoc)
    )
    
    (setq acm (vla-GetInterfaceObject
                  ApCad
                  (strcat "AutoCAD.AcCmColor." (substr (getvar 'acadver) 1 2))
              )
    )
    (acet-ui-status "Select DIMENSIONs" "Prompt")
    (setq ssdim (ssget '((0 . "DIMENSION"))))
    (acet-ui-status)
    (while (OR (NOT (setq ent_T
                             (car (entsel "\nPick a Text object for set sum dimensions"))
                    )
               )
               (NOT (eq (DXF 0 ent_T) "TEXT"))
           )
        (prompt "\nPick not right TEXT object, please pick again")
    )
    (setq Obj_Text (vlax-ename->vla-object ent_T))
    (setq tz (dxf 40 ent_T))
    (setq po (getvar "Extmin")
          po (list (- (car po) (* tz 20)) (cadr po) 0.0)
    )
    (if (null (setq prec (getint (acet-str-format
                                     "\nEnter number of decimal places: <%1> "
                                     (itoa (getvar "useri1"))
                                 )
                         )
              )
        )
        (setq prec (getvar "useri1"))
    )
    (setvar "useri1" prec)
    (if ssdim
        (progn
            (setq ent-lst (acet-ss-to-list ssdim))
            (setq len (length ent-lst))
            (setq objTab (vla-AddTable *Model*
                                       (vlax-3D-point po)
                                       len
                                       1
                                       (* tz 3.5)
                                       (* tz 8)
                         )
            )
            (vla-put-layer objTab (vla-get-layer Obj_Text))
            
            (vla-setrgb acm 0 0 0)
            (vla-put-truecolor objTab  acm)

            (setq n 0)
            (foreach entD ent-lst
                (setq Obj_DIM (vlax-ename->vla-object entD))
                (if (eq (vla-get-TextOverride Obj_DIM) "")
                    (vla-setText
                        objTab
                        n
                        0
                        (acet-str-format
                            "%<\\AcObjProp Object(%<\\_ObjId %1>%).%3 \\f \"%llu2%pr%2%\">%"
                            (getIDobject Obj_DIM)
                            (itoa prec)
                            "Measurement"
                        )
                    )
                    (vla-setText
                        objTab
                        n
                        0
                        (acet-str-format
                            "%<\\AcObjProp Object(%<\\_ObjId %1>%).%2>%"
                            (getIDobject Obj_DIM)
                            "TextOverride"
                        )
                    )
                )
                (setq n (+ n 1))
            )
            (setq str
                     (acet-str-format
                         "%<\\AcExpr (Table(%<\\_ObjId %1>%).Evaluate(Sum(A1:A%2))) \\f \"%lu2%pr%3\">%"
                         (getIDobject objTab)
                         (itoa len)
                         (itoa prec)
                     )
            )
            (vla-put-TextString Obj_Text str)
        )
    )
    (vla-put-Visible objTab acfalse)
    (ACET-SYSVAR-RESTORE)
    (command "undo" "en")
    (princ "ok")
    (PRINC)
)

Lisp tính tổng các text dimension, tạo field giá trị tổng đưa vào 1 đối tượng TEXT có sẵn. Text dimension có thể bị chỉnh sửa hay không bị chỉnh sửa cũng được cộng. Khi 1 hay nhiều dimension thay đổi thì text tổng cũng thay đổi.

Chưa test thử nhưng xem video thì đây là lisp mình mong muốn. Thanks bạn nhiều lắm. Chúc bạn cuối tuần nhiều niềm vui. 

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

@thiep: Bác phức tạp hóa vấn đề rồi (qua đối tượng trung gian Table), lại còn hạn chế luôn từ Cad2007 trở về trước nữa.

String cuối cùng để gán vào Text tổng, mình lấy như sau:

(setq str "%<\\AcExpr (")
(foreach ent  (acet-ss-to-list ssdim)
    (setq dim (vlax-ename->vla-object ent)
               oid (getIDobject dim))
    (if (distof (vla-get-TextOverride dim))
        (setq str (strcat str "+%<\\AcObjProp Object(%<\\_ObjId " oid ">%).TextOverride>%"))
        (setq str (strcat str "+%<\\AcObjProp Object(%<\\_ObjId " oid ">%).Measurement \\f \"%lu2\">%"))))
(setq str (strcat str ") \\f \"%lu2%pr" (itoa prec) "\">%"))

  • Like 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
20 giờ trước, thiep đã nói:

;| LISP  FIELD SUM DIMENSIONS TO A TEXT|;
(defun DXF (code en) (cdr (assoc code (entget en))))
(defun getIDobject (obj)
    (if (vlax-method-applicable-p *util* 'GetObjectIdString)
        (vla-GetObjectIdString *util* obj :vlax-false)
        (itoa (vla-get-ObjectId obj))
    )
)
(defun c:fdt (/ ApCad    ActDoc   *Model*  *util*       ssdim
                ent_T    Obj_Text tz       po       ent-lst  len      n
                Obj_DIM  str      rowtypes objTab acm prec
               )
    (vl-load-com)
    (command "undo" "be")
    (defun *error* (msg)
        (and doc (_EndUndo doc))
        (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
            (princ (strcat "\n** Error: " msg " **"))
        )
        (acet-sysvar-restore)
        (command "undo" "en")
        (princ)
    )
    (if (< (substr (getvar "ACADVER") 1 2) "15")
        (progn
            (acet-ui-message
                (strcat
                    "Lisp này ch\U+1EC9 ch\U+1EA1y \U+0111\U+01B0\U+1EE3c t\U+1EEB autoCad 2007 tr\U+1EDF lên."
                    "\nB\U+1EA1n nên nâng c\U+1EA5p autoCad và có menu Express"
                )
                "Warning"
                4144
            )
            (exit)
        )
    )
    (acet-sysvar-set '("cmdecho" 0 "osmode" 0 "dimpost" "."))
    (setq ApCad   (vlax-get-acad-object)
          ActDoc  (vla-get-ActiveDocument ApCad)
          *Model* (vla-get-ModelSpace ActDoc)
          *util*  (vla-get-Utility ActDoc)
    )
    
    (setq acm (vla-GetInterfaceObject
                  ApCad
                  (strcat "AutoCAD.AcCmColor." (substr (getvar 'acadver) 1 2))
              )
    )
    (acet-ui-status "Select DIMENSIONs" "Prompt")
    (setq ssdim (ssget '((0 . "DIMENSION"))))
    (acet-ui-status)
    (while (OR (NOT (setq ent_T
                             (car (entsel "\nPick a Text object for set sum dimensions"))
                    )
               )
               (NOT (eq (DXF 0 ent_T) "TEXT"))
           )
        (prompt "\nPick not right TEXT object, please pick again")
    )
    (setq Obj_Text (vlax-ename->vla-object ent_T))
    (setq tz (dxf 40 ent_T))
    (setq po (getvar "Extmin")
          po (list (- (car po) (* tz 20)) (cadr po) 0.0)
    )
    (if (null (setq prec (getint (acet-str-format
                                     "\nEnter number of decimal places: <%1> "
                                     (itoa (getvar "useri1"))
                                 )
                         )
              )
        )
        (setq prec (getvar "useri1"))
    )
    (setvar "useri1" prec)
    (if ssdim
        (progn
            (setq ent-lst (acet-ss-to-list ssdim))
            (setq len (length ent-lst))
            (setq objTab (vla-AddTable *Model*
                                       (vlax-3D-point po)
                                       len
                                       1
                                       (* tz 3.5)
                                       (* tz 8)
                         )
            )
            (vla-put-layer objTab (vla-get-layer Obj_Text))
            
            (vla-setrgb acm 0 0 0)
            (vla-put-truecolor objTab  acm)

            (setq n 0)
            (foreach entD ent-lst
                (setq Obj_DIM (vlax-ename->vla-object entD))
                (if (eq (vla-get-TextOverride Obj_DIM) "")
                    (vla-setText
                        objTab
                        n
                        0
                        (acet-str-format
                            "%<\\AcObjProp Object(%<\\_ObjId %1>%).%3 \\f \"%llu2%pr%2%\">%"
                            (getIDobject Obj_DIM)
                            (itoa prec)
                            "Measurement"
                        )
                    )
                    (vla-setText
                        objTab
                        n
                        0
                        (acet-str-format
                            "%<\\AcObjProp Object(%<\\_ObjId %1>%).%2>%"
                            (getIDobject Obj_DIM)
                            "TextOverride"
                        )
                    )
                )
                (setq n (+ n 1))
            )
            (setq str
                     (acet-str-format
                         "%<\\AcExpr (Table(%<\\_ObjId %1>%).Evaluate(Sum(A1:A%2))) \\f \"%lu2%pr%3\">%"
                         (getIDobject objTab)
                         (itoa len)
                         (itoa prec)
                     )
            )
            (vla-put-TextString Obj_Text str)
        )
    )
    (vla-put-Visible objTab acfalse)
    (ACET-SYSVAR-RESTORE)
    (command "undo" "en")
    (princ "ok")
    (PRINC)
)

Lisp tính tổng các text dimension, tạo field giá trị tổng đưa vào 1 đối tượng TEXT có sẵn. Text dimension có thể bị chỉnh sửa hay không bị chỉnh sửa cũng được cộng. Khi 1 hay nhiều dimension thay đổi thì text tổng cũng thay đổi.

Bác ơi em test với những dim sửa text rồi thì không được, Cũng bài toán như vậy bác có thể sửa thay đối tượng Dim bằng (text, length hoặc area) được không ạ

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
Vào lúc 4/4/2020 tại 17:14, thiep đã nói:

;| LISP  FIELD SUM DIMENSIONS TO A TEXT|;
(defun DXF (code en) (cdr (assoc code (entget en))))
(defun getIDobject (obj)
    (if (vlax-method-applicable-p *util* 'GetObjectIdString)
        (vla-GetObjectIdString *util* obj :vlax-false)
        (itoa (vla-get-ObjectId obj))
    )
)
(defun c:fdt (/ ApCad    ActDoc   *Model*  *util*       ssdim
                ent_T    Obj_Text tz       po       ent-lst  len      n
                Obj_DIM  str      rowtypes objTab acm prec
               )
    (vl-load-com)
    (command "undo" "be")
    (defun *error* (msg)
        (and doc (_EndUndo doc))
        (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
            (princ (strcat "\n** Error: " msg " **"))
        )
        (acet-sysvar-restore)
        (command "undo" "en")
        (princ)
    )
    (if (< (substr (getvar "ACADVER") 1 2) "15")
        (progn
            (acet-ui-message
                (strcat
                    "Lisp này ch\U+1EC9 ch\U+1EA1y \U+0111\U+01B0\U+1EE3c t\U+1EEB autoCad 2007 tr\U+1EDF lên."
                    "\nB\U+1EA1n nên nâng c\U+1EA5p autoCad và có menu Express"
                )
                "Warning"
                4144
            )
            (exit)
        )
    )
    (acet-sysvar-set '("cmdecho" 0 "osmode" 0 "dimpost" "."))
    (setq ApCad   (vlax-get-acad-object)
          ActDoc  (vla-get-ActiveDocument ApCad)
          *Model* (vla-get-ModelSpace ActDoc)
          *util*  (vla-get-Utility ActDoc)
    )
    
    (setq acm (vla-GetInterfaceObject
                  ApCad
                  (strcat "AutoCAD.AcCmColor." (substr (getvar 'acadver) 1 2))
              )
    )
    (acet-ui-status "Select DIMENSIONs" "Prompt")
    (setq ssdim (ssget '((0 . "DIMENSION"))))
    (acet-ui-status)
    (while (OR (NOT (setq ent_T
                             (car (entsel "\nPick a Text object for set sum dimensions"))
                    )
               )
               (NOT (eq (DXF 0 ent_T) "TEXT"))
           )
        (prompt "\nPick not right TEXT object, please pick again")
    )
    (setq Obj_Text (vlax-ename->vla-object ent_T))
    (setq tz (dxf 40 ent_T))
    (setq po (getvar "Extmin")
          po (list (- (car po) (* tz 20)) (cadr po) 0.0)
    )
    (if (null (setq prec (getint (acet-str-format
                                     "\nEnter number of decimal places: <%1> "
                                     (itoa (getvar "useri1"))
                                 )
                         )
              )
        )
        (setq prec (getvar "useri1"))
    )
    (setvar "useri1" prec)
    (if ssdim
        (progn
            (setq ent-lst (acet-ss-to-list ssdim))
            (setq len (length ent-lst))
            (setq objTab (vla-AddTable *Model*
                                       (vlax-3D-point po)
                                       len
                                       1
                                       (* tz 3.5)
                                       (* tz 8)
                         )
            )
            (vla-put-layer objTab (vla-get-layer Obj_Text))
            
            (vla-setrgb acm 0 0 0)
            (vla-put-truecolor objTab  acm)

            (setq n 0)
            (foreach entD ent-lst
                (setq Obj_DIM (vlax-ename->vla-object entD))
                (if (eq (vla-get-TextOverride Obj_DIM) "")
                    (vla-setText
                        objTab
                        n
                        0
                        (acet-str-format
                            "%<\\AcObjProp Object(%<\\_ObjId %1>%).%3 \\f \"%llu2%pr%2%\">%"
                            (getIDobject Obj_DIM)
                            (itoa prec)
                            "Measurement"
                        )
                    )
                    (vla-setText
                        objTab
                        n
                        0
                        (acet-str-format
                            "%<\\AcObjProp Object(%<\\_ObjId %1>%).%2>%"
                            (getIDobject Obj_DIM)
                            "TextOverride"
                        )
                    )
                )
                (setq n (+ n 1))
            )
            (setq str
                     (acet-str-format
                         "%<\\AcExpr (Table(%<\\_ObjId %1>%).Evaluate(Sum(A1:A%2))) \\f \"%lu2%pr%3\">%"
                         (getIDobject objTab)
                         (itoa len)
                         (itoa prec)
                     )
            )
            (vla-put-TextString Obj_Text str)
        )
    )
    (vla-put-Visible objTab acfalse)
    (ACET-SYSVAR-RESTORE)
    (command "undo" "en")
    (princ "ok")
    (PRINC)
)

Lisp tính tổng các text dimension, tạo field giá trị tổng đưa vào 1 đối tượng TEXT có sẵn. Text dimension có thể bị chỉnh sửa hay không bị chỉnh sửa cũng được cộng. Khi 1 hay nhiều dimension thay đổi thì text tổng cũng thay đổi.

Thanks bạn! 

Sau khi dùng thử thì mình thấy lisp này chỉ dùng được cho đối tượng chưa bị edit, còn nhửng đối tượng đã bị edit rồi thì không dùng được, Mong bạn xem lại giúp

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
8 phút trước, Han Tinh đã nói:

Thanks bạn! 

Sau khi dùng thử thì mình thấy lisp này chỉ dùng được cho đối tượng chưa bị edit, còn nhửng đối tượng đã bị edit rồi thì không dùng được, Mong bạn xem lại giúp

 

6 giờ trước, mdchuyen đã nói:

Bác ơi em test với những dim sửa text rồi thì không được, Cũng bài toán như vậy bác có thể sửa thay đối tượng Dim bằng (text, length hoặc area) được không ạ

Lisp đã được chỉnh sửa rồi các bạn, sẽ có lisp tổng quát cho các kiểu tạo field tổng text số, tổng chiều dài line, tổng diện tích luôn, nhưng @quocmanh04tt đã phát hiện Thiep dùng "đối tượng ăn gian" , (đối tượng này chỉ có autocad 2005 trở lên mới tạo được), dùng để tính tổng như trong excel rồi tạo field cho text. He he he, Thiẹp cũng đã làm phương án 2 theo hướng của QuocManh nhưng nó không chạy.

  • Like 1
  • 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

Lisp đã chỉnh sửa: tạo field của sum dimensions vào đối tượng text có sẵn, không còn tạo "đối tượng trung gian" để cộng trừ nhân chia, chạy thử trên autoCad 2014 thấy OK. Chấp nhận text dim đã chỉnh sửa. Còn sum đối tượng text số, lengLine, area tạo field đưa vào text, hẹn một ngày khác.

Cảm ơn Quocmanh04tt đã gợi ý.

;| LISP  FIELD SUM DIMENSIONS TO A TEXT
          by TrânThiêp 04/2020 |;
(defun getIDobject (obj)
    (if (vlax-method-applicable-p *util* 'GetObjectIdString)
        (vla-GetObjectIdString *util* obj :vlax-false)
        (itoa (vla-get-ObjectId obj))
    )
)
(defun c:fdt2 (/ ApCad ActDoc  *util* ssdim ent_T Obj_Text ent-lst len
                 Obj_DIM objDim_lst ID_Dim_lst str prec)
    (vl-load-com)
    (command "undo" "be")
    (defun *error* (msg)
        (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
            (princ (strcat "\n** Error: " msg " **"))
        )
        (acet-sysvar-restore)
        (command "undo" "en")
        (princ)
    )
    (acet-sysvar-set '("cmdecho" 0 "osmode" 0 ))
    (setq ApCad  (vlax-get-acad-object)
          ActDoc (vla-get-ActiveDocument ApCad)
          *util* (vla-get-Utility ActDoc)
    )
    (acet-ui-status "Select DIMENSIONs" "Prompt")
    (setq ssdim (ssget '((0 . "DIMENSION"))))
    (acet-ui-status)
    (while (OR (NOT (setq ent_T
                             (car (entsel
                                      "\nPick a Text object for set sum dimensions"
                                  )
                             )
                    )
               )
               (NOT (eq (cdr (assoc 0 (entget ent_T))) "TEXT"))
           )
        (prompt "\nPick not right TEXT object, please pick again")
    )
    (setq Obj_Text (vlax-ename->vla-object ent_T))
    (if (null (setq prec (getint (acet-str-format
                                     "\nEnter number of decimal places: <%1> "
                                     (itoa (getvar "useri1"))
                                 )
                         )
              )
        )
        (setq prec (getvar "useri1"))
    )
    (setvar "useri1" prec)
    
    (if ssdim
        (progn
            (setq objDim_lst (mapcar 'vlax-ename->vla-object
                                     (acet-ss-to-list ssdim)
                             )
            )
            (setq ID_Dim_lst (mapcar '(lambda (x) (getIDobject x)) objDim_lst))
            (setq str "%<\\AcExpr (")
            (mapcar '(lambda (ob id)
                         (if (distof (vla-get-TextOverride ob))
                             (Setq str
                                      (strcat
                                          str
                                          (acet-str-format
                                              "%<\\AcObjProp Object(%<\\_ObjId %1>%).%2>%+"
                                              id
                                              "TextOverride"
                                          )
                                      )
                             )
                             (Setq str
                                      (strcat
                                          str
                                          (acet-str-format
                                              "%<\\AcObjProp Object(%<\\_ObjId %1>%).%3 \\f \"%lu2%pr%2\">%+"
                                              id
                                              (itoa prec)
                                              "Measurement"
                                          )
                                      )
                             )
                         )

                     )
                    objDim_lst
                    ID_Dim_lst
            )
            (setq str (acet-str-format "%1) \\f \"%lu2%pr%2\">%"
                                       (vl-string-right-trim "+" str)
                                       (itoa prec)
                      )
            )
            (vla-put-TextString Obj_Text str)
        )
    )
    (ACET-SYSVAR-RESTORE)
    (command "undo" "en")
    (princ "\nOK")
    (PRINC)
)

 

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
6 giờ trước, thiep đã nói:

Lisp đã chỉnh sửa: tạo field của sum dimensions vào đối tượng text có sẵn, không còn tạo "đối tượng trung gian" để cộng trừ nhân chia, chạy thử trên autoCad 2014 thấy OK. Chấp nhận text dim đã chỉnh sửa. Còn sum đối tượng text số, lengLine, area tạo field đưa vào text, hẹn một ngày khác.

Cảm ơn Quocmanh04tt đã gợi ý.


;| LISP  FIELD SUM DIMENSIONS TO A TEXT
          by TrânThiêp 04/2020 ;
(defun getIDobject (obj)
    (if (vlax-method-applicable-p *util* 'GetObjectIdString)
        (vla-GetObjectIdString *util* obj :vlax-false)
        (itoa (vla-get-ObjectId obj))
    )
)
(defun c:fdt2 (/ ApCad ActDoc  *util* ssdim ent_T Obj_Text ent-lst len
                 Obj_DIM objDim_lst ID_Dim_lst str prec)
    (vl-load-com)
    (command "undo" "be")
    (defun *error* (msg)
        (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
            (princ (strcat "\n** Error: " msg " **"))
        )
        (acet-sysvar-restore)
        (command "undo" "en")
        (princ)
    )
    (acet-sysvar-set '("cmdecho" 0 "osmode" 0 ))
    (setq ApCad  (vlax-get-acad-object)
          ActDoc (vla-get-ActiveDocument ApCad)
          *util* (vla-get-Utility ActDoc)
    )
    (acet-ui-status "Select DIMENSIONs" "Prompt")
    (setq ssdim (ssget '((0 . "DIMENSION"))))
    (acet-ui-status)
    (while (OR (NOT (setq ent_T
                             (car (entsel
                                      "\nPick a Text object for set sum dimensions"
                                  )
                             )
                    )
               )
               (NOT (eq (cdr (assoc 0 (entget ent_T))) "TEXT"))
           )
        (prompt "\nPick not right TEXT object, please pick again")
    )
    (setq Obj_Text (vlax-ename->vla-object ent_T))
    (if (null (setq prec (getint (acet-str-format
                                     "\nEnter number of decimal places: <%1> "
                                     (itoa (getvar "useri1"))
                                 )
                         )
              )
        )
        (setq prec (getvar "useri1"))
    )
    (setvar "useri1" prec)
    
    (if ssdim
        (progn
            (setq objDim_lst (mapcar 'vlax-ename->vla-object
                                     (acet-ss-to-list ssdim)
                             )
            )
            (setq ID_Dim_lst (mapcar '(lambda (x) (getIDobject x)) objDim_lst))
            (setq str "%<\\AcExpr (")
            (mapcar '(lambda (ob id)
                         (if (distof (vla-get-TextOverride ob))
                             (Setq str
                                      (strcat
                                          str
                                          (acet-str-format
                                              "%<\\AcObjProp Object(%<\\_ObjId %1>%).%2>%+"
                                              id
                                              "TextOverride"
                                          )
                                      )
                             )
                             (Setq str
                                      (strcat
                                          str
                                          (acet-str-format
                                              "%<\\AcObjProp Object(%<\\_ObjId %1>%).%3 \\f \"%lu2%pr%2\">%+"
                                              id
                                              (itoa prec)
                                              "Measurement"
                                          )
                                      )
                             )
                         )

                     )
                    objDim_lst
                    ID_Dim_lst
            )
            (setq str (acet-str-format "%1) \\f \"%lu2%pr%2\">%"
                                       (vl-string-right-trim "+" str)
                                       (itoa prec)
                      )
            )
            (vla-put-TextString Obj_Text str)
        )
    )
    (ACET-SYSVAR-RESTORE)
    (command "undo" "en")
    (princ "\nOK")
    (PRINC)
)

 

Tuyệt vời rồi bạn ơi, 

Thanks bạn nhiều nha! Chúc bạn một ngày đầy năng lượng

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
 
 
 
 
Vào lúc 5/4/2020 tại 09:57, quocmanh04tt đã nói:

@thiep

.......

    (if (distof (vla-get-TextOverride dim))
        (setq str (strcat str "+%<\\AcObjProp Object(%<\\_ObjId " oid ">%).TextOverride>%"))
        (setq str (strcat str "+%<\\AcObjProp Object(%<\\_ObjId " oid ">%).Measurement \\f \"%lu2\">%"))))
........

@thiệp Kết quả chỉ đúng tại thời điểm chạy Lisp.

Sau đó nếu user edit giá trị từ TextOverride sang Measurement (hoặc ngược lai) thì lisp không tự phát hiện đc, và dĩ nhiên k/quả sẽ ko đúng.

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
5 giờ trước, gia_bach đã nói:

@thiệp Kết quả chỉ đúng tại thời điểm chạy Lisp.

Sau đó nếu user edit giá trị từ TextOverride sang Measurement (hoặc ngược lai) thì lisp không tự phát hiện đc, và dĩ nhiên k/quả sẽ ko đúng.

@gia_bach, khi đó lisp sẽ hiểu ID của đối tượng đó bị thay đổi, field sẽ bị sai ngay, chỉ còn cách chạy lại lisp lần nữa.

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

@thiephiểu sai ý mình rồi!

vẫn là ID của đối tương đó nhưng việc lấy thuộc tính TextOverwrite của 1 dim kích thước thật hoặc lấy thuộc tính Measurement của 1 dim bị edit sẽ dẫn đến kết quả không chính xác.

 

 

image.png.4794886e527e3730f51c30ed97263a6c.png

 

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
1 giờ trước, gia_bach đã nói:

@thiephiểu sai ý mình rồi!

vẫn là ID của đối tương đó nhưng việc lấy thuộc tính TextOverwrite của 1 dim kích thước thật hoặc lấy thuộc tính Measurement của 1 dim bị edit sẽ dẫn đến kết quả không chính xác.

 

@gia_bach

biểu thức cộng field:

...%<\AcObjProp Object(%<\_ObjId xxxxxxxxx>%).TextOverride>% + %<\AcObjProp Object(%<\_ObjId yyyyyyyyyyy>%).Measurement...

thuộc tính TextOverride được lấy tại đối tượng _ObjId xxxxxxxxx, thuộc tính Measurement được lấy tại đối tượng _ObjId yyyyyyyyy. Ông TRỜI đã định biểu thức này  như vậy để gán cho text có sẵn là cứng nhắc rồi, không thay đổi được như lisp.

công thức field trong autocad không tự động thay đổi thuộc tính cho đối tượng được mà chỉ lấy giá trị thuộc tính của nó.

Thiệp hiểu: Một khi thay đổi từ TextOverride  sang Measurement, công thức field sẽ tìm giá trị thuộc tính Measurement tại objID màu xanh (vế hai) để thực hiện, nó tìm không thấy giá trị thuộc tính Measurement tại objID màu đỏ nào, nó bỏ qua.

 

 

 

 

 

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

Mở rộng thêm lisp fdt1: tạo field của tổng giá trị dimensions vào đối tượng text có sẵn. Thiệp tạo thêm 4 lisp:

fdt2: tạo field tổng giá trị số của text, mtext số;

fdt3: tạo field tổng giá trị length của các đối tượng có thuộc tính length;

fdt4: tạo field tổng giá trị diện tích của các đối tượng có thuộc tính Area;

fdt5: tạo field tổng giá trị chu vi đường tròn của các đối tượng đường tròn.

(tuy nhiên fdt2 thật sự Thiep không vừa ý lắm vì nó tạo ra tới độ chính xác 6 con số lẻ của số thập phân. ví dụ số tổng 910.1 nó sẽ ra 910.100000, nhờ ae phân tích tại sao nó bị khiếm khuyết này)

Có tới hơn 400 dòng mã của 5 lisp.

;;; LISP  FIELD SUM DIMENSIONS, TEXTs, MTEXTs, LENGTHs, AREAs, CIRCUMFERENCEs TO A TEXT
;;;          by TrânThiêp 04/2020
;;;		09188411230
;;;=======================================================
;;; command         fdt1 : field sum DIMENSIONS                        
;;; command         fdt2 : field sum TEXTs, MTEXTs                     
;;; command         fdt3 : field sum LENGTHs                           
;;; command         fdt4 : field sum AREAs                             
;;; command         fdt5 : field sum CIRCUMFERENCEs                    
;;;                                                       
(defun DXF (code en) (cdr (assoc code (entget en))))
;;;===========================================================================1: sum DIMENSIONs =========
(defun c:fdt1 (/  ss ent_T Obj_Text str prec Lobj_dim ID_Dim_lst field_lst)
    (vl-load-com)
    (command "undo" "be")
    (defun *error* (msg)
        (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
            (princ (strcat "\n** Error: " msg " **"))
        )
        (acet-sysvar-restore)
        (command "undo" "en")
        (princ)
    )
    (acet-sysvar-set '("cmdecho" 0 "osmode" 0))
    (acet-ui-status "Select DIMENSIONs FOR GET SUM" "Prompt")
    (setq ss (ssget '((0 . "DIMENSION"))))
    (acet-ui-status)
    (while (OR (NOT (setq ent_T
                             (car (entsel
                                      "\nPick a Text object for set sum dimensions"
                                  )
                             )
                    )
               )
               (NOT (eq (cdr (assoc 0 (entget ent_T))) "TEXT"))
           )
        (prompt "\nPick not right TEXT object, please pick again")
    )
    (setq Obj_Text (vlax-ename->vla-object ent_T))
    (if (null (setq prec (getint (acet-str-format
                                     "\nEnter number of decimal places: <%1> "
                                     (itoa (getvar "useri1"))
                                 )
                         )
              )
        )
        (setq prec (getvar "useri1"))
    )
    (setvar "useri1" prec)
    (if ss
        (progn
            (mapcar
                '(lambda (x)
                     (setq Lobj_dim (CONS (vlax-ename->vla-object x) Lobj_dim))
                 )
                (acet-ss-to-list ss)
            )
            (setq ID_Dim_lst (mapcar 'vla-get-objectid Lobj_dim))
            (Setq field_lst
                     (mapcar
                         '(lambda (ob id)
                              (if (distof (vla-get-TextOverride ob))
                                  (acet-str-format
                                      "%<\\AcObjProp Object(%<\\_ObjId %1>%).%2>%+"
                                      (itoa id)
                                      "TextOverride"
                                  )
                                  (acet-str-format
                                      "%<\\AcObjProp Object(%<\\_ObjId %1>%).%3 \\f \"%lu2%pr%2\">%+"
                                      (itoa id)
                                      (itoa prec)
                                      "Measurement"
                                  )
                              )
                          )
                         Lobj_dim
                         ID_Dim_lst
                     )
            )
            (setq str (acet-str-format
                          "%<\\AcExpr (%1) \\f \"%lu2%pr%2\">%"
                          (vl-string-right-trim "+" (apply 'strcat field_lst))
                          (itoa prec)
                      )
            )
            (vla-put-TextString Obj_Text str)
        ) ;_PROGN
    ) ;_IF
    (ACET-SYSVAR-RESTORE)
    (command "undo" "en")
    (PRINC str)
    (princ "\nOK")
    
)
;;;===========================================================================2: sum TEXTs, MTEXTs NUMBER=========
(defun c:fdt2 (/  ss ent_T Obj_Text str prec Lobj_text ID_text_lst field_lst)
    (vl-load-com)
    (command "undo" "be")
    (defun *error* (msg)
        (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
            (princ (strcat "\n** Error: " msg " **"))
        )
        (acet-sysvar-restore)
        (command "undo" "en")
        (princ)
    )
    (acet-sysvar-set '("cmdecho" 0 "osmode" 0))
    (acet-ui-status "Select:  TEXT, MTEXT NUMBER FOR GET SUM" "Prompt")
    (setq ss (ssget '((0 . "*TEXT"))))
    (acet-ui-status)
    (if ss
        (progn
            (while (OR (NOT (setq ent_T
                                     (car
                                         (entsel
                                             "\nPick a Text object for set sum text number"
                                         )
                                     )
                            )
                       )
                       (NOT (eq (cdr (assoc 0 (entget ent_T))) "TEXT"))
                   )
                (prompt "\nPick not right TEXT object, please pick again")
            )
            (setq Obj_Text (vlax-ename->vla-object ent_T))
            (if (null (setq
                          prec (getint
                                   (acet-str-format
                                       "\nEnter number of decimal places: <%1> "
                                       (itoa (getvar "useri2"))
                                   )
                               )
                      )
                )
                (setq prec (getvar "useri2"))
            )
            (setvar "useri2" prec)
            (mapcar
                '(lambda (x)
                     (if (Numberp (atof (dxf 1 x)))
                         (setq Lobj_text (CONS (vlax-ename->vla-object x)
                                               Lobj_text
                                         )
                         )
                     )
                 )
                (acet-ss-to-list ss)
            )
            (setq ID_text_lst (mapcar 'vla-get-objectid Lobj_text))
            (setq field_lst
                     (mapcar
                         '(lambda (x)
                              (acet-str-format
                                  "%<\\AcObjProp Object(%<\\_ObjId %1>%).TextString>% +"
                                  (itoa x)
                              )
                          )
                         ID_text_lst
                     )
            )
            (setq str (acet-str-format
                          "%<\\AcExpr (%1)>%"
                          (vl-string-right-trim "+" (apply 'strcat field_lst))
                      )
            )
            (vla-put-TextString Obj_Text str)
        ) ;_PROGN
    ) ;_IF
    (ACET-SYSVAR-RESTORE)
    (command "undo" "en")
    (princ "\nOK")
    (PRINC)
)
;;;===========================================================================3: LENGTHs=========
(defun c:fdt3 (/ ss ent_T Obj_Text str prec Lobj_leng ID_leng_lst field_lst)
    (vl-load-com)
    (command "undo" "be")
    (defun *error* (msg)
        (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
            (princ (strcat "\n** Error: " msg " **"))
        )
        (acet-sysvar-restore)
        (command "undo" "en")
        (princ)
    )
    (acet-sysvar-set '("cmdecho" 0 "osmode" 0))
    (acet-ui-status "Select:  LINE, POLYLINE, for GET SUM LENGTH"
                    "Prompt"
    )
    (setq ss (ssget '((0 . "LINE,*POLYLINE"))))
    (acet-ui-status)
    (if ss
        (progn
            (while (OR (NOT (setq ent_T
                                     (car
                                         (entsel
                                             "\nPick a Text object for set sum length value"
                                         )
                                     )
                            )
                       )
                       (NOT (eq (cdr (assoc 0 (entget ent_T))) "TEXT"))
                   )
                (prompt "\nPick not right TEXT object, please pick again")
            )
            (setq Obj_Text (vlax-ename->vla-object ent_T))
            (if (null (setq
                          prec (getint
                                   (acet-str-format
                                       "\nEnter number of decimal places: <%1> "
                                       (itoa (getvar "useri3"))
                                   )
                               )
                      )
                )
                (setq prec (getvar "useri3"))
            )
            (setvar "useri3" prec)
            (mapcar
                '(lambda (x)
                     (if (vlax-property-available-p (vlax-ename->vla-object x)
                                                    'length
                         )
                         (setq Lobj_leng (CONS (vlax-ename->vla-object x)
                                               Lobj_leng
                                         )
                         )
                     )
                 )
                (acet-ss-to-list ss)
            )
            (setq ID_leng_lst (mapcar 'vla-get-objectid Lobj_leng))
            (setq field_lst
                     (mapcar
                         '(lambda (id)
                              (acet-str-format
                                  "%<\\AcObjProp Object(%<\\_ObjId %1>%).Length \\f \"%lu2%pr%2\">%+"
                                  (itoa id)
                                  (itoa prec)
                              )
                          )
                         ID_leng_lst
                     )
            )
            (setq str (acet-str-format
                          "%<\\AcExpr (%1) \\f \"%lu2%pr%2\">%"
                          (vl-string-right-trim "+" (apply 'strcat field_lst))
                          (itoa prec)
                      )
            )
            (vla-put-TextString Obj_Text str)
        ) ;_PROGN
    ) ;_IF
    (ACET-SYSVAR-RESTORE)
    (command "undo" "en")
    (princ "\nOK")
    (PRINC)
)
;;;===========================================================================4: AREAs=========
(defun c:fdt4 (/ ss ent_T Obj_Text Lobj_area ID_area_lst str prec field_lst)
    (vl-load-com)
    (command "undo" "be")
    (defun *error* (msg)
        (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
            (princ (strcat "\n** Error: " msg " **"))
        )
        (acet-sysvar-restore)
        (command "undo" "en")
        (princ)
    )
    (acet-sysvar-set '("cmdecho" 0 "osmode" 0))
    (acet-ui-status
        "Select: POLYLINE, HATCH, ARC, CIRCLE, REGION, ELLIPSE for GET SUM AREA"
        "Prompt"
    )
    (setq ss (ssget '((0 . "*POLYLINE,HATCH,ARC,CIRCLE,ELLIPSE,REGION"))))
    (acet-ui-status)
    (if ss
        (progn
            
            (mapcar
                '(lambda (x)
                     (if (vlax-property-available-p (vlax-ename->vla-object x)
                                                    'area
                         )
                         (setq Lobj_area (CONS (vlax-ename->vla-object x) Lobj_area))
                     )
                 )
                (acet-ss-to-list ss)
            )
            (if (null (setq
                          prec (getint
                                   (acet-str-format
                                       "\nEnter number of decimal places: <%1> "
                                       (itoa (getvar "useri4"))
                                   )
                               )
                      )
                )
                (setq prec (getvar "useri4"))
            )
            (setvar "useri4" prec)
            (setq ID_area_lst (mapcar 'vla-get-objectid Lobj_area))
            (setq field_lst
                     (mapcar
                         '(lambda (id)
                              (acet-str-format
                                  "%<\\AcObjProp Object(%<\\_ObjId %1>%).Area \\f \"%lu2%pr%2\">%+"
                                  (itoa id)
                                  (itoa prec)
                              )
                          )
                         ID_area_lst
                     )
            )
            (setq str (acet-str-format "%<\\AcExpr (%1) \\f \"%lu2%pr%2\">%"
                                       (vl-string-right-trim "+" (apply 'strcat field_lst))
                                       (itoa prec)
                      )
            )
            (while (OR (NOT (setq ent_T
                                     (car
                                         (entsel
                                             "\nPick a Text object for set sum area value"
                                         )
                                     )
                            )
                       )
                       (NOT (eq (cdr (assoc 0 (entget ent_T))) "TEXT"))
                   )
                (prompt "\nPick not right TEXT object, please pick again")
            )
            (setq Obj_Text (vlax-ename->vla-object ent_T))
            (vla-put-TextString Obj_Text str)
        ) ;_PROGN
    ) ;_IF
    (ACET-SYSVAR-RESTORE)
    (command "undo" "en")
    (princ "\nOK")
    (PRINC)
)
;;;==================================================================    5: CIRCUMFERENCEs: CHU VI VÒNG TRÒN
(defun c:fdt5 (/  ss ent_T Obj_Text Lobj_CIR ID_CIR_lst str prec field_lst)
    (vl-load-com)
    (command "undo" "be")
    (defun *error* (msg)
        (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
            (princ (strcat "\n** Error: " msg " **"))
        )
        (acet-sysvar-restore)
        (command "undo" "en")
        (princ)
    )
    (acet-sysvar-set '("cmdecho" 0 "osmode" 0))
    (acet-ui-status "Select: CIRCLE for GET SUM CIRCUMFERENCE" "Prompt")
    (setq ss (ssget '((0 . "CIRCLE"))))
    (acet-ui-status)
    (while (OR (NOT (setq ent_T
                             (car
                                 (entsel
                                     "\nPick a Text object for set sum circumference value"
                                 )
                             )
                    )
               )
               (NOT (eq (cdr (assoc 0 (entget ent_T))) "TEXT"))
           )
        (prompt "\nPick not right TEXT object, please pick again")
    )
    (setq Obj_Text (vlax-ename->vla-object ent_T))
    (if ss
        (progn
            (mapcar
                '(lambda (x)
                     (setq Lobj_CIR (CONS (vlax-ename->vla-object x) Lobj_CIR))
                 )
                (acet-ss-to-list ss)
            )
            (if (null (setq
                          prec (getint
                                   (acet-str-format
                                       "\nEnter number of decimal places: <%1> "
                                       (itoa (getvar "useri5"))
                                   )
                               )
                      )
                )
                (setq prec (getvar "useri5"))
            )
            (setvar "useri5" prec)
            (setq ID_CIR_lst (mapcar 'vla-get-objectid Lobj_CIR))
            (setq field_lst
                     (mapcar
                         '(lambda (id)
                              (acet-str-format
                                  "%<\\AcObjProp Object(%<\\_ObjId %1>%).Circumference \\f \"%lu2%pr%2\">%+"
                                  (itoa id)
                                  (itoa prec)
                              )
                          )
                         ID_CIR_lst
                     )
            )
            (setq str (acet-str-format
                          "%<\\AcExpr (%1) \\f \"%lu2%pr%2\">%"
                          (vl-string-right-trim "+" (apply 'strcat field_lst))
                          (itoa prec)
                      )
            )
            (vla-put-TextString Obj_Text str)
        ) ;_PROGN
    ) ;_IF
    (ACET-SYSVAR-RESTORE)
    (command "undo" "en")
    (princ "\nOK")
    (PRINC)
)

910.1 thì nó ra 910.100000; Nhờ các ae chỉ ra chỗ còn khiếm khuyết này)

  • Like 1
  • 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

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

×