Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
6 replies to this topic

#1 tnmtpc

tnmtpc

    biết dimcontinue

  • Members
  • PipPipPipPipPip
  • 370 Bài viết
Điểm đánh giá: 206 (khá)

Đã gửi 01 February 2008 - 07:30 PM

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

  • 5

#2 se7en

se7en

    biết vẽ ellipse

  • Members
  • PipPip
  • 52 Bài viết
Điểm đánh giá: 5 (bình thường)

Đã gửi 02 February 2008 - 09:07 AM

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
  • 0
Mê xe và súng
Thích để súng trong xe

#3 tnmtpc

tnmtpc

    biết dimcontinue

  • Members
  • PipPipPipPipPip
  • 370 Bài viết
Điểm đánh giá: 206 (khá)

Đã gửi 02 February 2008 - 09:50 AM

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à
  • 0

#4 vbao

vbao

    biết lệnh array

  • CADViet Team
  • PipPipPip
  • 184 Bài viết
Điểm đánh giá: 80 (tàm tạm)

Đã gửi 02 February 2008 - 04:47 PM

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 !
  • 0

#5 tnmtpc

tnmtpc

    biết dimcontinue

  • Members
  • PipPipPipPipPip
  • 370 Bài viết
Điểm đánh giá: 206 (khá)

Đã gửi 02 February 2008 - 04:52 PM

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
  • 0

#6 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 4105 Bài viết
Điểm đánh giá: 4495 (đỉnh cao)

Đã gửi 03 February 2008 - 10:29 AM

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

#7 minhtuan1412

minhtuan1412

    Chưa sử dụng CAD

  • Members
  • Pip
  • 4 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 01 November 2008 - 07:27 AM

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