Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
4 replies to this topic

#1 DanKhaosat

DanKhaosat

    biết lệnh scale

  • Members
  • PipPipPip
  • 149 Bài viết
Điểm đánh giá: 14 (tàm tạm)

Đã gửi 31 July 2014 - 09:59 PM

Đư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!


  • 0

#2 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 31 July 2014 - 10:38 PM

Anh gửi file đi


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#3 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 31 July 2014 - 10:45 PM

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

  • 1



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#4 nguyentuyen6

nguyentuyen6

    biết lệnh chamfer

  • Advance Member
  • PipPipPipPip
  • 213 Bài viết
Điểm đánh giá: 124 (tàm tạm)

Đã gửi 01 August 2014 - 12:24 AM

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

  • 2

Lisp In bản vẽ hàng loạt:
http://www.cadviet.c...ndpost&p=139860


#5 DanKhaosat

DanKhaosat

    biết lệnh scale

  • Members
  • PipPipPip
  • 149 Bài viết
Điểm đánh giá: 14 (tàm tạm)

Đã gửi 01 August 2014 - 06:09 AM

Cảm ơn bạn  nguyentuyen6 và Thanh Duân nhé


  • 1