Hỏi về Lisp (thuật toán, ý tưởng, coding,...)

[ketxu 2.984]

Thank bác Gia Bach + Ketxu. Cách của bác Gia Bach hay quá. Hóa ra chỉ cần entmod là được.

vla-update của e hoặc entupd của bác Thái chính là thể hiện điều đó

Không ai có thể giúp mình câu hỏi này sao?

Bạn nên đưa toàn lisp lên thì mọi người có cái nhìn tổng quan hơn

[Thaistreetz 539]

Các bác giúp mình với:

- Mình có vla-object name của đối tượng block insert chứa một số attribute, tag là "a" "b" "c"... chẳng hạn.

giờ mình muốn lấy vla-object name của thằng ku "a" thì làm thế nào? mình ngại chuyển về ename nên không muốn dùng cách này.

 

- mở rộng hơn, mình có ActiveSelectionSet là tập hợp của các block trên:

(ssget '((0 . "INSERT")))

(vla-get-ActiveSelectionSet *document*)

giờ mình muốn có code ngắn nhất để lấy được danh sách (list) vla-object của tất cả đối tượng con có tag là "a"

[Doan Van Ha 3.202]

Các bác giúp mình với:

- Mình có vla-object name của đối tượng block insert chứa một số attribute, tag là "a" "b" "c"... chẳng hạn.

giờ mình muốn lấy vla-object name của thằng ku "a" thì làm thế nào? mình ngại chuyển về ename nên không muốn dùng cách này.

 

- mở rộng hơn, mình có ActiveSelectionSet là tập hợp của các block trên:

(ssget '((0 . "INSERT")))

(vla-get-ActiveSelectionSet *document*)

giờ mình muốn có code ngắn nhất để lấy được danh sách (list) vla-object của tất cả đối tượng con có tag là "a"

Bác tham khảo cái này xem:

; VxGetAtts - Reads all attribute values from a block
; Copyright: ©2000 MENZI ENGINEERING GmbH, Switzerland
; Arguments [Type]:
; Obj = Object [VLA-OBJECT]
; Return [Type]:
; > Dotted pair list '(("Tag1" . "Val1")...) [list]
; Notes:
; - None
(defun VxGetAtts (Obj)
(mapcar '(lambda (Att) (cons (vla-get-TagString Att) (vla-get-TextString Att))) (vlax-invoke Obj 'GetAttributes)))

[gia_bach 1.553]

Các bác giúp mình với:

- Mình có vla-object name của đối tượng block insert chứa một số attribute, tag là "a" "b" "c"... chẳng hạn.

giờ mình muốn lấy vla-object name của thằng ku "a" thì làm thế nào? mình ngại chuyển về ename nên không muốn dùng cách này.

 

- mở rộng hơn, mình có ActiveSelectionSet là tập hợp của các block trên:

(ssget '((0 . "INSERT")))

(vla-get-ActiveSelectionSet *document*)

giờ mình muốn có code ngắn nhất để lấy được danh sách (list) vla-object của tất cả đối tượng con có tag là "a"

Thaistreetz tham khảo Lisp này (đổi nội dung biến tag theo nhu cầu):

(defun c:exTag (/  attlst e i obj reslst ss tag tagname)
 (vl-load-com)
 (if (setq ss (ssget (list (cons 0 "INSERT")(cons 66 1))))
(progn
 	(setq i -1 tag "a") ; doi ten tag
 	(while (setq e (ssname ss (setq i (1+ i))))
(setq obj (vlax-Ename->Vla-Object e)
  	attLst (vlax-invoke obj 'GetAttributes))
(foreach att attLst
  (setq tagName (vla-get-TagString att))
  (if (= tagName tag)
(setq resLst (cons att resLst)) )) );(vla-get-TextString att)
 	(princ (vl-princ-to-string resLst)) ))
 (princ))

 

hay

(defun c:exTag1 (/  reslst tag )
 (vl-load-com)
 (if (ssget(list (cons 0 "INSERT")(cons 66 1)))
(progn
 	(setq tag "a") ; doi ten tag
 	(vlax-for obj (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(foreach att (vlax-invoke obj 'GetAttributes)
  (if (= (vla-get-TagString att) tag)
(setq resLst (cons att resLst)) )));(vla-get-TextString att)
 	(princ (vl-princ-to-string resLst))   ) )
 (princ))

[Thaistreetz 539]

hix. các bác hiểu ngược ý của mình rồi.

trong ví dụ của bác Hà và bác Gia Bách thì từ object ta lấy ra giá trị của đối tượng.

còn nhu cầu của mình là ngược lại:

mình có vla-object của đối tượng chính là block. block đó chứa các đối tượng att. từ tag của att mình muốn lấy vla-object của chính nó thôi (mục đích để xử lý cho các bước tiếp theo ấy mà)

1 cách tương đương thì mình có ename của 1 đối tượng block insert. và mình muốn lấy ename của đối tượng con của nó có tag "a". nhưng vì đang xử lý trên vla-object nên không muốn chuyển về ename, cho đỡ lằng nhằng ý mà.

[ketxu 2.984]

Cái VD 2 của bác gia_bach là đúng ý bác Thái r chứ nhỉ :o

(vl-remove-if-not '(lambda(x)(eq (vla-get-TagString x) Tag)) (vlax-invoke blockObj 'GetAttributes) )

[Thaistreetz 539]

Cảm ơn các bác. đúng là 1 lúc ngâm cứu code của bác Gia Bách thì thấy chuẩn luôn rồi. mình hồ đồ quá :P

(defun c:fg (/ lst)
(ssget '((0 . "INSERT")))
(setq tag "a")
(vlax-for Obj (vla-get-ActiveSelectionSet *document*)
(setq lst (append (vlax-invoke obj 'GetAttributes) lst)))
(vl-remove-if-not '(lambda (x) (and x (= tag (vla-get-TagString x)))) lst))

 

Mình có 1 chút thắc mắc nữa chưa tìm được lời giải:

mới đầu mình dùng code này để lấy list att : (vlax-safearray->list (vlax-variant-value (vla-getattributes obj)))

tuy nhiên nó không khả thi vì lúc thì nó lấy được, lúc thì nó báo lỗi tại hàm vlax-variant-value, nội dung như thế này:

error: ActiveX Server returned an error: Invalid index

thế là sao nhỉ?

[ketxu 2.984]

(vla-getattributes obj) trả về Nil

[gia_bach 1.553]

Cảm ơn các bác. đúng là 1 lúc ngâm cứu code của bác Gia Bách thì thấy chuẩn luôn rồi. mình hồ đồ quá :P

(defun c:fg (/ lst)
(ssget '((0 . "INSERT")))
(setq tag "a")
(vlax-for Obj (vla-get-ActiveSelectionSet *document*)
(setq lst (append (vlax-invoke obj 'GetAttributes) lst)))
(vl-remove-if-not '(lambda (x) (and x (= tag (vla-get-TagString x)))) lst))

 

Mình có 1 chút thắc mắc nữa chưa tìm được lời giải:

mới đầu mình dùng code này để lấy list att : (vlax-safearray->list (vlax-variant-value (vla-getattributes obj)))

tuy nhiên nó không khả thi vì lúc thì nó lấy được, lúc thì nó báo lỗi tại hàm vlax-variant-value, nội dung như thế này:

error: ActiveX Server returned an error: Invalid index

thế là sao nhỉ?

Do đối tuợng không phải là Block thuộc tính.

Cách khắc phục :

- kiểm tra block có thuộc tính hay không : (eq :vlax-true (vla-get-hasAttributes obj))

- hoặc lọc ngay từ ssget : (ssget(list (cons 0 "INSERT")(cons 66 1)))

[Thaistreetz 539]

mình có 1 Safearray chứ dữ liệu 3D point. làm thế nào để chuyển nó thành 2D mà không cần chuyển nó về list để xử lý? kết quả không có phần tử thứ 3 (không có tọa độ z) chứ không fải là giá trị của phần tử thứ 3 = 0 (tọa độ z = 0) nhé.

[Tue_NV 3.912]

mình có 1 Safearray chứ dữ liệu 3D point. làm thế nào để chuyển nó thành 2D mà không cần chuyển nó về list để xử lý? kết quả không có phần tử thứ 3 (không có tọa độ z) chứ không fải là giá trị của phần tử thứ 3 = 0 (tọa độ z = 0) nhé.

Ngoài cách chuyển về List để xử lý thì theo Tue_NV biết thì không có cách nào khác nữa đâu bạn.

[hochoaivandot 111]

Em viết code sau để lấy danh sách Block name.

Nhưng kết quả ("*Model_Space" "*Paper_Space" "*Paper_Space0" "Block1" "Block2" "Block3")

Mình không muốn mấy cái Block động và "*Model_Space" "*Paper_Space" "*Paper_Space0" tham gia vào danh sách trả về.

Mọi người giúp với. Phải vl-remove-if thế nào nhỉ???

(defun GetListBlock(/ acadobject acaddocument for-item lst obj_block)
(setq acadobject (vlax-get-Acad-Object))
(setq acaddocument (vla-get-activedocument acadobject))
(setq obj_block (vla-get-blocks acaddocument))
(setq lst (list))
(vlax-for for-item obj_block
 (setq lst (cons (vla-get-Name for-item) lst))
)
(reverse lst)
)

 

File đính kém nếu cần: http://www.cadviet.com/upfiles/3/40108_block.dwg

[ketxu 2.984]

Bỏ những cái có `* đằng trước bác ạ :)

[hochoaivandot 111]

Bỏ những cái có `* đằng trước bác ạ

Làm được rồi. Cảm ơn ketxu nhé

(defun GetListBlock(/ acadobject acaddocument for-item lst obj_block)
(setq acadobject (vlax-get-Acad-Object))
(setq acaddocument (vla-get-activedocument acadobject))
(setq obj_block (vla-get-blocks acaddocument))
(setq lst (list))
(vlax-for for-item obj_block
 (if (/= (substr (setq #name (vla-get-Name for-item)) 1 1) "*")
  (setq lst (cons #name lst))
 )
)
(reverse lst)
)

[Doan Van Ha 3.202]

Tôi sử dụng lisp dưới đây để tính góc của tiếp tuyến với curve tại điểm giữa của curve, nhưng trong file cad đính kèm thì nó bị lỗi (đường màu xanh). Tôi biết lỗi ở hàm (vlax-curve-getParamAtPoint obj cen) nhưng không hiểu vì sao mà lỗi, và cách khắc phục. Ai biết xin chỉ giùm.

http://www.cadviet.com/upfiles/3/67029_loi_vlax.dwg

(defun C:HA( / obj len cen goc)
(setq obj (vlax-ename->vla-object (car (entsel))))
(setq len (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj)))
(setq cen (vlax-curve-getPointAtDist obj (/ len 2)))
(setq goc (angle '(0 0 0) (vlax-curve-getFirstDeriv obj (vlax-curve-getParamAtPoint obj cen)))))

[Thaistreetz 539]

bỏ hàm vlax-ename->vla-object đi. lỗi ở tất cả các hàm vlax-curve trong code trên chứ không fải chỉ riêng (vlax-curve-getParamAtPoint obj cen) bởi

đối số của các hàm vlax-curve là ename, không fải là vla-object

[Doan Van Ha 3.202]

bỏ hàm vlax-ename->vla-object đi. lỗi ở tất cả các hàm vlax-curve trong code trên chứ không fải chỉ riêng (vlax-curve-getParamAtPoint obj cen) bởi

đối số của các hàm vlax-curve là ename, không fải là vla-object

Một số hàm vlax đối số có thể là ename hoặc vla-object. Bỏ đi hay không bỏ đi thì vẫn cứ lỗi trên bản vẽ đã post. Kết luận: lỗi ở tất cả hàm vlax-curve e không đúng.

[Thaistreetz 539]

Một số hàm vlax đối số có thể là ename hoặc vla-object. Bỏ đi hay không bỏ đi thì vẫn cứ lỗi trên bản vẽ đã post. Kết luận: lỗi ở tất cả hàm vlax-curve e không đúng.

Vậy thì đây là 1 trường hợp khó hiểu. lỗi do hàm (vlax-curve-getParamAtPoint obj cen) trả về nil => cen không nằm trên curve.

test lại bằng cách bắt điểm trực tiếp vào midpoint vẫn trả về nil: (vlax-curve-getParamAtPoint (car (entsel)) (osnap (getpoint) "_mid")) => trung điểm của đường thẳng này không nằm trên chính nó. ????????

Nếu dùng chuột kéo đầu hoặc đít của line đó qua chỗ khác thì lại trả về kết quả bình thường, mình nghĩ bạn có thể sử dụng code này bình thường bởi lẽ trường hợp đặc biệt như line này rất hiếm gặp. tôi có viết 1 chương trình rải taluy bình đồ, mỗi lần dùng nó vẽ ra cả nghìn đối tượng cũng chưa thấy gặp lỗi này bao giờ nên có thể an tâm.

[ketxu 2.984]

Cad có nhiều cái khó hiểu lắm ^^

(defun C:HA( / obj len cen goc)

(setq obj (vlax-ename->vla-object (car (entsel))))

(setq len (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj)))

(setq cen (vlax-curve-getPointAtDist obj (/ len 2.0)))

(setq cen (vlax-curve-getClosestPointToProjection obj cen (list 0 0 1)))

(setq goc (angle '(0 0 0) (vlax-curve-getFirstDeriv obj (vlax-curve-getParamAtPoint obj cen)))))

Ngoài ra, bác có thể dùng cách lấy FirstDeriv trong Help ^^

[Doan Van Ha 3.202]

Việc lấy góc thì còn có cách khác, tôi có biết, tuy nhiên tôi đã lỡ dùng nó mà bị lỗi nên cố tìm cho ra (tham khảo lại tài nguyên thì thấy có 1 siêu lisp nước ngoài cũng dùng hàm lấy góc như vậy mà không thấy phản hồi gì???). Tôi có 1 nhận định hơi chủ quan tí: các hàm vlax-curve-get... rất phiêu lưu, bởi chí ít tôi cũng đã bị việt vị 2 lần trong khi viết lisp giúp người khác. Vì vậy mà cực nguy hiểm, nếu đã lỡ viết một chương trình dài hơi rồi mà lỗi kiểu này thì có nước tiêu tán đường! Và không biết còn bao nhiêu phiêu lưu nữa đang rình rập đây. Chán!!!

Thank Ket đã thêm 1 dòng code để sửa lỗi.

[ketxu 2.984]

Việc lấy góc thì còn có cách khác, tôi có biết, tuy nhiên tôi đã lỡ dùng nó mà bị lỗi nên cố tìm cho ra (tham khảo lại tài nguyên thì thấy có 1 siêu lisp nước ngoài cũng dùng hàm lấy góc như vậy mà không thấy phản hồi gì???). Tôi có 1 nhận định hơi chủ quan tí: các hàm vlax-curve-get... rất phiêu lưu, bởi chí ít tôi cũng đã bị việt vị 2 lần trong khi viết lisp giúp người khác. Vì vậy mà cực nguy hiểm, nếu đã lỡ viết một chương trình dài hơi rồi mà lỗi kiểu này thì có nước tiêu tán đường! Và không biết còn bao nhiêu phiêu lưu nữa đang rình rập đây. Chán!!!

Thank Ket đã thêm 1 dòng code để sửa lỗi.

Ầy dà, siêu mấy thì siêu, chẳng qua là người ta chưa gặp lỗi đó thôi ^^ Thực ra cái phiêu lưu ở đây là hệ thống tọa độ UCS OCS WCS, 2D, 3D loạn xị ngậu. Cái này chắc phải phi sang Các lỗi thường gặp khi lập trình lisp

Code bác viết k vấn đề gì ở 2D, trường hợp bác gặp ở đây chắc chắn do chú màu xanh là hậu quả của việc giao ban từ đời 3D về 2D ^^

[Doan Van Ha 3.202]

1. Nhờ Ket chuyển qua bên mục đó giùm được không? Khi post xong tôi cũng nghĩ vậy, nhưng lỡ rồi. Giờ thêm bến ấy nữa thì loãng CV, chuyển tốt hơn.

2. Tôi nghĩ không phải thằng màu xanh là hậu quả giao ban từ 3D và 2D. Trên bản vẽ của người ta gởi có hàng loạt đường nằm san sát nhau như thế (chắc vẽ cùng lần???), tôi chỉ trích 3 đường để ví dụ thôi. Hàng loạt đường nằm 2 bên nó thì chả sao cả. Ket hay tham vấn trên các web lisp uy tín, thử hỏi giùm xem sao hè, vì tôi english đặc!

[hnhmai 6]

1. Nhờ Ket chuyển qua bên mục đó giùm được không? Khi post xong tôi cũng nghĩ vậy, nhưng lỡ rồi. Giờ thêm bến ấy nữa thì loãng CV, chuyển tốt hơn.

2. Tôi nghĩ không phải thằng màu xanh là hậu quả giao ban từ 3D và 2D. Trên bản vẽ của người ta gởi có hàng loạt đường nằm san sát nhau như thế (chắc vẽ cùng lần???), tôi chỉ trích 3 đường để ví dụ thôi. Hàng loạt đường nằm 2 bên nó thì chả sao cả. Ket hay tham vấn trên các web lisp uy tín, thử hỏi giùm xem sao hè, vì tôi english đặc!

 

Tôi thay biến cen của Bác bằng (OSNAP cen "_NEAR") thì không có lỗi. Chắc là do độ chính xác của các phép tính.

[Doan Van Ha 3.202]

Đã phát hiện ra sự khác nhau giữa 2 đường Line này. Có lẽ đường đỏ được vẽ từ Cad, đường xanh sinh ra từ 1 phần mềm nào đó nên DXF của chúng khác nhau.

Trích dẫn:

1). Đường đỏ:

(

(-1 . <Entity name: 7efad8c8>)

(0 . "LINE")

(330 . <Entity name: 7efa9cc0>)

(5 . "52469")

(100 . "AcDbEntity")

(67 . 0)

(410 . "Model")

(8 . "ranhdoc")

(62 . 1)

(100 . "AcDbLine")

(10 602087.0 1.63698e+006 0.0)

(11 602060.0 1.63695e+006 0.0)

(210 0.0 0.0 1.0)

)

 

2). Đường xanh:

(

(-1 . <Entity name: 7efad8c0>)

(0 . "LINE")

(330 . <Entity name: 7efa9cc0>)

(5 . "52468")

(100 . "AcDbEntity")

(67 . 0)

(410 . "Model")

(8 . "LAYER8")

(6 . "Continuous")

(370 . 0)

(100 . "AcDbLine")

(10 602099.0 1.63697e+006 0.0)

(11 602064.0 1.63695e+006 0.0)

(210 0.0 0.0 1.0)

)

[ketxu 2.984]

@ bác ĐVH : dòng code e thêm vào để chuyển điểm về cùng mặt phẳng với Obj (có vecto pháp tuyến (0 0 1)

3 mã dxf trên k liên quan gì ạ ^^

(61 : color , 6 : linetype , 370 : lineWeight)