Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
tnmtpc

liên kết text diện tích và boundary

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

Mới sưu tầm cái lisp ghi diện tích của boundary và liên kết diện tích với boundary đó, nghĩa là khi thay đổi boundary, diện tích tự động thay đổi theo. lệnh có hai tùy chọn: B dùng để tạo boundary và ghi diện tích; L để ghi diện tích cho boundary có sẵn. Tặng các bạn , ai thích thì xài:(lệnh là tarb)

(defun ufa (notifier-object reactor-object parameter-list) 
 (vl-load-com) 
 (cond 
   ((vlax-property-available-p notifier-object "Area") 
    (setq actDoc 
    (vla-get-ActiveDocument (vlax-get-acad-object))) 
    (vla-SAVE actDoc) 
   ) 
 ) 
) 


(defun plar(/ pt pt1 pt2) 
(setq pt (getpoint"\nStarting Point: ")) 
(setq pt1 (getpoint pt "\nNext Point: ")) 
(command "Pline" pt pt1 "") 
  (while 
      (setq pt2 (getpoint pt1"\nNext Point: ")) 
     (command "pline" "" pt2 "") 
     (command "pedit" pt "j" pt pt2 "" "") 
     (setq pt1 pt2) 
  ) 
(command "pedit" pt "c" "") 
(princ) 
) 

(defun ar5 () 
(SETQ A NIL)
(vl-load-com) 

 (setq cm (getvar "cmdecho")) 
 (setvar"cmdecho" 0) 
 (setq fd (getvar "fielddisplay")) 
 (if (/= fd 0)(setvar"fielddisplay" 0)) 

   (setq ar1 (entsel "\nSelect Area Boundary: ")) 
   (setq ar2 (car ar1)) 
   (setq tab (vlax-ename->vla-object ar2)) 
   (setq oba (vla-get-objectid tab)) 

(setq lu (getvar "lunits")) 
(setq tpt (getpoint"\nSelect Area Text Point: ")) 
(cond 
((= lu 2) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " 
                                   (rtos oba 2 0) ">%).Area \\f \"%lu6%qf1\">%"))) 
((= lu 4) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " 
                                   (rtos oba 2 0) ">%).Area \\f \"%lu2%ct4%qf1 SQ. FT.\">%"))) 
((= lu 5) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " 
                                   (rtos oba 2 0) ">%).Area \\f \"%lu5\">%"))) 
((= lu 3) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " 
                                   (rtos oba 2 0) ">%).Area \\f \"%lu2%ct4%qf1 SQ. FT.\">%"))) 
((= lu 1) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " 
                                   (rtos oba 2 0) ">%).Area \\f \"%lu1\">%"))) 
) 
(command "mtext" tpt "w" "0" lin "") 
(setq plineReactor (vlr-object-reactor (list tab)  "pline Reactor" '((:vlr-modified . ufa))))

(princ) 
)       

(defun c:tarb (/ key) 
(initget  1 "Boundary/label-area Label-area") 
(setq key (getkword "\nWould you like Boundary/label-area or Label-area: ")) 
  (cond 
    ((= key "Boundary/label-area")(plar)(ar5)) 
    ((= key "Label-area")(ar5)) 
  ) 
(princ) 
)

  • Vote tăng 5

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ới sưu tầm cái lisp ghi diện tích của boundary và liên kết diện tích với boundary đó, nghĩa là khi thay đổi boundary, diện tích tự động thay đổi theo. lệnh có hai tùy chọn: B dùng để tạo boundary và ghi diện tích; L để ghi diện tích cho boundary có sẵn. Tặng các bạn , ai thích thì xài:(lệnh là tarb)

(defun ufa (notifier-object reactor-object parameter-list) 
 (vl-load-com) 
 (cond 
   ((vlax-property-available-p notifier-object "Area") 
    (setq actDoc 
    (vla-get-ActiveDocument (vlax-get-acad-object))) 
    (vla-SAVE actDoc) 
   ) 
 ) 
) 


(defun plar(/ pt pt1 pt2) 
(setq pt (getpoint"\nStarting Point: ")) 
(setq pt1 (getpoint pt "\nNext Point: ")) 
(command "Pline" pt pt1 "") 
  (while 
      (setq pt2 (getpoint pt1"\nNext Point: ")) 
     (command "pline" "" pt2 "") 
     (command "pedit" pt "j" pt pt2 "" "") 
     (setq pt1 pt2) 
  ) 
(command "pedit" pt "c" "") 
(princ) 
) 

(defun ar5 () 
(SETQ A NIL)
(vl-load-com) 

 (setq cm (getvar "cmdecho")) 
 (setvar"cmdecho" 0) 
 (setq fd (getvar "fielddisplay")) 
 (if (/= fd 0)(setvar"fielddisplay" 0)) 

   (setq ar1 (entsel "\nSelect Area Boundary: ")) 
   (setq ar2 (car ar1)) 
   (setq tab (vlax-ename->vla-object ar2)) 
   (setq oba (vla-get-objectid tab)) 

(setq lu (getvar "lunits")) 
(setq tpt (getpoint"\nSelect Area Text Point: ")) 
(cond 
((= lu 2) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " 
                                   (rtos oba 2 0) ">%).Area \\f \"%lu6%qf1\">%"))) 
((= lu 4) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " 
                                   (rtos oba 2 0) ">%).Area \\f \"%lu2%ct4%qf1 SQ. FT.\">%"))) 
