Đến nội dung


Hình ảnh
5 stars - based on 24598 reviews
- - - - -

Xin Giúp Đỡ Lisp Chèn 1 Block Vào Tâm Của Nhiều Hình Chữ Nhật


  • Please log in to reply
9 replies to this topic

#1 đặng phụng

đặng phụng

    biết zoom

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

Đã gửi 10 August 2017 - 08:33 AM

Xin nhờ các pro giúp đỡ!

Em có một block, muốn chèn block này vào tâm của nhiều hình chữ nhật (các hình chữ nhật này không giống nhau về chiều dài, rộng).Vì làm thủ công kẻ đường chéo rồi copy vào rất mất thời gian, mong lên diễn đàn nhờ các pro giúp đỡ e. Xin chân thành cảm ơn!

P/S: Câu lệnh như thế này các bác ạ.

- gõ lệnh: CBT

- select objects: Hãy chọn các hình chữ nhật:

- chon block


  • 0

#2 quang_lac

quang_lac

    biết lệnh stretch

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

Đã gửi 10 August 2017 - 09:54 AM

(defun c:brc (/ retcen osmode idx rectangles ins );Chen Block vao tam rectang
(defun rectcen (rect / pl p1 p2 p3 p4 pm1 pm2 an di ceo)
(setq ceo (vlax-ename->vla-object rect))
(setq pl (vlax-safearray->list (vlax-variant-value (vla-get-coordinates ceo))))
(if (> (length pl) 6)
(progn
(setq p1 (list (nth 0 pl) (nth 1 pl)))
(setq p2 (list (nth 2 pl) (nth 3 pl)))
(setq p3 (list (nth 4 pl) (nth 5 pl)))
(setq p4 (list (nth 6 pl) (nth 7 pl)))
(setq pm1 (mapcar '/ (mapcar '+ p1 p3) '(2.0 2.0 2.0)))
(setq pm2 (mapcar '/ (mapcar '+ p2 p4) '(2.0 2.0 2.0)))
(cond
((and
(equal (distance pm1 p1)(distance pm2 p1) 0.001)
(equal (distance pm1 p2)(distance pm2 p2) 0.001)
(equal (distance pm1 p3)(distance pm2 p3) 0.001)
(equal (distance pm1 p4)(distance pm2 p4) 0.001)
)
(inters p1 p3 p2 p4 nil)
)
)
)
)
)
;----------------------------------------------
(vl-load-com)
(command "undo" "begin")
(command "ucs" "w")
(setq osmode (getvar "osmode"))
(setvar "osmode" 0)
(if
(setq rectangles (ssget '((0 . "LWPOLYLINE"))))
(progn
(setq idx 0)
(repeat (sslength rectangles)
(setq ins (rectcen (ssname rectangles idx)))
(if ins (command "-insert" "s" ins "" "" ""))
(setq idx (1+ idx))
)
)
(princ "\n Selected(s) object(s) are not Lwpolyline!")
)
(command "undo" "end")
(setvar "osmode" osmode)
(princ)
) 

thay từ "S" bôi đỏ bằng tên block của bạn


  • 1

#3 lp_hai

lp_hai

    biết lệnh Xplode

  • Members
  • PipPipPipPipPipPip
  • 481 Bài viết
Điểm đánh giá: 207 (khá)

Đã gửi 10 August 2017 - 01:27 PM


thay từ "S" bôi đỏ bằng tên block của bạn

Bạn thay cái "s" bằng đoạn code lấy tên block mẫu để có thể áp dụng cho mọi block:
(setq name(cdr (assoc 2 (entget (car (entsel))))))


  • 0

#4 đặng phụng

đặng phụng

    biết zoom

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

Đã gửi 10 August 2017 - 03:02 PM

Bác quang_lac viết cho e đoạn lisp trên sử dụng ngon.Trước tiên e cảm ơn bác đã dành ít thời gian của mình viết đoạn code trên. Tuy nhiên e có vấn đề là tỷ lệ chèn block so với block gốc có sự khác nhau cụ thể: khi khai báo trong drawing units phần insertion scale ở hệ inches thì các block chèn bằng block gốc. Còn khi ở hệ millimeter thì chèn tỷ lệ không đúng với block gốc( block chèn to hơn nhiều so với block gốc) .Các bản vẽ của e ở hệ milimet vậy bác có thể giúp e sửa lại đoạn code trên được không. Nếu bác giúp sẵn bác thêm trường hợp tổng quát chọn block nào tuỳ thích không cần phải đưa tên block vào đoạn code trên.Cảm ơn bác lần nữa.


  • 0

#5 lp_hai

lp_hai

    biết lệnh Xplode

  • Members
  • PipPipPipPipPipPip
  • 481 Bài viết
Điểm đánh giá: 207 (khá)

Đã gửi 10 August 2017 - 03:14 PM

Góp vui tí :)

(defun c:cbr (/ dt bl sdt id en)
  (command "Undo" "be")
  (setq osm (getvar "osmode")
	bl (cdr (assoc 2 (entget(car (entsel "\nSelect block:")))))
	dt (ssget '((-4 . "<OR")
		(0 . "LWPOLYLINE")
		(-4 . "OR>")	
		))
	sdt (sslength dt)
	id 0
	)
  (setvar "osmode" 0)
  (repeat sdt
    (setq en (ssname dt id)
	  id (1+ id)
	  )
    (midp en)
    )
  (setvar "osmode" osm)
  (command "undo" "end")
  (princ)
  )
    
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;	
(defun midp (en / p2 p4 pm)
  (setq p2 (vlax-curve-getPointAtParam en 2)
	p4 (vlax-curve-getPointAtParam en 4)
	pm (list (/(+(car p2)(car p4))2) (/(+(cadr p2)(cadr p4))2))
	)
  (entmake (list  (cons 0 "insert")  (cons 2 bl) (cons 10 pm)))
  )

  • 0

#6 Danh Cong

Danh Cong

    biết lệnh Xplode

  • Moderator
  • PipPipPipPipPipPip
  • 481 Bài viết
Điểm đánh giá: 108 (tàm tạm)

Đã gửi 10 August 2017 - 03:32 PM

Anh #lp_Hai    xài món này thì cứ gặp Polyline có số đỉnh lớn hơn 5 thì nó chèn hết Block kìa, bất chấp hình thù méo mó tròn vuông luôn ....  :D  :D 


  • 0

              *** Vô lo - Vô nghĩ - Vô sầu hận ***
*** Chẳng thương - Chẳng giận - Chẳng đau lòng ***


#7 lp_hai

lp_hai

    biết lệnh Xplode

  • Members
  • PipPipPipPipPipPip
  • 481 Bài viết
Điểm đánh giá: 207 (khá)

Đã gửi 10 August 2017 - 03:46 PM

Anh #lp_Hai    xài món này thì cứ gặp Polyline có số đỉnh lớn hơn 5 thì nó chèn hết Block kìa, bất chấp hình thù méo mó tròn vuông luôn ....  :D  :D 

mình thì theo sát yêu cầu của chủ thớt là hình chữ nhật, chứ mà không phải chữ nhật phải xác định điểm giữa có phải là trọng tâm không??? :D xài hàng loạt chắc rectang thôi :D


  • 1

#8 đặng phụng

đặng phụng

    biết zoom

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

Đã gửi 10 August 2017 - 03:57 PM

không còn gì để tả. Cảm ơn các cao nhân lisp, đặt biệt anh IP_hai thank thank thank!!!


  • 1

#9 cuongtk2

cuongtk2

    biết lệnh mirror

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

Đã gửi 10 August 2017 - 05:07 PM

Mấy cái hàm vlax-curve chấp nhận cả entity lẫn object nhỉ.


  • 0

#10 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5556 Bài viết
Điểm đánh giá: 2675 (tuyệt vời)

Đã gửi 10 August 2017 - 10:37 PM

Mấy cái hàm vlax-curve chấp nhận cả entity lẫn object nhỉ.

đúng vậy


  • 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ờ. Và đừng làm điều ngược lại.

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