Đến nội dung


Hình ảnh
- - - - -

[Nhờ giúp đỡ] Thêm code vào lisp


  • Please log in to reply
14 replies to this topic

#1 amateurday

amateurday

    biết lệnh break

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

Đã gửi 09 May 2012 - 01:28 PM

Em lấy được code này trên mạng. Chức năng là cho tất cả image path của image có trên bản vẽ thành "no path" giống như xref với điều kiện là file bản vẽ và file ảnh nằm cùng folder. Nếu trong folder không có image đó thì lisp không có tác dụng, cũng không báo cho mình biết. Em muốn nếu không tìm được image thì lisp sẽ báo lỗi cho người dùng biết. Nhờ các bác giúp em.

(defun stripimagepath (/ el imgdef path)
(if (setq imgdef (cdadr (member '(3 . "ACAD_IMAGE_DICT") (entget (namedobjdict)))))
(foreach x (entget imgdef)
(and (eq (car x) 350)
(setq path (cdr (assoc 1 (setq el (entget (cdr x))))))
(setq path (strcat (vl-filename-base path) (vl-filename-extension path)))
(findfile (strcat (getvar 'dwgprefix) path))
(entmod (subst (cons 1 path) (assoc 1 el) el))
)
)
(princ "\n Not OK")
)
(princ)
)
(stripimagepath)

  • 0

#2 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5454 Bài viết
Điểm đánh giá: 2626 (tuyệt vời)

Đã gửi 09 May 2012 - 01:48 PM

Em lấy được code này trên mạng. Chức năng là cho tất cả image path của image có trên bản vẽ thành "no path" giống như xref với điều kiện là file bản vẽ và file ảnh nằm cùng folder. Nếu trong folder không có image đó thì lisp không có tác dụng, cũng không báo cho mình biết. Em muốn nếu không tìm được image thì lisp sẽ báo lỗi cho người dùng biết. Nhờ các bác giúp em.

Hình như khi không tìm được thì nó đã in ra dòng "Not OK" rồi mà?
  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#3 amateurday

amateurday

    biết lệnh break

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

Đã gửi 09 May 2012 - 02:00 PM

Dòng not OK là em thêm vào vì em chưa hiểu mà của lisp trên, thêm vào mới biết nó không có tác dụng.
Em muốn nó báo lỗi khi không tìm thấy file ảnh đó cùng thư mục với file bản vẽ.
Các bác chỉnh giúp em nhé!
  • 0

#4 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5685 Bài viết
Điểm đánh giá: 2606 (tuyệt vời)

Đã gửi 09 May 2012 - 02:33 PM

File ảnh đó là file nào :D Cứ 1 lần k thấy file nằm cùng chỗ bản vẽ lại báo à :D (bản vẽ có nhiều ánh xạ ảnh)


(defun stripimagepath (/ imgdef el path)
(if (setq imgdef (cdadr (member '(3 . "ACAD_IMAGE_DICT") (entget (namedobjdict)))))
(foreach x (entget imgdef)
(cond ((eq (car x) 350)
(setq path (cdr (assoc 1 (setq el (entget (cdr x))))))
(cond ((equal (vl-string-right-trim "\\" (getvar 'dwgprefix))(vl-filename-directory path))
(entmod (subst (cons 1 (strcat (vl-filename-base path) (vl-filename-extension path))) (assoc 1 el) el))
)
(T (alert "Co mot anh k nam chung thu muc voi file DWG"))
)
)
)
)
))

  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#5 amateurday

amateurday

    biết lệnh break

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

Đã gửi 09 May 2012 - 03:16 PM

Lisp không chạy đúng ý em rồi. file ảnh là file abc.png(nằm khác folder với bản vẽ) được xref vào bản vẽ, em muốn chuyển save path của nó thành no path theo lisp trên. Muốn vậy thì phải có file abc.png cùng folder thì mới no path được. Nếu chưa có file ảnh đó thì lisp báo để mình copy vào. Nếu file ảnh có rồi thì lisp chuyển no path là xong.
Bác ketxu nói em mới nghĩ ra, vậy lisp có thể báo tên những file ảnh không có cùng thư mục được không bác nhỉ?
Với lại bảng thông báo phải OK 2 lần mới tắt bác à.
Nhờ các bác giúp em.
  • 0

#6 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5685 Bài viết
Điểm đánh giá: 2606 (tuyệt vời)

Đã gửi 09 May 2012 - 03:42 PM

Lisp không chạy đúng ý em rồi. file ảnh là file abc.png(nằm khác folder với bản vẽ) được xref vào bản vẽ, em muốn chuyển save path của nó thành no path theo lisp trên. Muốn vậy thì phải có file abc.png cùng folder thì mới no path được. Nếu chưa có file ảnh đó thì lisp báo để mình copy vào. Nếu file ảnh có rồi thì lisp chuyển no path là xong.
Bác ketxu nói em mới nghĩ ra, vậy lisp có thể báo tên những file ảnh không có cùng thư mục được không bác nhỉ?
Với lại bảng thông báo phải OK 2 lần mới tắt bác à.
Nhờ các bác giúp em.

Hô. Ý đầu mình giữ nguyên nguyên tắc làm việc của lisp bạn post
- Số thông báo ở cái đầu mình viết phụ thuộc vào số ảnh mà nó k No Path được
- Viết lại cái gộp hết vào 1 thông báo hoặc tự động copy, mình k có CAD để test nhưng đã ghi chú trong code, bạn tự tìm hiểu nhé :)

(defun stripimagepath (/ imgdef path el lst)
(if (setq imgdef (cdadr (member '(3 . "ACAD_IMAGE_DICT") (entget (namedobjdict)))))
(foreach x (entget imgdef)
(cond ((eq (car x) 350)
(setq path (cdr (assoc 1 (setq el (entget (cdr x))))))
(cond ((equal (vl-string-right-trim "\\" (setq a (getvar 'dwgprefix)))(vl-filename-directory path))
(entmod (subst (cons 1 (setq b (strcat (vl-filename-base path) (vl-filename-extension path)))) (assoc 1 el) el))
)
((eq (vl-filename-directory path) ""))
(T
(setq lst (cons path lst))
; Xoa dau ";" dau dong ben duoi + xoa toan bo dong ben tren neu muon tu copy
;(vl-file-copy path (strcat a B)) (stripimagepath)
)
)
)
)
)
)
;Xoa het doan nay neu muon tu copy
(if lst (alert (strcat "\nCac anh khong nam chung thu muc file CAD :\n"
(apply 'strcat (mapcar '(lambda(x)(strcat "- " x "\n")) lst))))
)
)

  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#7 amateurday

amateurday

    biết lệnh break

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

Đã gửi 09 May 2012 - 08:55 PM

Em phải kết hợp 2 lisp mới đúng được ý em. Cảm ơn bác nhiều, phần copy (có phải là copy ảnh thiếu vào folder bản vẽ) thì em không biết nên xóa thế nào, phía dưới thì em xóa hết rồi, còn phía trên thì không biết xóa dòng nào, em thử nhưng không được. Phần lisp này cao cấp quá em chưa hiểu được. Nhờ bác giúp em nhé. Bác không có cad mà viết được hay thế.

P/S:
Nhờ bác giải thích cho em phần này nhé:
- (cdadr (member '(3 . "ACAD_IMAGE_DICT"): ý nghĩa các lệnh trong này em không rõ

- namedobjdict: đối tượng này em cũng không hiểu, nó là biến hay loại đt của cad nhỉ.
- (setq b (strcat (vl-filename-base path) (vl-filename-extension path))): dòng này hình như có lỗi, em chép vào command mà không chạy.
  • 0

#8 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5685 Bài viết
Điểm đánh giá: 2606 (tuyệt vời)

Đã gửi 09 May 2012 - 10:09 PM

Nó là 1 object phi hình học :D Bạn hãy thử đánh từng dòng 1 vào command, từ trong ra ngoài sẽ hiểu ý nghĩa của nó thôi mà. (đoạn này để chắc chắn có Image trong file)
  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#9 amateurday

amateurday

    biết lệnh break

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

Đã gửi 09 May 2012 - 10:26 PM

Em hỏi nhiều thế mà bác trả lời có tí tẹo.
  • 0

#10 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5685 Bài viết
Điểm đánh giá: 2606 (tuyệt vời)

Đã gửi 09 May 2012 - 10:50 PM

Bạn bật help develop lên là có hết mà :o
- (cdadr lst) = (cdr (car (cdr lst)))
- (member item lst) = lấy list con từ vị trí phần tử item trong list (nếu có)
- (vl-filename-base path) : tên file trong pathname, k bao gồm đuôi mở rộng
- (vl-filename-extension path) : đuôi mở rộng => b : tên đầy đủ của file
- "ACAD_IMAGE_DICT" là tên cho đối tượng Dictionary Image (Cad đặt như thế)
- Câu bạn hỏi xóa dòng nào thì chỉ xóa 1 dòng thôi
  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#11 amateurday

amateurday

    biết lệnh break

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

Đã gửi 10 May 2012 - 04:24 PM

Bác thử test cho em chứ em xóa cad không hiểu, chắc phải tùy người xóa mới được. Hic
  • 0

#12 amateurday

amateurday

    biết lệnh break

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

Đã gửi 11 May 2012 - 12:24 PM

Em không sửa đc lisp này. Em không hiểu hàm T để làm gì, trong help nói không rõ. Bác ket xem hộ em nhé.
  • 0

#13 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 11 May 2012 - 01:44 PM

Em không sửa đc lisp này. Em không hiểu hàm T để làm gì, trong help nói không rõ. Bác ket xem hộ em nhé.

Bạn đọc thêm trong Help -> Hàm COND
  • 1

#14 amateurday

amateurday

    biết lệnh break

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

Đã gửi 12 May 2012 - 08:16 AM

Em vẫn không hiểu ý nghĩa của cái vd trong help lắm, các bác có thể giải thích cho em về hàm T và COND đi. Còn về phần lisp trên thì em xóa vẫn không chạy được, bó tay. Em chỉnh theo ý em, không biết có thể ngắn gọn hay hợp lý được hơn không, nhờ các bác kiểm tra lại nhé!!!


(defun stripimagepath (/ imgdef path el lst)
(if (setq imgdef (cdadr (member '(3 . "ACAD_IMAGE_DICT") (entget (namedobjdict)))))
(foreach x (entget imgdef)
(cond ((eq (car x) 350)
(setq path (cdr (assoc 1 (setq el (entget (cdr x))))))
(setq a (getvar 'dwgprefix))
(setq b (strcat (vl-filename-base path) (vl-filename-extension path)))
(if (not (findfile (strcat a B)))
(progn
(vl-file-copy path (strcat a B))
(entmod (subst (cons 1 (setq b (strcat (vl-filename-base path) (vl-filename-extension path)))) (assoc 1 el) el))
)
)
)
)
)
)
)

  • 0

#15 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5685 Bài viết
Điểm đánh giá: 2606 (tuyệt vời)

Đã gửi 12 May 2012 - 09:37 AM

Hàm COND + T hoạt động như thế nào, bạn nghiên cứu ở đây nhé. Mình chưa có thời gian để test lại lisp của bạn
  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC