Chuyển đến nội dung
Diễn đàn CADViet
DanKhaosat

Đưa Block về point gần nhất

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

Đưa Block về point gần nhất

Mình tìm trên diễn đàn đã có lisp đưa text về ponit gầm nhất nhưng chưa thấy có lisp đưa Block về point gần nhất, đầu bài mình là:

1. Trên bản vẽ có point và nhiều loại Block (Block có tên khác nhau)

2. Đưa 1 loại block chọn về điểm point gần nhất ( khoảng cách lớn nhất tùy giá trị mình cho)

Kính mời các cao nhân giúp đỡ

Chân thành cảm ơ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

Của anh đây. Em đã sửa lại lisp của bác TOT77

(defun c:BL2P(/ os ss ss1 ss2 cd) 
  (defun layxy(a) (list (car a) (cadr a)))
  (defun leftL(L n / l1 i) (setq l1 nil i -1) (while (and (< (setq i (1+ i)) n) (nth i L)) (setq l1 (append l1 (list (nth i L))))))
  (defun doi (id tri v)   (entmod (subst (cons id tri) (assoc id (entget v)) (entget v))))
  (setq ss (ssget (list (cons 0 "INSERT,POINT"))))
(setq ss1 (vl-remove nil (mapcar '(lambda(x) (if (= (acet-dxf 0 (entget x)) "INSERT") (cons (layxy (acet-dxf 10 (entget x))) x) nil)) (acet-ss-to-list ss))))
(setq ss1 (vl-sort (vl-sort ss1 '(lambda(x y) (< (cadar x) (cadar y)))) '(lambda(x y) (< (caar x) (caar y)))))
(setq ss2 (vl-remove nil (mapcar '(lambda(x) (if (= (acet-dxf 0 (entget x)) "POINT") (layxy (acet-dxf 10 (entget x))) nil)) (acet-ss-to-list ss))))
(setq ss2 (vl-sort (vl-sort ss2 '(lambda(x y) (< (cadr x) (cadr y)))) '(lambda(x y) (< (car x) (car y)))))
  (foreach v ss1    
    (doi 10 (setq cd (car (vl-sort (leftL ss2 10) '(lambda(x y) (< (distance x (car v)) (distance y (car v))))))) (cdr v))
    (setq ss2 (vl-remove cd  ss2))
  )
)
  • Vote tăng 1

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

Bạn thanhduan viết rồi mà thôi kệ mình cứ post thử cái này. :D

 

(defun c:b2p(/ lst lstData lstB lstP p index kc)
	(and
	    (setq kc (getdist "\nKhoang cach toi da:" ));;;setq
	    (setq  ten_blk (cdr (assoc 8 (entget(car (entsel "\nChon block mau:"))))))
		(princ "\nChon vung thuc hien");;;princ
		(setq ss (ssget (list (cons 0 "INSERT,POINT"))))
		(setq lstData (acet-ss-to-list ss))
		(foreach e lstData (if (and (= (cdr (assoc 0 (entget e))) "INSERT")(= (cdr (assoc 8 (entget e))) ten_blk)) (setq lstB (cons e lstB)))
						   (if (= (cdr (assoc 0 (entget e))) "POINT") (setq lstP (cons e lstP)))
		)
	)
	;(princ lstP)
	(setq index 0)
	(while (< index (length lstB))
		(setq xx  (nth index lstB));;;setq
		(setq p (cdr (assoc 10 (entget xx))))
		(setq lstP (vl-sort lstP '(lambda(x y)(<= (distance (cdr (assoc 10 (entget x))) p)(distance (cdr (assoc 10 (entget y))) p)))))
		(if (< (distance (cdr (assoc 10 (entget (car lstP)))) p)  kc)
			(entmod (subst (cons 10 (cdr (assoc 10 (entget (car lstP))))) (assoc 10 (entget xx)) (entget xx))) ;;; if T
		)
		(setq index (1+ index))
	);;; end While 
)
;;;ketxu
  • Vote tăng 2

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


×