Đến nội dung


Hình ảnh

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


  • Please log in to reply
5 replies to this topic

#1 khaosatheco

khaosatheco

    biết vẽ circle

  • Members
  • PipPip
  • 30 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 28 March 2013 - 04:19 PM

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.c...ile_mau_2_1.dwg


  • 0

#2 KangKung

KangKung

    biết lệnh array

  • Members
  • PipPipPip
  • 189 Bài viết
Điểm đánh giá: 227 (khá)

Đã gửi 28 March 2013 - 07:19 PM

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

  • 2

#3 khaosatheco

khaosatheco

    biết vẽ circle

  • Members
  • PipPip
  • 30 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 29 March 2013 - 08:50 AM

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


  • 0

#4 thanhlong.hygt

thanhlong.hygt

    biết vẽ pline

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

Đã gửi 23 August 2013 - 12:12 AM

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 ạ


  • 0

#5 colombus

colombus

    biết vẽ ellipse

  • Members
  • PipPip
  • 58 Bài viết
Điểm đánh giá: 3 (bình thường)

Đã gửi 19 May 2016 - 08:07 AM

Đá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.


  • 0

#6 lohado

lohado

    biết lệnh erase

  • Members
  • PipPipPip
  • 101 Bài viết
Điểm đánh giá: 3 (bình thường)

Đã gửi 19 May 2016 - 09:01 AM

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.c.../146106_rot.lsp


  • 0

    146106_untitled444_2.png