Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
vanhoatnguyen

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

Các bài được khuyến nghị

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.com/upfiles/3/103883_ldp.lsp

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
ketxu    2.652

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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
ketxu    2.652

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 ?

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

Đăng nhập để thực hiện theo  

×