Đến nội dung


Hình ảnh
* * * - - 1 Bình chọn

LISP : Ánh xạ giá trị đối tượng (thay đổi giá trị nguồn -> Đích cập nhật theo)


  • Please log in to reply
76 replies to this topic

#21 master_worse

master_worse

    biết lệnh offset

  • Advance Member
  • PipPipPip
  • 170 Bài viết
Điểm đánh giá: 87 (tàm tạm)

Đã gửi 20 October 2009 - 06:03 PM

Chào các bạn
Nhân đọc bài Ánh xạ giá trị đối tượng text, nguồn đổi giá trị, đích bị sửa của bác Hoành,
xin gửi các bạn LISP : Ánh xạ giá trị đối tượng gồm
1 . LinkT : Ánh xạ giá trị Text
2 . LinkA : Ánh xạ giá trị Diện tích
chú ý : khi sửa giá trị ở đối tượng nguồn, đối tượng đích (text) chỉ update sau khi sử dụng lệnh REGEN, SAVE, PLOT, ...
(defun c:LinkA (/ ss_ent ent ss e cmd sole tile Suff Pref);Link Area
-----
(setq Pref "S=")
(setq Suff " mm2")
------


có thể thêm Pref và Suff vào chuổi đích vậy có cách nào chỉ lấy ra một đoạn chuổi nguồn không?
ví dụ
nguồn: 15 dia8 a=20
đích thứ nhất lấy số lượng 15
đích thứ hai lấy đường kính 8
đích thứ ba lấy khoảng cách 20

Thanks!
  • 0

Ngu dốt không đáng thẹn bằng thiếu ý chí học hỏi


Tri thức làm người ta khiêm tốn, ngu si làm người ta kiêu ngạo (Ngạn ngữ Anh)


#22 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 21 October 2009 - 06:09 AM

Chào Tue_NV
Lâu rồi trên lập trình AutoLisp của CadViet mới có ý tuởng mới : sử dụng Group để lọc và chọn đối tuợng.
Đi theo đuờng mòn hoài khó tới đích quá!
Cám ơn bạn nhiều.

Cảm ơn anh gia_bach
Đúng là đi theo đuờng mòn hoài khó tới đích. Thật sự là Tue_NV cũng thấy thế và từ khi đọc các bài viết của anh trong topic này, Tue_NV cảm thấy Lisp đã làm nhiều công việc thực sự rất hiệu quả, đặc biệt là REACTOR
Anh gia_bach cho Tue_NV hỏi về Lisp LinkR của anh trong topic này :

Bạn tham khảo 1 ví dụ về REACTOR :
- Cập nhật bán kính (đuờng kính) vòng tròn khi có sự thay đổi bán kính (đuờng kính) của bất kỳ đối tuợng vòng tròn đã chọn.
đối tượng đích cập nhật ngay sau khi đối tượng nguồn thay đổi không cần lệnh Regen, ...
Cách sử dụng :
1. sau khi load Lisp, tại dấu nhắc gõ lệnh LinkR -> chọn các vòng tròn cần Link với nhau -> enter kết thúc lệnh.
2. thay đổi bán kính (đuờng kính) của bất kỳ đối tuợng vòng tròn đã chọn ở buớc 1 -> xem kết quả các vòng tròn còn lại trong tập hợp đã chọn ở buớc 1.

(defun c:LinkR (/ ss objlst obj_reactor); Link Radius
(if (setq ss (ssget '((0 . "CIRCLE"))) )
(progn
(vl-load-com)
(setq objlst (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
(setq obj_reactor (vlr-object-reactor objlst nil '((:vlr-modified . callback))))
)
)
)
(defun callback (notifier-object obj_reactor parameter-list / objlist newrad)
(setq objlist (vlr-owners obj_reactor))
(setq newrad (vla-get-radius notifier-object))
(if
(= notifier-object (nth 0 objlist))
(vla-put-radius (nth 1 objlist) newrad)
(vla-put-radius (nth 0 objlist) newrad)
)
)


Tue_NV đã sử dụng Lisp này và nhận thấy : sau khi sử dụng Lisp và hiệu chỉnh bán kính đường tròn bằng Grips thì thấy có 1 số đường tròn thay đổi theo, 1 số đường tròn không chịu thay đổi theo. Tue_NV không hiểu nguyên nhân làm sao? Anh giải thích dùm em tí nhé.
Đây là file mà Tue_NV chạy thử với lisp LINKR : LinkR.dwg
Cảm ơn anh gia_bach
  • 0

#23 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1432 Bài viết
Điểm đánh giá: 1425 (rất tốt)

Đã gửi 21 October 2009 - 10:40 AM

........
Tue_NV đã sử dụng Lisp này và nhận thấy : sau khi sử dụng Lisp và hiệu chỉnh bán kính đường tròn bằng Grips thì thấy có 1 số đường tròn thay đổi theo, 1 số đường tròn không chịu thay đổi theo.
..................

Chào Tue_NV
Lisp LINKR bị lỗi như Tue_NV đã phát hiện.
(sau khi Post Lisp LINKR lên diễn đàn vài ngày tui cũng đã phát hiện lỗi này, nhưng chờ mãi không thấy ai có ý kiến phản hồi. "No Table")
Gửi Tue_NV Lisp đã fix lỗi. Tue_NV test lại dùm, cám ơn nhiều.
(defun c:LinkR (/ ss objlst obj_reactor); Link Radius
(if (setq ss (ssget '((0 . "CIRCLE"))) )
(progn
(vl-load-com)
(setq objlst (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
(setq obj_reactor (vlr-object-reactor objlst nil '((:vlr-modified . callback))))
)
)
)
(defun callback (notifier-object obj_reactor parameter-list / objlist newrad)
(setq objlist (vlr-owners obj_reactor))
(setq newrad (vla-get-radius notifier-object))
(foreach obj objlist
(if (/= (vla-get-radius obj)newrad)
(vla-put-radius obj newrad)
)
)
)

  • 4

#24 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1432 Bài viết
Điểm đánh giá: 1425 (rất tốt)

Đã gửi 21 October 2009 - 10:51 AM

có thể thêm Pref và Suff vào chuổi đích vậy có cách nào chỉ lấy ra một đoạn chuổi nguồn không?
ví dụ
nguồn: 15 dia8 a=20
đích thứ nhất lấy số lượng 15
đích thứ hai lấy đường kính 8
đích thứ ba lấy khoảng cách 20

Chào master_worse
Rất tiếc là lệnh FIELD trong CAD chưa cho phép làm điều này.

Khi đóng bản vẽ thì sự liên kết này cũng mất đi luôn, vậy có cách nào để không làm mất sự liên kết này không?

Gửi bạn LISP link text đã cập nhật phần liên kết sau khi đóng bản vẽ .
chú ý : để liên kết đuợc thưc hiện, list phải đuợc Appload truớc khi sử dụng (đưa list vào mục Startup Suite)
(defun c:LinkT (/ ss objlst ); Link Text
(if (setq ss (ssget '((0 . "TEXT"))) )
(progn
(vl-load-com)
(setq objlst (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
(if (and obj_reactor (vlr-added-p obj_reactor))
(vlr-remove obj_reactor))
(setq obj_reactor (vlr-pers (vlr-object-reactor objlst nil '((:vlr-modified . LinkText)
(:vlr-erased . eraseEnt) ))))
(princ (strcat "\n Da thuc hien Link " (itoa(sslength ss)) " Text voi nhau !"
"\n Goi lenh Edit Text (ddedit) de cap nhat gia tri."))
(princ)
)
)
)
(defun LinkText (notifier-object obj_reactor parameter-list / objlist str)
(setq objlist (vlr-owners obj_reactor)
str (vla-get-TextString notifier-object))
(foreach obj objlist
(if (/= (vla-get-TextString obj)str)
(vla-put-TextString obj str)
)
)
)
(defun eraseEnt (notifier-object obj_reactor parameter-list)
(alert "Ban da thuc hien lenh Erase tu doi tuong REACTOR.\nLinkText da bi huy bo : Cac Text khong con Link voi nhau !")
(vlr-owner-remove obj_reactor notifier-object)
(vlr-remove obj_reactor)
(princ)
)

  • 3

#25 master_worse

master_worse

    biết lệnh offset

  • Advance Member
  • PipPipPip
  • 170 Bài viết
Điểm đánh giá: 87 (tàm tạm)

Đã gửi 21 October 2009 - 10:53 AM

thanks
  • 0

Ngu dốt không đáng thẹn bằng thiếu ý chí học hỏi


Tri thức làm người ta khiêm tốn, ngu si làm người ta kiêu ngạo (Ngạn ngữ Anh)


#26 HoangSon614

HoangSon614

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 254 Bài viết
Điểm đánh giá: 66 (tàm tạm)

Đã gửi 21 October 2009 - 11:23 AM

Chào master_worse
Rất tiếc là lệnh FIELD trong CAD chưa cho phép làm điều này.

Gửi bạn LISP link text đã cập nhật phần liên kết sau khi đóng bản vẽ .
chú ý : để liên kết đuợc thưc hiện, list phải đuợc Appload truớc khi sử dụng (đưa list vào mục Startup Suite)

(defun c:LinkT (/ ss objlst ); Link Text
(if (setq ss (ssget '((0 . "TEXT"))) )
(progn
(vl-load-com)
(setq objlst (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
(if (and obj_reactor (vlr-added-p obj_reactor))
(vlr-remove obj_reactor))
(setq obj_reactor (vlr-pers (vlr-object-reactor objlst nil '((:vlr-modified . LinkText)
(:vlr-erased . eraseEnt) ))))
(princ (strcat "\n Da thuc hien Link " (itoa(sslength ss)) " Text voi nhau !"
"\n Goi lenh Edit Text (ddedit) de cap nhat gia tri."))
(princ)
)
)
)
(defun LinkText (notifier-object obj_reactor parameter-list / objlist str)
(setq objlist (vlr-owners obj_reactor)
str (vla-get-TextString notifier-object))
(foreach obj objlist
(if (/= (vla-get-TextString obj)str)
(vla-put-TextString obj str)
)
)
)
(defun eraseEnt (notifier-object obj_reactor parameter-list)
(alert "Ban da thuc hien lenh Erase tu doi tuong REACTOR.\nLinkText da bi huy bo : Cac Text khong con Link voi nhau !")
(vlr-owner-remove obj_reactor notifier-object)
(vlr-remove obj_reactor)
(princ)
)


Lisp rất hay, nhưng cho mình hỏi tý, Gia_bach có thể chỉnh lại như lệnh "field" của cad được không? (cụ thể là: đối tượng nguồn thay đổi thì đối tượng đích thay đổi theo nhưng thêm "background color" làm mờ đối tượng đích bằng lớp màu trắng sữa phủ lên đối tượng để khỏi nhầm lẫn). Cảm ơn gia_ bach
  • 0
-~-~-~-~-~-~-~-~-~-~-~-~-~-~
Hôm qua là sự học hỏi nhận được sau 1 ngày
Ngày mai là sự bí ẩn mà chúng ta sẽ khám phá


------------------------------------------
http://www.tailieukythuat.com

#27 master_worse

master_worse

    biết lệnh offset

  • Advance Member
  • PipPipPip
  • 170 Bài viết
Điểm đánh giá: 87 (tàm tạm)

Đã gửi 21 October 2009 - 05:50 PM

Lisp rất hay, nhưng cho mình hỏi tý, Gia_bach có thể chỉnh lại như lệnh "field" của cad được không? (cụ thể là: đối tượng nguồn thay đổi thì đối tượng đích thay đổi theo nhưng thêm "background color" làm mờ đối tượng đích bằng lớp màu trắng sữa phủ lên đối tượng để khỏi nhầm lẫn). Cảm ơn gia_ bach

trong lisp nay: các đối tượng này được liên kết với nhau một đối tựơng đổi thì các đối tựơng khác cùng đổi theo (không có nguồn và đích)


Tiền bối gia_bach cho em hỏi có cách nào để không cho edit trực tiếp một đối tượng không(để dùng làm đối tượng đích)
hiện tại em chỉ xác định đối tựong đích rồi đặt dkiện để cac đối tượng khác không bị thay đổi khi tựong đích bị thay đổi thôi :bigsmile:
  • 0

Ngu dốt không đáng thẹn bằng thiếu ý chí học hỏi


Tri thức làm người ta khiêm tốn, ngu si làm người ta kiêu ngạo (Ngạn ngữ Anh)


#28 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1432 Bài viết
Điểm đánh giá: 1425 (rất tốt)

Đã gửi 22 October 2009 - 07:33 AM

......
có thể chỉnh lại như lệnh "field" của cad được không? (cụ thể là: đối tượng nguồn thay đổi thì đối tượng đích thay đổi theo nhưng thêm "background color" làm mờ đối tượng đích bằng lớp màu trắng sữa phủ lên đối tượng để khỏi nhầm lẫn).

Do CAD không hổ trợ thuộc tính "background color" cho đối tượng TEXT -> chưa tìm đuợc cách thích hợp để làm mờ đối tượng đích.


.......
có cách nào để không cho edit trực tiếp một đối tượng không(để dùng làm đối tượng đích)
hiện tại em chỉ xác định đối tựong đích rồi đặt dkiện để cac đối tượng khác không bị thay đổi khi tựong đích bị thay đổi thôi :bigsmile:

Trong t/hợp này bạn có thể xét thêm 1 điều kiện thuộc tính nào đó để phân biệt nguồn và đích.
Vd: đưa đối tuợng nguồn vào layer có tên xác định, đối tuợng đích ở layer bình thuờng. viết hàm đáp ứng điều kiện tên Layer của đối tuợng trùng với layer cho truớc thì mới xử lý "LinkText"
(defun LinkText (notifier-object obj_reactor parameter-list / objlist str)
(if (= (vla-get-Layer notifier-object) "Layer_nguon"); vd : ten layer = "Layer_nguon"
(progn
(setq objlist (vlr-owners obj_reactor)
str (vla-get-TextString notifier-object))
(foreach obj objlist
(if (/= (vla-get-TextString obj)str)
(vla-put-TextString obj str)
)
)
)
)
)

  • 3

#29 master_worse

master_worse

    biết lệnh offset

  • Advance Member
  • PipPipPip
  • 170 Bài viết
Điểm đánh giá: 87 (tàm tạm)

Đã gửi 23 October 2009 - 05:37 PM

(defun C:L2T (/ OBJLINE SS OBJLST OBJ;|OBJ-REACTOR|;)
(vl-load-com)
(setq OBJLINE (vlax-ename->vla-object (car (entsel "\nChon duong thang nguon: "))))
(while (/= (vla-get-objectname OBJLINE) "AcDbLine")
(setq OBJLINE (vlax-ename->vla-object (car (entsel "\nChon duong thang nguon: "))))
)
(princ "\nChon cac text dich: ")
(setq SS (ssget '((0 . "TEXT"))))
(setq OBJLST (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))))
(foreach OBJ OBJLST
(vla-put-textstring OBJ (rtos (* (vla-get-length OBJLINE) (getvar "DIMLFAC"))))
)
(setq OBJLST (append OBJLST (list OBJLINE)))
(if (and OBJ-REACTOR (vlr-added-p OBJ-REACTOR))
(vlr-remove OBJ-REACTOR)
)
(setq OBJ-REACTOR
(vlr-pers
(vlr-object-reactor OBJLST
NIL
'((:vlr-modified . UPDATETEXT)
(:vlr-erased . ERASEENT)
)
)
)
)
(princ (strcat "\nDa link duong thang voi " (itoa (sslength SS)) " text"))
(princ)
)
(defun UPDATETEXT (NOTIFIER-OBJECT OBJ-REACTOR PARAMETER-LIST / OBJLST OBJ)
(setq *ERROR* REACTOR-ERR)
(if (= (vla-get-objectname NOTIFIER-OBJECT) "AcDbLine")
(progn
(princ (strcat "\nTy le 1/" (rtos (getvar "DIMLFAC"))))
(setq OBJLST (vlr-owners OBJ-REACTOR))
(foreach OBJ OBJLST
(if (= (vla-get-objectname OBJ) "AcDbText")
(vla-put-textstring OBJ (rtos (* (vla-get-length NOTIFIER-OBJECT) (getvar "DIMLFAC"))))
)
)
)
)
(setq *ERROR* NIL)
)
(defun ERASEENT (NOTIFIER-OBJECT OBJ-REACTOR PARAMETER-LIST / OBJLST)
(alert "Ban da thuc hien lenh Erase tu doi tuong REACTOR.\nCac doi tuong khong con link voi nhau!")
(vlr-owner-remove OBJ-REACTOR NOTIFIER-OBJECT)
(vlr-remove OBJ-REACTOR)
(princ)
)
(defun REACTOR-ERR (MSG)
(cond ((= MSG "Automation Error. Object was open for undo") (princ "\nObject was open for undo"))
((= MSG "Automation Error. Object was erased") (princ "\nObject was erased"))
((= MSG "quit / exit abort") (princ "\t\texit"))
(t (progn (princ MSG) (princ)))
)
(setq *ERROR* NIL)
(princ)
)

tiền bối gia_bach từ các hướng dẫn của tiền bối, em viết cái lisp này
tiền bối cho em hỏi thêm chút nha
- PARAMETER-LIST sử dụng làm gì?
- mình có thể thêm đối số cho các hàm callback không?
-------------------------
26/10/2009
có cách nào xác định một đối tượng là reactor (an object from the list of owners of an object reactor)
  • 0

Ngu dốt không đáng thẹn bằng thiếu ý chí học hỏi


Tri thức làm người ta khiêm tốn, ngu si làm người ta kiêu ngạo (Ngạn ngữ Anh)


#30 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1432 Bài viết
Điểm đánh giá: 1425 (rất tốt)

Đã gửi 29 October 2009 - 10:51 AM

......................... cho em hỏi thêm chút nha
- PARAMETER-LIST sử dụng làm gì?
- mình có thể thêm đối số cho các hàm callback không?
-------------------------
26/10/2009
có cách nào xác định một đối tượng là reactor (an object from the list of owners of an object reactor)

- PARAMETER-LIST sử dụng làm gì?
tạm dịch từ Help của CAD : PARAMETER-LIST : danh sách các phần tử dữ liệu có liên quan đến sự kiện cụ thể. Các thành phần của danh sách này đuợc cho trong bảng “Object Events Callback Data”
thực sự thì tui cũng không hiểu rõ tham số này! pótay :tongue2:
- mình có thể thêm đối số cho các hàm callback không?
hàm callback chỉ chấp nhận 3 tham số : owner , reactor_objectPARAMETER-LIST như bạn đã biết.

Để xác định một đối tượng là reactor bạn dùng hàm vlr-owners
trong ví dụ của bạn, gọi (vlr-owners OBJ-REACTOR) sẽ trả về các đối tuợng VLA, trong t/hợp này là IAcadText .
  • 2

#31 master_worse

master_worse

    biết lệnh offset

  • Advance Member
  • PipPipPip
  • 170 Bài viết
Điểm đánh giá: 87 (tàm tạm)

Đã gửi 02 November 2009 - 01:16 PM

Để xác định một đối tượng là reactor bạn dùng hàm vlr-owners
trong ví dụ của bạn, gọi (vlr-owners OBJ-REACTOR) sẽ trả về các đối tuợng VLA, trong t/hợp này là IAcadText .


Cho em hỏi thêm chút nữa là: hàm (vlr-owners OBJ-REACTOR) trả về các đối tuợng VLA, nếu ngược lại thì sử dụng hàm gì? (hàm??? VLA-OBJ) trả về OBJ-REACTOR
  • 0

Ngu dốt không đáng thẹn bằng thiếu ý chí học hỏi


Tri thức làm người ta khiêm tốn, ngu si làm người ta kiêu ngạo (Ngạn ngữ Anh)


#32 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1432 Bài viết
Điểm đánh giá: 1425 (rất tốt)

Đã gửi 02 November 2009 - 03:47 PM

Cho em hỏi thêm chút nữa là: hàm (vlr-owners OBJ-REACTOR) trả về các đối tuợng VLA, nếu ngược lại thì sử dụng hàm gì? (hàm??? VLA-OBJ) trả về OBJ-REACTOR

Bạn đọc trong Help đó : các hàm bắt đầu bằng vlr-***

vlr-type : Returns a symbol representing the reactor type
vlr-types : Returns a list of all reactor types

Chú ý các hàm vlr-***-reactor
  • 1

#33 dkkx3a

dkkx3a

    biết lệnh trim

  • Members
  • PipPipPip
  • 190 Bài viết
Điểm đánh giá: 57 (tàm tạm)

Đã gửi 29 November 2009 - 01:27 PM

LSP ánh xạ rất hay khi dùng tính diện tích và ADD vào Block thuộc tính để sau đó xuất ra file số liệu. Nhưng nó không dùng được thuộc tính diện tích của "HATCH".
Hy vọng các bác bổ sung thêm phần nầy vào lsp và cho luôn biến tỉ lệ khi tính diện tích. Thanks.
  • 0
TỰ SỰ
Biển vào chiều buồn giữa cô liêu
Sóng vỗ bờ bạc đầu con nước
Khi biển động như lòng ta chợt động
Biển ồn ào nhưng thực rất dịu êm.......

#34 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1432 Bài viết
Điểm đánh giá: 1425 (rất tốt)

Đã gửi 30 November 2009 - 09:39 AM

..............................
Nhưng nó không dùng được thuộc tính diện tích của "HATCH".
Hy vọng các bác bổ sung thêm phần nầy vào lsp và cho luôn biến tỉ lệ khi tính diện tích. Thanks.

Bổ sung tính diện tích của "HATCH" và tỉ lệ khi tính diện tích.
(defun c:LinkA (/ ss_ent ent ss e cmd sole tile Suff Pref);Link Area
(if (> (atof (substr (getvar "ACADVER") 1 4)) 16.1) ;;;AutoCAD 2006 16.2
(progn
(vl-load-com)
(command "_.undo" "_begin")
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(princ "\nChon doi tuong lay Dien tich : ")
(if (setq ss_ent (ssget "_:S:E" '((0 . "*POLYLINE,ARC,SPLINE,ELLIPSE,CIRCLE,HATCH"))) )
(progn
(setq ent (vlax-ename->vla-object (ssname ss_ent 0)))
(princ "\nChon Text can Link gia tri Dien tich : ")
(setq ss (ssget (list (cons 0 "*TEXT")) ))
(setq sole (getvar "Luprec"));so le
(or *tile* (setq *tile* 1));ti le
(initget 6)
(setq tile (getreal (strcat "\nNhap ti le <" (rtos *tile*) ">: ")))
(if tile (setq *tile* tile)(setq tile *tile*))
(setq Pref "S=")
(setq Suff " mm2")
(foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(vla-put-TextString
(vlax-ename->vla-object e)
(strcat "%<\\AcObjProp Object(%<\\_ObjId "
(vl-princ-to-string (vla-get-ObjectId ent) )
">%).Area \\f \"%lu2%ps[" Pref "," Suff "]%pr" (itoa sole) "%ct8[" (vl-princ-to-string tile) "]\">%"
)
)
)
)
(alert "\nDoi tuong da chon khong co Dien tich !")
)
(setvar "cmdecho" cmd)
(command "_.undo" "_end")(princ)
)
(alert "\nChi chay tren Autocad 2006-2010")
)
)

  • 2

#35 halen

halen

    biết zoom

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

Đã gửi 18 January 2010 - 04:22 PM

Chào các bạn
Nhân đọc bài Ánh xạ giá trị đối tượng text, nguồn đổi giá trị, đích bị sửa của bác Hoành,
xin gửi các bạn LISP : Ánh xạ giá trị đối tượng gồm
1 . LinkT : Ánh xạ giá trị Text
2 . LinkA : Ánh xạ giá trị Diện tích
chú ý : khi sửa giá trị ở đối tượng nguồn, đối tượng đích (text) chỉ update sau khi sử dụng lệnh REGEN, SAVE, PLOT, ...

(defun c:LinkT (/ ss_ent ent ss e cmd);Link Text
(if (> (atof (substr (getvar "ACADVER") 1 4)) 16.1) ;;;AutoCAD 2006 16.2
(progn
(vl-load-com)
(command "_.undo" "_begin")
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(and (princ "\nChon Text goc : ")
(setq ss_ent (ssget "_:S:E" '((0 . "TEXT"))) )
(setq ent (vlax-ename->vla-object (ssname ss_ent 0)))
(princ "\nChon Text can Link gia tri tu Text goc : ")
(setq ss (ssget (list (cons 0 "TEXT")) ))
(foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(vla-put-TextString
(vlax-ename->vla-object e)
(strcat"%<\\AcObjProp Object(%<\\_ObjId "(vl-princ-to-string (vla-get-ObjectId ent)) ">%).TextString >%")
)
)
)
(setvar "cmdecho" cmd)
(command "_.undo" "_end")(princ)
)
(alert "\nChi chay tren Autocad 2006-2010")
)
)

(defun c:LinkA (/ ss_ent ent ss e cmd sole tile Suff Pref);Link Area
(if (> (atof (substr (getvar "ACADVER") 1 4)) 16.1) ;;;AutoCAD 2006 16.2
(progn
(vl-load-com)
(command "_.undo" "_begin")
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(and (princ "\nChon doi tuong lay Dien tich : ")
(setq ss_ent (ssget "_:S:E" '((0 . "*POLYLINE,ARC,SPLINE,ELLIPSE,CIRCLE"))) )
(setq ent (vlax-ename->vla-object (ssname ss_ent 0)))
(princ "\nChon Text can Link gia tri Dien tich : ")
(setq ss (ssget (list (cons 0 "TEXT")) ))
(setq sole (getvar "Luprec"));so le
(setq tile 1);ti le
(setq Pref "S=")
(setq Suff " mm2")
(foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(vla-put-TextString
(vlax-ename->vla-object e)
(strcat "%<\\AcObjProp Object(%<\\_ObjId "
(vl-princ-to-string (vla-get-ObjectId ent) )
">%).Area \\f \"%lu2%ps[" Pref "," Suff "]%pr" (itoa sole) "%ct8[" (vl-princ-to-string tile) "]\">%"
)
)
)
)
(setvar "cmdecho" cmd)
(command "_.undo" "_end")(princ)
)
(alert "\nChi chay tren Autocad 2006-2010")
)
)

Anh ơi cái này áp dụng cho cad 2007 được không vậy? Em áp dụng sảy ra trường hợp như sau: chọn đối tượng nguồn, sau đó chọn các
đối tượng muốn link rồi. Sau đó thì các text được chọn bị ẩn hết. Thay đổi giá trị nguồn, sau đó regen lại nhưng vẫn không thấy các đối tượng
text bị ẩn hiện lên và thay đổi.
Mong anh giải thích dùm. Cảm ơn anh.
  • 0

#36 halen

halen

    biết zoom

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

Đã gửi 18 January 2010 - 09:18 PM

Chào các bạn
Nhân đọc bài Ánh xạ giá trị đối tượng text, nguồn đổi giá trị, đích bị sửa của bác Hoành,
xin gửi các bạn LISP : Ánh xạ giá trị đối tượng gồm
1 . LinkT : Ánh xạ giá trị Text
2 . LinkA : Ánh xạ giá trị Diện tích
chú ý : khi sửa giá trị ở đối tượng nguồn, đối tượng đích (text) chỉ update sau khi sử dụng lệnh REGEN, SAVE, PLOT, ...

(defun c:LinkT (/ ss_ent ent ss e cmd);Link Text
(if (> (atof (substr (getvar "ACADVER") 1 4)) 16.1) ;;;AutoCAD 2006 16.2
(progn
(vl-load-com)
(command "_.undo" "_begin")
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(and (princ "\nChon Text goc : ")
(setq ss_ent (ssget "_:S:E" '((0 . "TEXT"))) )
(setq ent (vlax-ename->vla-object (ssname ss_ent 0)))
(princ "\nChon Text can Link gia tri tu Text goc : ")
(setq ss (ssget (list (cons 0 "TEXT")) ))
(foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(vla-put-TextString
(vlax-ename->vla-object e)
(strcat"%<\\AcObjProp Object(%<\\_ObjId "(vl-princ-to-string (vla-get-ObjectId ent)) ">%).TextString >%")
)
)
)
(setvar "cmdecho" cmd)
(command "_.undo" "_end")(princ)
)
(alert "\nChi chay tren Autocad 2006-2010")
)
)

(defun c:LinkA (/ ss_ent ent ss e cmd sole tile Suff Pref);Link Area
(if (> (atof (substr (getvar "ACADVER") 1 4)) 16.1) ;;;AutoCAD 2006 16.2
(progn
(vl-load-com)
(command "_.undo" "_begin")
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(and (princ "\nChon doi tuong lay Dien tich : ")
(setq ss_ent (ssget "_:S:E" '((0 . "*POLYLINE,ARC,SPLINE,ELLIPSE,CIRCLE"))) )
(setq ent (vlax-ename->vla-object (ssname ss_ent 0)))
(princ "\nChon Text can Link gia tri Dien tich : ")
(setq ss (ssget (list (cons 0 "TEXT")) ))
(setq sole (getvar "Luprec"));so le
(setq tile 1);ti le
(setq Pref "S=")
(setq Suff " mm2")
(foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(vla-put-TextString
(vlax-ename->vla-object e)
(strcat "%<\\AcObjProp Object(%<\\_ObjId "
(vl-princ-to-string (vla-get-ObjectId ent) )
">%).Area \\f \"%lu2%ps[" Pref "," Suff "]%pr" (itoa sole) "%ct8[" (vl-princ-to-string tile) "]\">%"
)
)
)
)
(setvar "cmdecho" cmd)
(command "_.undo" "_end")(princ)
)
(alert "\nChi chay tren Autocad 2006-2010")
)
)

Sao không bác nào ghé qua trả lời giúp em cái nhỉ? em thực hiện mãi ko được mà cái này em thấy rất hay. Ứng dụng được nhiều trong công việc. Mong các bác giải thích dùm tại sao lại sảy ra hiện tượng trên.
  • 0

#37 halen

halen

    biết zoom

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

Đã gửi 19 January 2010 - 08:00 AM

[quote name='gia_bach' date='Jan 19 2010, 7:28' post='85384']
Bổn hiệu em chỉ làm giờ hành chánh thôi các bác ạ.
Ngoài giờ phải tranh thủ "tăng ca" bác á.

Đừng dowload bằng cách click vào Download lisp file.
(chức năng này của diễn đàn đang bị lỗi)
Bạn copy toàn bộ text trong mục CODEBOX và luu thành file *.lsp.

Tham khảo : http://www.cadviet.c...o...ost&p=81489
[/quote
Cảm ơn anh. Tối qua em tìm ra rồi.
  • 0

#38 tvgtyb08

tvgtyb08

    biết vẽ spline

  • Members
  • PipPip
  • 92 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 12 April 2011 - 10:47 PM

Bổ sung tính diện tích của "HATCH" và tỉ lệ khi tính diện tích.

(defun c:LinkA (/ ss_ent ent ss e cmd sole tile Suff Pref);Link Area
(if (> (atof (substr (getvar "ACADVER") 1 4)) 16.1) ;;;AutoCAD 2006 16.2
(progn
(vl-load-com)
(command "_.undo" "_begin")
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(princ "\nChon doi tuong lay Dien tich : ")
(if (setq ss_ent (ssget "_:S:E" '((0 . "*POLYLINE,ARC,SPLINE,ELLIPSE,CIRCLE,HATCH"))) )
(progn
(setq ent (vlax-ename->vla-object (ssname ss_ent 0)))
(princ "\nChon Text can Link gia tri Dien tich : ")
(setq ss (ssget (list (cons 0 "*TEXT")) ))
(setq sole (getvar "Luprec"));so le
(or *tile* (setq *tile* 1));ti le
(initget 6)
(setq tile (getreal (strcat "\nNhap ti le <" (rtos *tile*) ">: ")))
(if tile (setq *tile* tile)(setq tile *tile*))
(setq Pref "S=")
(setq Suff " mm2")
(foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(vla-put-TextString
(vlax-ename->vla-object e)
(strcat "%<\\AcObjProp Object(%<\\_ObjId "
(vl-princ-to-string (vla-get-ObjectId ent) )
">%).Area \\f \"%lu2%ps[" Pref "," Suff "]%pr" (itoa sole) "%ct8[" (vl-princ-to-string tile) "]\">%"
)
)
)
)
(alert "\nDoi tuong da chon khong co Dien tich !")
)
(setvar "cmdecho" cmd)
(command "_.undo" "_end")(princ)
)
(alert "\nChi chay tren Autocad 2006-2010")
)
)

Bác ơi em chạy trên Cad 2005 và 2007 nó ko nhận, nhờ các bác sửa giúp em với.
  • 0

#39 xuandao0708

xuandao0708

    biết lệnh scale

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

Đã gửi 18 April 2011 - 01:50 PM

Nhân tiện đây nhờ Bác chỉnh sữa dùm em 1 chút về lips LinkT như sau:
- Khi chọn đối tượng nguồn thì mình có thể chọn được nhiều đối tượng nguồn cho 1 đối tượng đích.
- Khi copy 1 đối tượng nguồn thì đối tượng mới được copy vẫn được hiểu là 1 phần đối tượng nguồi của đối tượng đích mà mình vừa copy.
Cá mơn Bác nhiều!
  • 0

#40 xuandao0708

xuandao0708

    biết lệnh scale

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

Đã gửi 05 May 2011 - 01:55 PM

Nhân tiện đây nhờ mọi người chỉnh sửa dùm em 1 chút về lips LinkT như sau:
- Khi chọn đối tượng nguồn thì mình có thể chọn được nhiều đối tượng nguồn cho 1 đối tượng đích.
- Khi copy 1 đối tượng nguồn thì đối tượng mới được copy vẫn được hiểu là 1 phần đối tượng nguồi của đối tượng đích mà mình vừa copy.
Cá mơn Bác nhiều!
Đây là file cad mẫu: http://www.cadviet.c...mau_cadviet.dwg
  • 0