Đến nội dung


Hình ảnh
- - - - -

Đếm, sắp xếp, ghi thông tin Block


  • Please log in to reply
14 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 02 September 2014 - 07:00 PM

Kính nhờ các cao thủ, mình có bài toán thế này:

  1. Có 1 điểm chuẩn (có tọa độ x,y)
  2. Xung quanh điểm chuẩn này có các Block (ở các layer, mầu sắc khác nhau)
  3. Mình muốn chọn các Block quanh điểm chuẩn trong cửa sổ ( cửa sổ này có góc dưới là x-30, y-30 và góc trên là x+30, y+30 số 30 là ví dụ có thể 20, 25, 35…)
  4. Các Block này mình muốn sắp xếp theo thứ tự theo khoảng cách đến điểm chuẩn từ gần nhất đến xa nhất.
  5. Các Block này chứa các thông tin sau ghi ra màn hình theo vị trí mình chỉ:
  • Vị trí hướng đông, tây, nam, bắc, đông nam… so với điểm chuẩn.
  • Tên Block
  • Khoảng cách từ Block đến điểm chuẩn

Rất mong các cao thủ chỉ bảo!http://www.cadviet.c...7907p_block.rar


  • 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 02 September 2014 - 08:58 PM

Kính nhờ các cao thủ, mình có bài toán thế này:

  1. Có 1 điểm chuẩn (có tọa độ x,y)
  2. Xung quanh điểm chuẩn này có các Block (ở các layer, mầu sắc khác nhau)
  3. Mình muốn chọn các Block quanh điểm chuẩn trong cửa sổ ( cửa sổ này có góc dưới là x-30, y-30 và góc trên là x+30, y+30 số 30 là ví dụ có thể 20, 25, 35…)
  4. Các Block này mình muốn sắp xếp theo thứ tự theo khoảng cách đến điểm chuẩn từ gần nhất đến xa nhất.
  5. Các Block này chứa các thông tin sau ghi ra màn hình theo vị trí mình chỉ:
  • Vị trí hướng đông, tây, nam, bắc, đông nam… so với điểm chuẩn.
  • Tên Block
  • Khoảng cách từ Block đến điểm chuẩn

Rất mong các cao thủ chỉ bảo!http://www.cadviet.c...7907p_block.rar

Lần đầu tiên thấy bạn nêu 1 y/c khá rành mạch (những lần trước thì y/c của bạn thường rất khó hiểu). Tuy nhiên, có 3 vấn đề thắc mắc:

1). "theo vị trí mình chỉ"  nghĩa là thế nào? Trong khi vị trí của chúng đã được xác định.

2). Nếu 1 block, ví dụ nằm giữa hướng "Bắc" và "Đông - Bắc" thì ghi hướng là "Bắc, Đông - Bắc" phải không?

3). Vị trí của Block được quy định là điểm chèn của Block phải không?

Tôi đang bận. Nếu 2 ngày sau chưa ai giúp thì tôi viết cho bạn.


  • 1

* 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 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 02 September 2014 - 09:06 PM

Lần đầu tiên thấy bạn nêu 1 y/c khá rành mạch (những lần trước thì y/c của bạn thường rất khó hiểu). Tuy nhiên, có 3 vấn đề thắc mắc:

1). "theo vị trí mình chỉ"  nghĩa là thế nào? Trong khi vị trí của chúng đã được xác định.

2). Nếu 1 block, ví dụ nằm giữa hướng "Bắc" và "Đông - Bắc" thì ghi hướng là "Bắc, Đông - Bắc" phải không?

3). Vị trí của Block được quy định là điểm chèn của Block phải không?

Tôi đang bận. Nếu 2 ngày sau chưa ai giúp thì tôi viết cho bạn.

Cảm ơn bạn Hà đã quan tâm!

1. Theo vị trí mình chỉ -- cũng có thể là tại vị trí Block đó luôn bạn ạ!

