Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
khaosatheco

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

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

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

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
KangKung    229

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")
  • 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ặ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 ạ

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

Đăng nhập để thực hiện theo  

×