Nhờ các chú các bác hỗ trợ sửa lisp ạ

[Xuân Lộc 2004 0]

Cháu tìm được cái lisp này nhưng không hiểu sao dùng rất lag, chậm (chắc do máy cháu yếu) cháu muốn lisp lấy được diện tích của hatch nữa ạ và lisp cho phép gán vào text, mtext, atttext đồng thời với tạo text sẵn như lisp đang có ạ.
 

(defun C:FTT (/ obj obj-type tkq text-style text-height rotation insertion-point)
  ;; Chon doi tuong nguon
  (setq obj (car (nentsel "\nChọn đối tượng là TEXT, MTEXT, ATTRIBUTE hoặc DIMENSION: ")))
  (if obj
    (progn
      (setq obj (vlax-ename->vla-object obj)
            obj-type (vla-get-ObjectName obj))
      ;; Xử lý thông tin từ TEXT, MTEXT, ATTRIB, ATTDEF, hoặc DIMENSION
      (cond
        ;; Doi tuong TEXT
        ((equal obj-type "AcDbText")
         (setq tkq (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-objectid obj)) ">%).TextString>%")
               text-style (vla-get-StyleName obj)
               text-height (vla-get-Height obj)
               rotation (if (vlax-property-available-p obj 'Rotation) (vla-get-Rotation obj) 0.0)
               insertion-point (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint obj)))))

        ;; Đối tượng MTEXT
        ((equal obj-type "AcDbMText")
         (setq tkq (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-objectid obj)) ">%).Text>%")
               text-style (vla-get-StyleName obj)
               text-height (vla-get-Height obj) ;; Đúng
               rotation (vla-get-Rotation obj)
               insertion-point (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint obj)))))

        ;; Đối tượng ATTDEF hoặc ATTRIB
        ((or (equal obj-type "AcDbAttributeDefinition")
             (equal obj-type "AcDbAttribute"))
         (setq tkq (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-objectid obj)) ">%).TextString>%")
               text-style (if (vlax-property-available-p obj 'StyleName) (vla-get-StyleName obj) "")
               text-height (if (vlax-property-available-p obj 'Height) (vla-get-Height obj) 0.0)
               rotation (if (vlax-property-available-p obj 'Rotation) (vla-get-Rotation obj) 0.0)
               insertion-point (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint obj)))))

        ;; Đối tượng DIMENSION
        ((equal obj-type "AcDbDimension")
         ;; Lấy giá trị Text trong Dimension
         (setq tkq (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-objectid obj)) ">%).Measurement>%")
               text-style (vla-get-StyleName obj)
               text-height (vla-get-TextHeight obj)
               rotation (if (vlax-property-available-p obj 'Rotation) (vla-get-Rotation obj) 0.0)
               insertion-point (vlax-safearray->list (vlax-variant-value (vla-get-TextPosition obj)))))

        ;; Đối tượng không được hỗ trợ
        (T (princ "\nĐối tượng chọn không phải là TEXT, MTEXT, ATTRIBUTE hoặc DIMENSION.")
           (setq obj nil)))
      
      ;; Nếu đối tượng hợp lệ, yêu cầu người dùng chon vị trí tạo TEXT mới
      (if obj
        (progn
          (setq insertion-point (getpoint "\nChọn vị trí tạo FIELD TEXT mới: "))
          (if insertion-point
            (progn
              ;; Tạo TEXT mới Field tại vị trí được chọn
              (entmake
                (list
                  (cons 0 "TEXT") ; đối tượng la TEXT
                  (cons 8 (vla-get-Layer obj)) ; Lớp giống với đối tượng đã chọn
                  (cons 7 text-style) ; Kiểu TEXT giống với đối tượng đã chọn
                  (cons 40 text-height) ; Chiều cao TEXT
                  (cons 10 insertion-point) ; Điểm chèn
                  (cons 1 tkq) ; Nội dung là Field
                  (cons 50 rotation) ; Góc xoay
                )
              )
              (vl-cmdf "regen")
              (princ "\nFIELD TEXT mới đã được tạo thành công.")
            )
            (princ "\nKhông chọn vị trí tạo FIELD TEXT mới.")
          )
        )
      )
    )
    (princ "\nKhông chọn đối tượng hợp lệ.")
  )
  (princ)
)
 

[Duong Nhat Duy 423]

Lisp trên lag có thể là do hàm Regen. Hoặc bạn có thể tham khảo lisp của mình, nó thỏa mãn tất cả yêu cầu của bạn nói ở trên.

Bạn vào thiết lập, tick chọn Tạo Field, rồi dùng lệnh DT4

 

[Xuân Lộc 2004 0]

Vào lúc 24/12/2024 tại 10:59, Duong Nhat Duy đã nói:

Lisp trên lag có thể là do hàm Regen. Hoặc bạn có thể tham khảo lisp của mình, nó thỏa mãn tất cả yêu cầu của bạn nói ở trên.

Bạn vào thiết lập, tick chọn Tạo Field, rồi dùng lệnh DT4

 

cháu cảm ơn, vậy các bác, các chú giúp cháu bỏ ý đầu đi còn ý thứ 2 là sửa lisp cho phép gán vào text, mtext, atttext đồng thời với tạo text sẵn như lisp đang có ạ.

[Duong Nhat Duy 423]

1 giờ} trướ}c, Xuân Lộc 2004 đã nói:

cháu cảm ơn, vậy các bác, các chú giúp cháu bỏ ý đầu đi còn ý thứ 2 là sửa lisp cho phép gán vào text, mtext, atttext đồng thời với tạo text sẵn như lisp đang có ạ.

Bạn đọc kỹ bài viết đi, trong đó có hết mà !