Đến nội dung


Hình ảnh
- - - - -

Nhờ chỉnh sửa: Lisp trim leader


  • Please log in to reply
3 replies to this topic

#1 vanhoatnguyen

vanhoatnguyen

    biết zoom

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

Đã gửi 28 February 2012 - 05:44 PM

Trước tiên cho em gửi lời xin lỗi tới các bác Admin vì lần đầu nhờ các bác giúp đỡ mà lại không được đúng theo yêu cầu của diễn đàn. Mong các bác thông cảm vì em cứ nghĩ nhờ các bác giúp đỡ thêm thì cứ post luôn vào đó (topic Trim leader), nếu có yêu cầu mới hẳn thì mới lập một topic mới, mà em cũng chưa biết sửa một topic thì làm sao. Thành thật xin lỗi các bác!
Lần này em cũng chưa biết mình đã làm đúng theo yêu cầu chưa, nếu lại sai thì mong các bác thứ lỗi nhé.
Em muốn nhờ các bác sửa giúp em lisp trim leader thành kiểu mình chỉ cần click vào một leader rồi những leader khác chỉ cần "chạm" vào leader đó là tự động được chọn cùng về cùng một điểm chân.

http://www.cadviet.c.../103883_ldp.lsp
  • 0

#2 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 28 February 2012 - 11:29 PM

Mình về muộn, quick code và còn nhiều vấn đề, bạn dùng tạm, lúc khác sửa sau :


(defun c:ldp (/ LM:mAssoc p lst ss lstSS new ld duoi)
;Free lisp from Cadviet @Ketxu
(defun LM:mAssoc ( key lst / pair )
(if (setq pair (assoc key lst))
(cons (cdr pair) (LM:mAssoc key (cdr (member pair lst))))
)
)
(and (setq ld (ssget ":S" '((0 . "*LEADER")))
ld (ssname ld 0)
duoi (last (LM:mAssoc 10(entget ld)))
p (getpoint "\nDiem dat chung :")
new ld
)
(while (and (setq ss (ssget "c" duoi duoi '((0 . "*LEADER")))) (= (sslength ss) 2))
(setq lstSS (cons (setq new (car (vl-remove new (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))) lstSS)
duoi (last (LM:mAssoc 10 (entget new)))
)
)

(foreach subLd (cons ld lstSS)
(entmod (subst (cons 10 p) (cons 10 (last (LM:mAssoc 10 (setq lst (entget subLd))))) lst))
)
))

  • 0

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


#3 vanhoatnguyen

vanhoatnguyen

    biết zoom

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

Đã gửi 01 March 2012 - 09:41 AM

Bác Ketxu ơi em vẫn chưa dùng được. Lúc nào rảnh bác sửa lại giúp em với nhé!
Thanks bác!
  • 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 01 March 2012 - 09:58 AM

Bác Ketxu ơi em vẫn chưa dùng được. Lúc nào rảnh bác sửa lại giúp em với nhé!
Thanks bác!

Lại bốc thuốc qua thư à bạn ?
  • 0

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