2. Nếu 1 block, ví dụ nằm giữa hướng "Bắc" và "Đông - Bắc" thì ghi hướng là "Bắc, Đông - Bắc" phải không?--> Trong hình vẽ gửi kèm mình cũng ghi rõ giữa Đông- Bắc thì là Đông Bắc; Đông- Nam thì là Đông Nam...

3. Vị trí của Block được quy định là điểm chèn của Block phải không? --> Đúng là điểm chèn của Block đó bạn!

Rất mong được bạn quan tâm chỉ giúp!

3. Đúng


  • 0

#4 tien2005

tien2005

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 257 Bài viết
Điểm đánh giá: 94 (tàm tạm)

Đã gửi 02 September 2014 - 10:37 PM

BẠn thử cái này, chỉ ghi theo 8 hướng

không biết đặt tên gì, thôi thì NONAME :(

(defun c:NoName	(/ p0 p1 ss pn ang dirr dxf maketext)
  (defun dxf (code e) (cdr (assoc code (entget e))))
  (defun maketext (p height str)
    (entmake (list (cons 0 "TEXT")
		   (cons 10 p)
		   (cons 40 height)
		   (cons 1 str)
	     )
    )
  )
  (or rank# (setq rank# 30))
  (setq	rank# (cond ((getint (strcat "\nDo lon cua so de chon <"
				     (rtos rank# 2 0)
				     ">: "
			     )
		     )
		    )
		    (rank#)
	      )
  )
  (command ".undo" "be")
  (while (and (setq p0 (getpoint "\nChon diem chuan: "))
	      (setq ss
		     (ssget "x"
			    (list (cons 0 "insert")
				  (cons -4 ">=,>=,*")
				  (cons 10 (mapcar '- p0 (list rank# rank# rank#)))
				  (cons -4 "<=,<=,*")
				  (cons 10 (mapcar '+ p0 (list rank# rank# rank#)))

			    )
		     )
	      )
	 )
    (setq p1
	   (cond
	     ((getpoint
		"\nChon diem ghi ket qua hoac enter de ghi tai diem chuan: "
	      )
	     )
	     (p0)
	   )
    )

    (setq
      ss (vl-sort (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
		  '(lambda (x y)
		     (<	(distance p0 (dxf 10 x))
			(distance p0 (dxf 10 y))
		     )
		   )
	 )
    )
    (foreach n ss
      (setq pn	(dxf 10 n)
	    ang	(angle p0 pn)
      )
      (cond
	((or (>= (/ pi 8) ang) (< (/ (* 15 pi) 8) ang))
	 (setq dirr "Dong")
	)
	((>= (/ (* 3 pi) 8) ang) (setq dirr "Dong Bac"))
	((>= (/ (* 5 pi) 8) ang) (setq dirr "Bac"))
	((>= (/ (* 7 pi) 8) ang) (setq dirr "Tay Bac"))
	((>= (/ (* 9 pi) 8) ang) (setq dirr "Tay"))
	((>= (/ (* 11 pi) 8) ang) (setq dirr "Tay Nam"))
	((>= (/ (* 13 pi) 8) ang) (setq dirr "Nam"))
	((>= (/ (* 15 pi) 8) ang) (setq dirr "Dong Nam"))
      )
      (maketext p1 2.5 dirr)
      (maketext	(setq p1 (mapcar '- p1 (list 0 5 0)))
		2.5
		(dxf 2 n)
      )
      (maketext	(setq p1 (mapcar '- p1 (list 0 5 0)))
		2.5
		(strcat "L=" (rtos (distance p0 pn) 2 2))
      )
      (setq p1 (mapcar '- p1 (list 0 8 0)))
    )					;for

  )					;while
  (command ".undo" "en")
  (princ)
)

 


  • 1

#5 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 02 September 2014 - 10:50 PM

Không hiểu hết ý của bạn ở cái đoạn "mình chỉ" nên tạm thế này.

; Font va Height cua Text theo Current Text.
(defun C:HA(/ pc cr ptd ppt ss lst pg ten dis goc hng)
 (setq pc (getpoint "\nChon diem chuan: "))
 (setq cr (getreal "\nNhap chieu rong khung Window: "))
 (setq ptd (polar pc (* 1.25 pi) (* (/ cr 2) (sqrt 2))))
 (setq ppt (polar pc (* 0.25 pi) (* (/ cr 2) (sqrt 2))))
 (setq ss (ssget "c" ptd ppt '((0 . "Insert"))))
 (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
 (setq lst (vl-sort lst '(lambda(e1 e2) (< (distance pc (cdr (assoc 10 (entget e1)))) (distance pc (cdr (assoc 10 (entget e2))))))))
 (foreach ent lst
  (setq pg (cdr (assoc 10 (entget ent)))) 
  (setq ten (cdr (assoc 2 (entget ent))))
  (setq dis (distance pc pg))
  (setq goc (angle pc pg))
  (setq hng
   (cond
    ((equal goc 0 1E-3) "D")
((equal goc (/ pi 2) 1E-3) "B")
((equal goc pi 1E-3) "T")
((equal goc (* 1.5 pi) 1E-3) "N")
    ((< 0 goc (/ pi 2)) "DB")
((< (/ pi 2) goc pi) "TB")
((< pi goc (* 1.5 pi)) "TN")
((< (* 1.5 pi) goc (* 2 pi)) "DN")))
  (entmakex (list (cons 0 "TEXT") (cons 10 pg) (cons 40 (getvar 'textsize)) (cons 1 (strcat hng "_" ten "_" (rtos dis 2 2)))))))
 


  • 1

* 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.


#6 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 03 September 2014 - 08:47 AM

Cảm ơn bạn  tien2005 bạn làm chuẩn thế đúng ý mình rồi

Mình quên bạn có thể bổ sung thêm cho mình ghi tên tại vị trí Block từ gần nhất đến xa nhất theo A, B, C... được không?

Cám ơn bạn nhiều!

Chương trình bạn Hạ khi mình load vào nó báo ; error: syntax error Mình không tìm ra chỗ nào bạn ạ!


  • 0

#7 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 03 September 2014 - 09:51 AM

Bỏ cái chữ <span> đi. Đây là lỗi CadViet.


  • 1

* 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.


#8 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 03 September 2014 - 09:55 AM

Bỏ cái chữ <span> đi. Đây là lỗi CadViet.

Cảm ơn Bạn Hạ!


  • 0

#9 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 03 September 2014 - 10:07 AM

Bỏ cái chữ <span> đi. Đây là lỗi CadViet.

Bạn Hạ có thể bổ sung thêm cho mình ghi tên tại vị trí Block từ gần nhất đến xa nhất theo A, B, C... được không?

Cám ơn bạn nhiều!


  • 0

#10 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 03 September 2014 - 10:12 AM

Không hiểu!


  • 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.


#11 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 03 September 2014 - 10:15 AM

Không hiểu!

Tức là lại mốc gần điểm chuẩn nhất ghi chữ A

Mốc gần thứ 2 ghi chữ B

Mốc gần thứ 3 ghi chữ C

...


  • 0

#12 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 03 September 2014 - 10:24 AM

A, B, C... là thay "hướng", "tên block" hay "khoảng cách"?


  • -1

* 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.


#13 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 03 September 2014 - 10:26 AM

A, B, C... là thay "hướng", "tên block" hay "khoảng cách"?

A, B, C là đọc lập không thay "hướng", "tên block" hay "khoảng cách"

ABC như 1,2 3,... bạn ạ

Xin lỗ bạn mình vừa ấn nhầm nút!


  • 0

#14 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 03 September 2014 - 10:45 AM

Đây. Nhưng hết chữ cái thì ráng chịu nghe!

; Font va Height cua Text theo Current Text.
(defun C:HA(/ pc cr ptd ppt ss lst pg ten dis goc hng x)
 (setq pc (getpoint "\nChon diem chuan: "))
 (setq cr (getreal "\nNhap chieu rong khung Window: "))
 (setq ptd (polar pc (* 1.25 pi) (* (/ cr 2) (sqrt 2))))
 (setq ppt (polar pc (* 0.25 pi) (* (/ cr 2) (sqrt 2))))
 (setq ss (ssget "c" ptd ppt '((0 . "Insert"))))
 (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
 (setq lst (vl-sort lst '(lambda(e1 e2) (< (distance pc (cdr (assoc 10 (entget e1)))) (distance pc (cdr (assoc 10 (entget e2))))))))
 (setq x 65)
 (repeat (length lst)
  (setq ent (nth (- x 65) lst))
  (setq pg (cdr (assoc 10 (entget ent)))) 
  (setq ten (cdr (assoc 2 (entget ent))))
  (setq dis (distance pc pg))
  (setq goc (angle pc pg))
  (setq hng
   (cond
    ((equal goc 0 1E-3) "D")
((equal goc (/ pi 2) 1E-3) "B")
((equal goc pi 1E-3) "T")
((equal goc (* 1.5 pi) 1E-3) "N")
    ((< 0 goc (/ pi 2)) "DB")
((< (/ pi 2) goc pi) "TB")
((< pi goc (* 1.5 pi)) "TN")
((< (* 1.5 pi) goc (* 2 pi)) "DN")))
  (entmakex (list (cons 0 "TEXT") (cons 10 pg) (cons 40 (getvar 'textsize)) (cons 1 (strcat (chr x) "_" hng "_" ten "_" (rtos dis 2 2)))))
  (setq x (1+ x))))
 


  • 1

* 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.


#15 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 03 September 2014 - 10:55 AM

Đây. Nhưng hết chữ cái thì ráng chịu nghe!

; Font va Height cua Text theo Current Text.
(defun C:HA(/ pc cr ptd ppt ss lst pg ten dis goc hng x)
 (setq pc (getpoint "\nChon diem chuan: "))
 (setq cr (getreal "\nNhap chieu rong khung Window: "))
 (setq ptd (polar pc (* 1.25 pi) (* (/ cr 2) (sqrt 2))))
 (setq ppt (polar pc (* 0.25 pi) (* (/ cr 2) (sqrt 2))))
 (setq ss (ssget "c" ptd ppt '((0 . "Insert"))))
 (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
 (setq lst (vl-sort lst '(lambda(e1 e2) (< (distance pc (cdr (assoc 10 (entget e1)))) (distance pc (cdr (assoc 10 (entget e2))))))))
 (setq x 65)
 (repeat (length lst)
  (setq ent (nth (- x 65) lst))
  (setq pg (cdr (assoc 10 (entget ent)))) 
  (setq ten (cdr (assoc 2 (entget ent))))
  (setq dis (distance pc pg))
  (setq goc (angle pc pg))
  (setq hng
   (cond
    ((equal goc 0 1E-3) "D")
((equal goc (/ pi 2) 1E-3) "B")
((equal goc pi 1E-3) "T")
((equal goc (* 1.5 pi) 1E-3) "N")
    ((< 0 goc (/ pi 2)) "DB")
((< (/ pi 2) goc pi) "TB")
((< pi goc (* 1.5 pi)) "TN")
((< (* 1.5 pi) goc (* 2 pi)) "DN")))
  (entmakex (list (cons 0 "TEXT") (cons 10 pg) (cons 40 (getvar 'textsize)) (cons 1 (strcat (chr x) "_" hng "_" ten "_" (rtos dis 2 2)))))
  (setq x (1+ x))))
 

CẢM ƠN BẠN HẠ!


  • 0