((= lu 5) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " 
                                   (rtos oba 2 0) ">%).Area \\f \"%lu5\">%"))) 
((= lu 3) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " 
                                   (rtos oba 2 0) ">%).Area \\f \"%lu2%ct4%qf1 SQ. FT.\">%"))) 
((= lu 1) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " 
                                    (rtos oba 2 0) ">%).Area \\f \"%lu1\">%"))) 
) 
(command "mtext" tpt "w" "0" lin "") 
(setq plineReactor (vlr-object-reactor (list tab)  "pline Reactor" '((:vlr-modified . ufa))))

(princ) 
)       

(defun c:tarb (/ key) 
(initget  1 "Boundary/label-area Label-area") 
(setq key (getkword "\nWould you like Boundary/label-area or Label-area: ")) 
  (cond 
    ((= key "Boundary/label-area")(plar)(ar5)) 
    ((= key "Label-area")(ar5)) 
  ) 
(princ) 
)

 

CAD báo lỗi bạn ơi : ; error: AutoCAD variable setting rejected: "fielddisplay" 0

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
CAD báo lỗi bạn ơi : ; error: AutoCAD variable setting rejected: "fielddisplay" 0

Se7en thao tác thế nào mà báo lỗi? Nhớ là Cad 14 không chơi được thằng này. Sau khi load file xong gõ lệnh tarb, có hai tùy chọn: B và L, nếu chọn B, thực hiện vẽ boundary, xong chọn vị trí ghi text; Nếu chọn L:chọn đối tượng, chọn vị trí ghi text. Làm lại lẫn nữa xem, mình thực hiện trên Cad2005, Ok mà

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
Se7en thao tác thế nào mà báo lỗi? Nhớ là Cad 14 không chơi được thằng này. Sau khi load file xong gõ lệnh tarb, có hai tùy chọn: B và L, nếu chọn B, thực hiện vẽ boundary, xong chọn vị trí ghi text; Nếu chọn L:chọn đối tượng, chọn vị trí ghi text. Làm lại lẫn nữa xem, mình thực hiện trên Cad2005, Ok mà

 

tôi sử dụng cad 2004, cũng gặp lỗi như Se7en !

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ôi sử dụng cad 2004, cũng gặp lỗi như Se7en !

Vậy thì trong các phiên bản trước 2005 không có biến hệ thống "fielddisplay" rồi! hỏi Bác Hòanh hoặc Bác Ssg có thể tạo biến này đượ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ậy thì trong các phiên bản trước 2005 không có biến hệ thống "fielddisplay" rồi! hỏi Bác Hòanh hoặc Bác Ssg có thể tạo biến này được không

Lisp không tạo được, chỉ đơn giản đây là một chức năng hệ thống mới của AutoCAD (cũng như dynamicblock).

 

Bạn xem thêm bài viết này để hiểu rõ hơn về field

Ánh xạ text vào tên layout: http://www.cadviet.com/forum/index.php?showtopic=2062

Ánh xạ text vào giá trị text: http://www.cadviet.com/forum/index.php?showtopic=1515

Ánh xạ text vào diện tích đối tượng: http://www.cadviet.com/forum/index.php?showtopic=35

  • 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
Mới sưu tầm cái lisp ghi diện tích của boundary và liên kết diện tích với boundary đó, nghĩa là khi thay đổi boundary, diện tích tự động thay đổi theo. lệnh có hai tùy chọn: B dùng để tạo boundary và ghi diện tích; L để ghi diện tích cho boundary có sẵn. Tặng các bạn , ai thích thì xài:(lệnh là tarb)

Bác ơi cho em hỏi: kết quả xuất ra hình như là đơn vị là mm2 bây giờ mình muốn chỉnh đơn vị là m2 thì làm thế nào?ah và mình muốn chỉnh text cho nó bé xuống? chữ to kinh 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

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  

×