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

[ketxu 2.984]

hix lâu lâu không sờ đến lsp cho mình hỏi trọng tâm hình là mã DXF bao nhiêu nhỉ?

Mã DXF này :

 (defun mid (ent / p1 p2)
   (vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)
   (setq p1 (vlax-safearray->list p1)
  p2 (vlax-safearray->list p2)
  pt (mapcar '+ p1 p2)
  pt (mapcar '* pt '(0.5 0.5 0.5))
   )
   pt
 )

P/S : lâu hok sờ đến mà làm việc khó vậy bác ^^

[xuandao0708 9]

Thank mọi người nhiều, chắc thực hiện thao tác giống ketxu nói cho dễ hơn.

[duchieu0205 3]

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.

 

Nếu thé có thể làm ngược lại

 

"tập nguồn 1: %%c8

tập nguồn 2: a200

tập đích link là: %%c8a200

""

được không các bạn?

[gia_bach 1.549]

Nếu thé có thể làm ngược lại

 

"tập nguồn 1: %%c8

tập nguồn 2: a200

tập đích link là: %%c8a200

""

được không các bạn?

Tạm hiểu "lờ mờ" ý của bạn ?!

Nhưng làm được hay không thì tôi chưa biết (vì chưa rõ vấn đề, đừng bắt người đọc làm "thầy bói xem voi").

 

Trước mắt là bạn nên trình bày vấn đề 1 cách cụ thể hơn.

[duchieu0205 3]

Tạm hiểu "lờ mờ" ý của bạn ?!

Nhưng làm được hay không thì tôi chưa biết (vì chưa rõ vấn đề, đừng bắt người đọc làm "thầy bói xem voi").

 

Trước mắt là bạn nên trình bày vấn đề 1 cách cụ thể hơn.

 

Hu hu có lẽ em dốt văn quá đây mà! ý em muống các bác viết lisp ánh xạ từ 2 hay nhiều nguồn đến chung 1 đích ! đấy là một dạng cộng text nhưng không phải cộng đại số như lệnh CT mà các anh đã viết chỉ giản đơn là ghép các chuỗi text lại với nhau theo thứ tự chọn! Cám ơn các anh đã để tâm!

[gia_bach 1.549]

Hu hu có lẽ em dốt văn quá đây mà! ý em muống các bác viết lisp ánh xạ từ 2 hay nhiều nguồn đến chung 1 đích ! đấy là một dạng cộng text nhưng không phải cộng đại số như lệnh CT mà các anh đã viết chỉ giản đơn là ghép các chuỗi text lại với nhau theo thứ tự chọn! Cám ơn các anh đã để tâm!

LISP : Ghép các chuỗi text lại với nhau theo thứ tự chọn.

(defun c:JT (/ fieldexp obj sel ss);Joint Text
 ;;  By : Gia_Bach, www.CadViet.com      ;;
 (vl-load-com)
 (if (> (atof (substr (getvar "ACADVER") 1 4)) 16.1) ;;;AutoCAD 2006 16.2
   (progn
     (setq ss (ssadd))
     (while (setq sel (entsel "\nChon cac Text can noi voi nhau: "))
(setq ent (car sel))
(if (= (cdr (assoc 0 (entget ent))) "TEXT") (ssadd ent ss)) )
     (if (and
    (> (sslength ss) 0)
    (setq fieldExp"")
    (setq obj (car (entsel "\nChon Text ghi ket qua : ")) ))
     (progn
(foreach e (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
  (setq fieldExp (strcat fieldExp
			 "%<\\AcObjProp Object(%<\\_ObjId "
			 (itoa (vla-get-objectid e))
			 ">%).TextString>%")) )
(vla-put-TextString (vlax-ename->vla-object obj) fieldExp)
(princ))))
   (alert "\nChi chay tu Autocad 2006")  )  )

[duchieu0205 3]

LISP ghép các chuỗi text lại với nhau theo thứ tự chọn.

(defun c:JT (/ fieldexp obj sel ss);Joint Text
 ;;  By : Gia_Bach, www.CadViet.com      ;;
 (vl-load-com)
 (if (> (atof (substr (getvar "ACADVER") 1 4)) 16.1) ;;;AutoCAD 2006 16.2
   (progn
     (setq ss (ssadd))
     (while (setq sel (entsel "\nChon cac Text can noi voi nhau: "))
(setq ent (car sel))
(if (= (cdr (assoc 0 (entget ent))) "TEXT") (ssadd ent ss)) )
     (if (and
    (> (sslength ss) 0)
    (setq fieldExp"")
    (setq obj (car (entsel "\nChon Text ghi ket qua : ")) ))
     (progn
(foreach e (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
  (setq fieldExp (strcat fieldExp
			 "%<\\AcObjProp Object(%<\\_ObjId "
			 (itoa (vla-get-objectid e))
			 ">%).TextString>%")) )
(vla-put-TextString (vlax-ename->vla-object obj) fieldExp)
(princ))))
   (alert "\nChi chay tu Autocad 2006")  )  )

 

Tốt quá rồi anh Gia Bạch ơi! nhưng em có một đề xuất nhỏ này không biết có được không ạ! giờ này áp dụng cho text thì được rồi nhưng nếu em muốn link cho các dòng text của block có thuộc tính thì phải viết thêm gì nữa anh? Ngoài ra khi sử dụng link nhiều trong bản vẽ thì bản vẽ có vẻ nặng hơn thì phải

[xuandao0708 9]

Nhờ Bác Gia_Bach và mọi người giúp đỡ thêm như sau:

1/ Hiện giờ lisp linhA của bác gia_bach thì phải chọn đối tượng là 1 đường pline kín, nếu được thì có thể kích vào giữa vùng kín là những đường line vì trên bản vẽ phân lô tổng thể của mình thì đó là những đường line đơn lẽ, nếu phải tạo thành những vùng kín bằng pline cho từng lô đơn lẽ thì bản vẽ rất nặng và lâu

2/ Muốn chỉnh số lẽ là 1 thì phải chỉnh như thế nào?

Đây là file mẫu, 1 phần của dự án phân lô tổng thể xã Phong Phu

http://www.cadviet.com/upfiles/3/mau_4.dwg

[gia_bach 1.549]

Nhờ Bác Gia_Bach và mọi người giúp đỡ thêm như sau:

1/ Hiện giờ lisp linhA của bác gia_bach thì phải chọn đối tượng là 1 đường pline kín, nếu được thì có thể kích vào giữa vùng kín là những đường line vì trên bản vẽ phân lô tổng thể của mình thì đó là những đường line đơn lẽ, nếu phải tạo thành những vùng kín bằng pline cho từng lô đơn lẽ thì bản vẽ rất nặng và lâu

2/ Muốn chỉnh số lẽ là 1 thì phải chỉnh như thế nào?

Đây là file mẫu, 1 phần của dự án phân lô tổng thể xã Phong Phu

http://www.cadviet.com/upfiles/3/mau_4.dwg

Truớc tiên, bạn thử trình bày các buớc tạo "link tính diện tính vùng kín từ những đường line" bằng CAD.

 

Sau đó tôi sẽ "cố gắng" chuyển nó qua LISP giùm bạn.

[leejang 5]

Nếu đúng như vậy thì em hãy sử dụng Lisp này

Khi sử dụng Lisp này thì yêu cầu tập hợp text của T= { X1, X2, X3, ....., Xn } phải nằm trong 1 Group

tức là các đối tượng X1, X2, X3, ....., Xn thuộc 1 group -> X1, X2, X3, ....., Xn là các Text được thành lập bởi lệnh Group

và CAD phải ở chế độ hiển thị Group ON

Sử dụng Code sau. Hy vọng bạn hài lòng

(defun c:Lchu(/ e p socu somoi D ss i ent)
(setq e (entsel "\n Chon Text nguon trong Group can chinh sua :"))
(setq p (cadr e) dt (car e))
(setq socu (atof (cdr(assoc 1 (entget dt)))))
(setq somoi (getreal (strcat "\n Nhap so moi <" (rtos socu) "> :")))
(setq D (- somoi socu))
(setq ss (ssget p) i 0)

(if (not tpo) (setq tpo 0))
(setq tp (getint (strcat "\n So chu so thap phan <" (itoa tpo) "> :")))
(if (not tp) (setq tp tpo) (setq tpo tp))

(while (< i (sslength ss))
(setq ent (entget (ssname ss i)))
(if (distof (cdr(assoc 1 ent)))
(progn
  (setq so (+ (atof (cdr(assoc 1 ent))) D))
  (setq ent (entmod (subst (cons 1 (rtos so 2 tp)) (assoc 1 ent) ent)))
)
)
(setq i (1+ i))
)
(princ)
)

Lisp này quả thật rất hay nhưng làm sao để xoá Link đó đi ạ ? Vì trong thực tế có nhiều bản vẽ người vẽ ko vẽ đúng tỷ lệ, do đó ta phải Scale đi để tính toán cho đúng rùi Scale lại. Làm sao để xoá link đó đi ạ ?

[ketxu 2.984]

Lisp này quả thật rất hay nhưng làm sao để xoá Link đó đi ạ ? Vì trong thực tế có nhiều bản vẽ người vẽ ko vẽ đúng tỷ lệ, do đó ta phải Scale đi để tính toán cho đúng rùi Scale lại. Làm sao để xoá link đó đi ạ ?

Vậy tốt nhất là bạn đừng dùng link Text nữa. Người ta làm link để phù hợp với việc thay đổi mà :)

[Thaistreetz 539]

1 obj_reactor có owner chứa danh sách objname của các đối tượng mà nó liên kết. Vậy có cách nào thêm hoặc bớt objname vào danh sách này không?

Hàm vlr-owner-remove: (vlr-owner-remove obj_reactor notifier-object) không làm được điều này hoặc có thể mình đã hiểu sai cách thức sử dụng nó. Cụ thể:

- Mình gắn cho đối tượng 1 rector theo dỗi sự kiện đối tượng bị xóa.

- Rector này gọi tới hàm callback thực hiện hàm: (setq obj_reactor (vlr-owner-remove obj_reactor notifier-object)) (ở đây hàm callback gắn objname của đối tượng bị xóa cho đối số notifier-object)

- Sau khi thực hiện xong việc xóa đối tượng, nghĩa là hàm callback trên đã được thực hiện, kiểm tra lại owner của obj_reactor vẫn thấy tồn tại objname của đối tượng đã xóa trên.

 

Bác Gia_Bach hay bác nào nắm vững về rector trợ giúp mình với.

Mục đích của mình là tạo hàm callback gắn với sự kiện đối tượng bị xóa. nếu đối tượng bị xóa chứa 1 rector nào đó thì hàm tự động loại bỏ rector của nó trước khi xóa, nhưng không loại bỏ liên kết của các đối tượng khác cùng nhóm liên kết với nó.

[gia_bach 1.549]

1 obj_reactor có owner chứa danh sách objname của các đối tượng mà nó liên kết. Vậy có cách nào thêm hoặc bớt objname vào danh sách này không?

Hàm vlr-owner-remove: (vlr-owner-remove obj_reactor notifier-object) không làm được điều này hoặc có thể mình đã hiểu sai cách thức sử dụng nó. Cụ thể:

- Mình gắn cho đối tượng 1 rector theo dỗi sự kiện đối tượng bị xóa.

- Rector này gọi tới hàm callback thực hiện hàm: (setq obj_reactor (vlr-owner-remove obj_reactor notifier-object)) (ở đây hàm callback gắn objname của đối tượng bị xóa cho đối số notifier-object)

- Sau khi thực hiện xong việc xóa đối tượng, nghĩa là hàm callback trên đã được thực hiện, kiểm tra lại owner của obj_reactor vẫn thấy tồn tại objname của đối tượng đã xóa trên.

 

Bác Gia_Bach hay bác nào nắm vững về rector trợ giúp mình với.

Mục đích của mình là tạo hàm callback gắn với sự kiện đối tượng bị xóa. nếu đối tượng bị xóa chứa 1 rector nào đó thì hàm tự động loại bỏ rector của nó trước khi xóa, nhưng không loại bỏ liên kết của các đối tượng khác cùng nhóm liên kết với nó.

Thaistreetz tham khảo lisp EraseAndDisconnect

(vl-load-com)
(defun c:EraseAndDisconnect ( / allReactorsLst obj removeLst) 
 (if (setq obj (vlax-ename->vla-object (car (entsel))))
(progn
 	(mapcar
'(lambda (a / ownLst)
(setq ownLst (vlr-owners a))
(cond
 	((and (member obj ownLst) (= (length ownLst) 1))
  	(vlr-remove a) )
 	((member obj ownLst)
  	(vlr-owner-remove a obj) ) )	)
(apply 'append (mapcar 'cdr (vlr-reactors :vlr-object-reactor)))  )
 	(setq allReactors (apply 'append (mapcar 'cdr (vlr-reactors))))
 	(mapcar 'vlr-remove allReactors) ; temporarily disable all reactors
 	(vla-delete obj)
 	(mapcar 'vlr-add allReactors) ))
 (princ))
(defun c:LinkR (/ ss objlst obj_reactor); Link Radius
 (if (setq ss (ssget  '((0 . "CIRCLE"))) )
(setq objlst (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
  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) )	)  )

[enix 3]

Em dùng lisp link text của bác GiaBach thì nó ko chạy, file đích chỉ hiện thị #### chứ ko chạy theo file nguồn bác ơi.

Còn cái lisp đã chỉnh sửa sao cho khi tắt bản vẽ mở lại vẫn giữ link thì lại ko phản ứng gì cả.

Ah em xài AutoCAD 2013.

[ketxu 2.984]

Lisp ánh xạ text thì liên quan gì đến file ở đây ? Có phải bạn đang dùng CAD 64bit ?

[dung_can 2]

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

Chào các bác,

Bác Master Worse viết đoạn lisp tự động cập nhật chiều dài LINE khi LINE thay đổi rất hay. Khi em thống kê kích thước các chi tiết vào 1 bảng, lúc cập nhật được 1 LINE rồi chuyển sang LINE tiếp theo thì LINE trước không thực hiện được nữa. Em lại muốn sự cập nhật ấy giữ lại ở tất cả các LINE trong file ấy.

Mong các bác giúp đỡ.

[ketxu 2.984]

Bác ấy viết trên Reactor và chỉ gán cho 1 đối tượng. Bài toán của bạn sẽ cực kỳ dễ nếu dùng Field

[Thaistreetz 539]

code này có chạy được đâu nhỉ. nó lỗi ngay từ khi chọn đối tượng mà.

 

(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: ")))))

 

(vlax-ename->vla-object nil) => ; error: bad argument type: lentityp nil

 

Cũng thật khó hiểu cho đoạn code này của Master Worse để select đối tượng :mellow:

 

Code này có rất nhiều lỗi xử lý reactor, về khía cạnh người dùng thì bạn chỉ nhìn thấy kết quả. nhưng phía sau nó là rất nhiều lỗi sảy ra có thể gây ảnh hưởng đến cad của bạn, và sẽ đặc biệt nghiêm trọng nếu bạn có sử dụng các chương trình khác có sử dụng reactor. vì thế khuyên bạn ko lên dùng code này.

[Doan Van Ha 3.191]

code này có chạy được đâu nhỉ. nó lỗi ngay từ khi chọn đối tượng mà.

 

(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: ")))))

(vlax-ename->vla-object nil) => ; error: bad argument type: lentityp nil

Cũng thật khó hiểu cho đoạn code này của Master Worse để select đối tượng :mellow:

Đúng là như thế! Đoạn code đó nếu xui xẻo lần đầu chọn không trúng đối tượng thì lỗi.

Nếu muốn chọn chừng nào được 1 Line thì thôi, chắc phải viết kiểu như vầy:

(while (or (not (setq ent (car (entsel "\nChon 1 Line: ")))) (/= "LINE" (cdr (assoc 0 (entget ent))))))

[Chiron 94]

Lisp ánh xạ text thì liên quan gì đến file ở đây ? Có phải bạn đang dùng CAD 64bit ?

Hình như CAD64bit không dùng được linkA của bác gia_bach? Mình đã thử trên 2 bản, CAD 32bit thì bình thường. Ketxu có thể giải thích vì sao không và cách khắc phục?

[ketxu 2.984]

Field muốn lấy được thuộc tính của đối tượng để link (ở đây là Contents = nội dung) thì trước tiên nó phải lấy được mã hiệu của đối tượng đó, hay còn gọi là ObjectId.

Cad 64bit thì hàm lấy ObjectId có khác 1 chút so với CAd32 bit => Chỉ cần sửa 1 tí tẹo lisp bác gia_bach là ổn với các đời CAD. Mình đang ở chỗ k có CAD để viết, bạn hãy chờ bác nào đó viết hộ bạn nhé

[xuandao0708 9]

Nhờ mọi người nghiên cứu thêm dùm em phần ánh xạ hiệu, phần ánh xạ tổng thì rất được rồi, nhưng hiện nay do em phải làm nhiều phần hiệu trừ nên khi trừ nhiều diện tích thì rất dể bị nhầm này nhờ mọi người quan tâm dùm. Thank!

Đây là file cad mẫu:

http://www.cadviet.com/upfiles/3/37805_mau_hieu_anh_xa.dwg

[Tue_NV 3.912]

Nhờ mọi người nghiên cứu thêm dùm em phần ánh xạ hiệu, phần ánh xạ tổng thì rất được rồi, nhưng hiện nay do em phải làm nhiều phần hiệu trừ nên khi trừ nhiều diện tích thì rất dể bị nhầm này nhờ mọi người quan tâm dùm. Thank!

Đây là file cad mẫu:

http://www.cadviet.c...hieu_anh_xa.dwg

Xuan dao đọc các bài viết ở đây nhé!

Link: http://www.cadviet.com/forum/index.php?showtopic=40442

[xuandao0708 9]

Thank Tue_VN nhiều! Tại hồi sáng tìm mà không thấy bài này.

[thonggtcc 1]

Nhân đọc bài ánh xạ giá trị nguồn, giá trị đích thay đổi theo. Mình có bài toán thế này mong mọi người giúp đở:

Mình tạo 1 block thuộc tính. Khi đặt Block đó tại 1 vị trí cố định (nguồn). Nhập thủ công giá trị tọa độ hoặc khoảng cách mới thì Block tự động dịch chuyển (hoặc copy) sang tọa độ mới vừa đưa vào. (Xem file đính kèm).

Thanks.