[yêu cầu] lisp xoay block theo hướng pline cho trước

[khaosatheco 2]

Xin chào cả nhà.

Hôm nay mình có vấn đề về biên tập bản đồ tuyến đường muốn nhờ các anh trên diễn đàn giúp đỡ:

Khi in ấn bản đồ dạng tuyến cần phải cắt thành từng đoạn cho vừa khổ giấy. Trên mỗi đoạn thì tất cả các đối tượng đều phải xoay theo chiều khổ giấy.

Nhờ cả nhà viết lsp để xoay các block được chọn theo 1 đường pl cho trước như file đính kèm.

Xin chân thành cảm ơn và mong các bác giúp.

http://www.cadviet.com/upfiles/3/25684_file_mau_2_1.dwg

[KangKung 250]

Tặng bạn cái Lisp như yêu cầu

;========LISP XOAY BLOCK THEO HUONG TUYEN==========
;=============KANGKUNG 28/03/2013==================
(defun C:KK()
  (command "UNDO" "BE")
  (setq tuyen nil)
  (while (= (setq tuyen (car (entsel "\n Chon tuyen:\n"))) nil))
  (setq taphop(ssget '((0 . "INSERT"))))
  (setq index 0)
  (while (< index (sslength taphop))
    (setq block(entget (ssname taphop index)))
    (setq insertpoint(cdr (assoc 10 block)))
    (if (= (vlax-curve-getDistAtPoint tuyen (vlax-curve-getClosestPointTo tuyen insertpoint)) (vla-get-length (vlax-ename->vla-object tuyen)))
      (entmod (subst (cons 50 (+ pi (angle (vlax-curve-getClosestPointTo tuyen insertpoint) ( vlax-curve-getPointAtDist tuyen (+ (vlax-curve-getDistAtPoint tuyen (vlax-curve-getClosestPointTo tuyen insertpoint)) -0.001))))) (assoc 50 block) block))
      (entmod (subst (cons 50 (+ pi (angle ( vlax-curve-getPointAtDist tuyen (+ (vlax-curve-getDistAtPoint tuyen (vlax-curve-getClosestPointTo tuyen insertpoint)) 0.001)) (vlax-curve-getClosestPointTo tuyen insertpoint)))) (assoc 50 block) block))
      )
    (setq index (+ index 1)))
  (command "UNDO" "END")
  )
(princ "\n                Written By KangKung - 28/03/2013\n")
(princ "\n                  Nhap KK de chay chuong trinh\n")

[khaosatheco 2]

Tuyệt vời. Cảm ơn Kangkung!

[thanhlong.hygt 9]

 

Tặng bạn cái Lisp như yêu cầu

;========LISP XOAY BLOCK THEO HUONG TUYEN==========
;=============KANGKUNG 28/03/2013==================
(defun C:KK()
  (command "UNDO" "BE")
  (setq tuyen nil)
  (while (= (setq tuyen (car (entsel "\n Chon tuyen:\n"))) nil))
  (setq taphop(ssget '((0 . "INSERT"))))
  (setq index 0)
  (while (< index (sslength taphop))
    (setq block(entget (ssname taphop index)))
    (setq insertpoint(cdr (assoc 10 block)))
    (if (= (vlax-curve-getDistAtPoint tuyen (vlax-curve-getClosestPointTo tuyen insertpoint)) (vla-get-length (vlax-ename->vla-object tuyen)))
      (entmod (subst (cons 50 (+ pi (angle (vlax-curve-getClosestPointTo tuyen insertpoint) ( vlax-curve-getPointAtDist tuyen (+ (vlax-curve-getDistAtPoint tuyen (vlax-curve-getClosestPointTo tuyen insertpoint)) -0.001))))) (assoc 50 block) block))
      (entmod (subst (cons 50 (+ pi (angle ( vlax-curve-getPointAtDist tuyen (+ (vlax-curve-getDistAtPoint tuyen (vlax-curve-getClosestPointTo tuyen insertpoint)) 0.001)) (vlax-curve-getClosestPointTo tuyen insertpoint)))) (assoc 50 block) block))
      )
    (setq index (+ index 1)))
  (command "UNDO" "END")
  )
(princ "\n                Written By KangKung - 28/03/2013\n")
(princ "\n                  Nhap KK de chay chuong trinh\n")

Bác ơi e dùng lisp bác nhưng không quay được tối tượng att trong block. bác sửa giúp e với ạ

[colombus 3]

Đáng tiếc! lisp này không chấp nhận tuyến là đối tượng Mline. lisp này nên cho chọn tuyến là 2 điểm bất kỳ sẽ tốt hơn.

[lohado 4]

Tặng bạn cái lisp.xoay xong khi att chưa xoay thì attsyn sẽ oke nhé.xoay theo 1 điểm yêu cầu

http://www.cadviet.com/upfiles/6/146106_rot.lsp