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

[tnmtpc 207]

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) 
)

[se7en 5]

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

[tnmtpc 207]

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à

[vbao 80]

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 !

[tnmtpc 207]

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

[Nguyen Hoanh 4.663]

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

[minhtuan1412 0]

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!?