Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Người theo dõi 0
nguyenkienAgr

Nhờ sửa lỗi LISP

Bởi nguyenkienAgr , trong AutoLisp

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

nguyenkienAgr    8

nguyenkienAgr
Đã đăng

Chào các bạn, 

Mình Viết 1 đoạn lisp với mục đích chèn 1 block dạng attributes đã được tạo từ trước. Nhưng không hiểu bị lỗi ở đâu mà không chạy được? Bug thì không báo lỗi gì nhưng các attribute thì không thấy cập nhật?

Đoạn mã của mình đây ạ: (file chứa block mình để ở comment do không up cùng bài viết được). Mong được giúp đỡ ạ.

 

(defun c:InsertBlockWithAttributes (/ pt blkRef blkName attDefs attValues attEnt attName attData attPos attValue)
  (setq blkName "PhiTinh")
  (setq attDefs '("PHITINHVAN" "PHITINHNIEN_THUAN" "PHITINHNIEN_NGHICH"))
  (setq attValues '("a" "b" "c"))

  ;; Yêu cầu người dùng chọn điểm để chèn block
  (setq pt (getpoint "\nChọn điểm để chèn block: "))
  (if pt
    (progn
      ;; Chèn block vào điểm đã chọn
      (setq blkRef (entmakex (list '(0 . "INSERT")
                                   (cons 10 pt)
                                   (cons 2 blkName)
                                   (cons 41 1.0) ;; Scale X
                                   (cons 42 1.0) ;; Scale Y
                                   (cons 43 1.0) ;; Scale Z
                                   (cons 50 0.0) ;; Rotation
                                   (cons 70 0)   ;; Block Attribute Flags
                                   )))

      ;; Kiểm tra nếu block được chèn thành công
      (if blkRef
        (progn
          ;; Duyệt qua các entity liên quan đến block reference
          (setq attEnt (entnext blkRef)) ; Bắt đầu với entity kế tiếp sau block reference
          (while attEnt
            (setq attData (entget attEnt))
            ;; Kiểm tra xem entity có phải là attribute không
            (if (eq (cdr (assoc 0 attData)) "ATTRIB")
              (progn
                (setq attName (cdr (assoc 2 attData)))
                ;; Tìm chỉ số của thuộc tính trong danh sách
                (setq attPos (vl-position attName attDefs))
                (if attPos
                  (setq attValue (nth attPos attValues))
                  (princ "\nKhông tìm thấy thuộc tính trong danh sách.")
                )
                ;; Cập nhật giá trị thuộc tính
                (entmod (subst (cons 1 attValue)
                               (assoc 1 attData)
                               attData))
                (entupd attEnt)
              )
            )
            ;; Lấy entity kế tiếp
            (setq attEnt (entnext attEnt))
          )
          (princ "\nBlock PhiTinh đã được chèn và các thuộc tính đã được cập nhật.")
        )
        (princ "\nKhông thể chèn block.")
      )
    )
  (princ)
)
)

  • Vote giảm 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

tannguyen291    157

tannguyen291
Đã đăng

chèn block att nếu sử dụng entmake sẽ không tạo attribute trong block. (nếu muốn dùng cách này cần thêm lệnh attsync trong command.)

để tối ưu nên dùng vla:

(vla-InsertBlock Object<vla-object> InsertionPoint<variant:xyz> Name<string> Xscale?<double> Yscale?<double> Zscale?<double> Rotation?<double> Password?<variant>)

  • 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

nguyenkienAgr    8

nguyenkienAgr
Đã đăng
10 giờ trước, tannguyen291 đã nói:

chèn block att nếu sử dụng entmake sẽ không tạo attribute trong block. (nếu muốn dùng cách này cần thêm lệnh attsync trong command.)

để tối ưu nên dùng vla:

(vla-InsertBlock Object<vla-object> InsertionPoint<variant:xyz> Name<string> Xscale?<double> Yscale?<double> Zscale?<double> Rotation?<double> Password?<variant>)

Cám ơn ý kiến của bạn!. Mình dùng thử cách của bạn nhưng đến phần truy xuất thông tin block (để thêm các attribute) thì không được. Bạn có thể viết giúp mình 1 đoạn mã hoàn chỉnh được không?
Mình thử dùng hàm command như dưới thì được, nhưng với cách này cú pháp lệnh ở CAD đời thấp (2007) và CAD đời cao thì ko giống nhau nên bất tiện. Vậy nên vẫn phải nhờ  ý kiến của các bạn ạ!.
  

(command "_.INSERT" BlockName Pos ScaleX ScaleY RotationDeg Tag1Value Tag2Value Tag3Value)

 

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

Duong Nhat Duy    388

Duong Nhat Duy
Đã đăng

Đây nhé bạn: 

;;;Chen Block Att, Dynamic
;  blkname [str]: ten block
;  pt [list]: toa do diem chen
;  layer [str]: ten layer
;  scale [real] or [list]: block scale, vi du 1.0 hoac '(1.0 2.5 1.0)
;  rotation [real]: goc xoay block (radian)
;  attribute [list]: list of attribute, vi du '(("TAG1" . "123") ("TAG2" . "ABC"))
;  dynamic [list]: list of dynamic, vi du '(("Angle1" . (/ pi 2)) ("Flip state1" . 1))
;=> return [entity]: ket qua tra ve entity cua block vua chen
(defun ND:vla-insert (blkname pt layer scale rotation attribute dynamic / acdoc acspc itm lst obj)
  (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (setq acspc (vlax-get-property acdoc (if (= (getvar "CVPORT") 1) 'paperspace 'modelspace)))
  (if (listp scale)
    (setq obj (vla-InsertBlock acspc (vlax-3d-point pt) blkname (car scale) (cadr scale) (caddr scale) rotation))
    (setq obj (vla-InsertBlock acspc (vlax-3d-point pt) blkname scale scale scale rotation))
    )
  (vlax-put-property obj 'layer layer)
  (foreach att (vlax-invoke obj 'getattributes)
    (if (setq itm (assoc (vla-get-tagstring att) attribute))
      (vla-put-textstring att (cdr itm))
      )
    )
  (setq dynamic (mapcar '(lambda (lst) (cons (strcase (car lst)) (cdr lst))) dynamic))
  (foreach dyn (vlax-invoke obj 'getdynamicblockproperties)
    (if (setq itm (assoc (strcase (vla-get-propertyname dyn)) dynamic))
      (vla-put-value dyn (vlax-make-variant (cdr itm) (vlax-variant-type (vla-get-value dyn))))
      )
    )
  (vlax-vla-object->ename obj)
  )

;Vi du cach dung
(setq ent1 (ND:vla-insert "Block1" '(0 0) "0" 1 0 nil nil))
(setq ent2 (ND:vla-insert "Block2" (getpoint) (getvar "CLAYER") '(2 2 1) (/ pi 2) (list (cons "TAG1" "123") (cons "TAG2" "ABC")) (list (cons "Angle1" (/ pi 2)) (cons "Flip state1" 1))))

 

  • 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

nguyenkienAgr    8

nguyenkienAgr
Đã đăng
18 giờ trước, Duong Nhat Duy đã nói:

Đây nhé bạn: 


;;;Chen Block Att, Dynamic
;  blkname [str]: ten block
;  pt [list]: toa do diem chen
;  layer [str]: ten layer
;  scale [real] or [list]: block scale, vi du 1.0 hoac '(1.0 2.5 1.0)
;  rotation [real]: goc xoay block (radian)
;  attribute [list]: list of attribute, vi du '(("TAG1" . "123") ("TAG2" . "ABC"))
;  dynamic [list]: list of dynamic, vi du '(("Angle1" . (/ pi 2)) ("Flip state1" . 1))
;=> return [entity]: ket qua tra ve entity cua block vua chen
(defun ND:vla-insert (blkname pt layer scale rotation attribute dynamic / acdoc acspc itm lst obj)
  (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (setq acspc (vlax-get-property acdoc (if (= (getvar "CVPORT") 1) 'paperspace 'modelspace)))
  (if (listp scale)
    (setq obj (vla-InsertBlock acspc (vlax-3d-point pt) blkname (car scale) (cadr scale) (caddr scale) rotation))
    (setq obj (vla-InsertBlock acspc (vlax-3d-point pt) blkname scale scale scale rotation))
    )
  (vlax-put-property obj 'layer layer)
  (foreach att (vlax-invoke obj 'getattributes)
    (if (setq itm (assoc (vla-get-tagstring att) attribute))
      (vla-put-textstring att (cdr itm))
      )
    )
  (setq dynamic (mapcar '(lambda (lst) (cons (strcase (car lst)) (cdr lst))) dynamic))
  (foreach dyn (vlax-invoke obj 'getdynamicblockproperties)
    (if (setq itm (assoc (strcase (vla-get-propertyname dyn)) dynamic))
      (vla-put-value dyn (vlax-make-variant (cdr itm) (vlax-variant-type (vla-get-value dyn))))
      )
    )
  (vlax-vla-object->ename obj)
  )

;Vi du cach dung
(setq ent1 (ND:vla-insert "Block1" '(0 0) "0" 1 0 nil nil))
(setq ent2 (ND:vla-insert "Block2" (getpoint) (getvar "CLAYER") '(2 2 1) (/ pi 2) (list (cons "TAG1" "123") (cons "TAG2" "ABC")) (list (cons "Angle1" (/ pi 2)) (cons "Flip state1" 1))))

 

Cám ơn bạn nhiều!. Dựa vào đoạn mã của bạn mình đã làm được rồi ạ!.

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

duy782006    1592

duy782006
Đã đăng
Vào lúc 6/9/2024 tại 00:50, nguyenkienAgr đã nói:

Chào các bạn, 

Mình Viết 1 đoạn lisp với mục đích chèn 1 block dạng attributes đã được tạo từ trước. Nhưng không hiểu bị lỗi ở đâu mà không chạy được? Bug thì không báo lỗi gì nhưng các attribute thì không thấy cập nhật?

Đoạn mã của mình đây ạ: (file chứa block mình để ở comment do không up cùng bài viết được). Mong được giúp đỡ ạ.

 

(defun c:InsertBlockWithAttributes (/ pt blkRef blkName attDefs attValues attEnt attName attData attPos attValue)
  (setq blkName "PhiTinh")
  (setq attDefs '("PHITINHVAN" "PHITINHNIEN_THUAN" "PHITINHNIEN_NGHICH"))
  (setq attValues '("a" "b" "c"))

  ;; Yêu cầu người dùng chọn điểm để chèn block
  (setq pt (getpoint "\nChọn điểm để chèn block: "))
  (if pt
    (progn
      ;; Chèn block vào điểm đã chọn
      (setq blkRef (entmakex (list '(0 . "INSERT")
                                   (cons 10 pt)
                                   (cons 2 blkName)
                                   (cons 41 1.0) ;; Scale X
                                   (cons 42 1.0) ;; Scale Y
                                   (cons 43 1.0) ;; Scale Z
                                   (cons 50 0.0) ;; Rotation
                                   (cons 70 0)   ;; Block Attribute Flags
                                   )))

      ;; Kiểm tra nếu block được chèn thành công
      (if blkRef
        (progn
          ;; Duyệt qua các entity liên quan đến block reference
          (setq attEnt (entnext blkRef)) ; Bắt đầu với entity kế tiếp sau block reference
          (while attEnt
            (setq attData (entget attEnt))
            ;; Kiểm tra xem entity có phải là attribute không
            (if (eq (cdr (assoc 0 attData)) "ATTRIB")
              (progn
                (setq attName (cdr (assoc 2 attData)))
                ;; Tìm chỉ số của thuộc tính trong danh sách
                (setq attPos (vl-position attName attDefs))
                (if attPos
                  (setq attValue (nth attPos attValues))
                  (princ "\nKhông tìm thấy thuộc tính trong danh sách.")
                )
                ;; Cập nhật giá trị thuộc tính
                (entmod (subst (cons 1 attValue)
                               (assoc 1 attData)
                               attData))
                (entupd attEnt)
              )
            )
            ;; Lấy entity kế tiếp
            (setq attEnt (entnext attEnt))
          )
          (princ "\nBlock PhiTinh đã được chèn và các thuộc tính đã được cập nhật.")
        )
        (princ "\nKhông thể chèn block.")
      )
    )
  (princ)
)
)

Trong lisp này bạn sửa (cons 70 0) thành (cons 70 2) xem nó chạy đc ko.

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

nguyenkienAgr    8

nguyenkienAgr
Đã đăng
17 giờ trước, duy782006 đã nói:

Trong lisp này bạn sửa (cons 70 0) thành (cons 70 2) xem nó chạy đc ko.

Trong CAD 2007 thì không chạy dc bạn. môi trường CAD cao hơn mình chưa thử vì bị lỗi chưa cài lại dc

.

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
Đăng nhập để thực hiện theo  
Người theo dõi 0
Về Đầu Trang AutoLisp
×