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

Nhờ Viết Lisp Thay Đổi Chiều Dài Đường Mũi Tên

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

taipham    5

Nhờ các anh chị trong diễn đàn viết hộ em lisp tăng giảm chiều dài của đường mũi lên (Leader) đã có sẵn, cụ thể như sau:

Đánh lệnh: EDL -> chọn các đường mũi tên cần thay đổi chiều dài (theo phương của đường mũi tên) -> chọn thay đổi điểm đầu hay điểm cuối (điểm đầu là điểm có dấu mũi tên) -> nhập kích thước tăng (số dương) hoặc giảm (số âm), với tỉ lệ 1:1.

Rất mong sự giúp đỡ của anh chị, xin cảm ơn!

 

  • Vote giảm 1

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
quocmanh04tt    385

Không biết thế này có đúng ý chủ thớt không??? (Dịch mãi mới ra ý của đề)

 

(defun c:EDL  (/ ang ept ent lpt lst lsn obj poi sel spt lst-coor)
 (vl-load-com)
 (or *delta* (setq *delta* 0))
 (setq *delta* (cond ((getdist (strcat "\nNhap so gia <" (rtos *delta*) ">: ")))
                     (*delta*)))
 (while (setq sel (entsel))
  (if (eq (cdr (assoc 0 (entget (car sel)))) "LEADER")
   (progn (setq ent (car sel)
                poi (cadr sel)
                obj (vlax-ename->vla-object ent)
                lst (vl-remove-if-not '(lambda (x) (member (car x) '(10))) (entget ent))
                spt (cdr (car lst))
                ept (cdr (last lst))
                ang (angle spt ept)
                lsn (vl-remove (last (cdr lst)) (cdr lst)))
          (foreach x lsn (setq lpt (cons (cdr x) lpt)))
          (if (> (distance poi spt) (distance poi ept))
           (setq ang (angle (cdr (nth (- (length lst) 2) lst)) ept)
                 ept (polar ept ang *delta*))
           (setq ang (angle spt (cdr (nth 1 lst)))
                 spt (polar spt (+ ang pi) *delta*)))
          (if lsn
           (setq lst-coor (list spt (apply 'append (reverse lpt)) ept))
           (setq lst-coor (list spt ept)))
          (vlax-put obj 'Coordinates (apply 'append lst-coor)))
   (princ "\nDoi tuong da chon khong phai Leader...!"))
  (setq lpt nil))
 (princ))
  • Vote tăng 1

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
taipham    5

 

Không biết thế này có đúng ý chủ thớt không??? (Dịch mãi mới ra ý của đề)

(defun c:EDL  (/ ang ept ent lpt lst lsn obj poi sel spt lst-coor)
 (vl-load-com)
 (or *delta* (setq *delta* 0))
 (setq *delta* (cond ((getdist (strcat "\nNhap so gia <" (rtos *delta*) ">: ")))
                     (*delta*)))
 (while (setq sel (entsel))
  (if (eq (cdr (assoc 0 (entget (car sel)))) "LEADER")
   (progn (setq ent (car sel)
                poi (cadr sel)
                obj (vlax-ename->vla-object ent)
                lst (vl-remove-if-not '(lambda (x) (member (car x) '(10))) (entget ent))
                spt (cdr (car lst))
                ept (cdr (last lst))
                ang (angle spt ept)
                lsn (vl-remove (last (cdr lst)) (cdr lst)))
          (foreach x lsn (setq lpt (cons (cdr x) lpt)))
          (if (> (distance poi spt) (distance poi ept))
           (setq ang (angle (cdr (nth (- (length lst) 2) lst)) ept)
                 ept (polar ept ang *delta*))
           (setq ang (angle spt (cdr (nth 1 lst)))
                 spt (polar spt (+ ang pi) *delta*)))
          (if lsn
           (setq lst-coor (list spt (apply 'append (reverse lpt)) ept))
           (setq lst-coor (list spt ept)))
          (vlax-put obj 'Coordinates (apply 'append lst-coor)))
   (princ "\nDoi tuong da chon khong phai Leader...!"))
  (setq lpt nil))
 (princ))

Cảm ơn anh! hehe, anh sửa lại như thế này dùm e nha, đánh lệnh: EDL -> chọn các đường Leader -> hiện bảng chọn điểm đầu hoặc điểm cuối -> nhập kích thước muốn thay đổi. Anh xem file này nhé! mong anh hiểu ý và giúp đỡ

http://www.cadviet.com/upfiles/5/146422_edit_leader.dwg

  • Vote giảm 1

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
quocmanh04tt    385

Sửa lại theo Y/c đây:

 

(defun c:EDL  (/ ang ept ent lpt lst lsn obj poi sel spt lst-coor i ss)
 (vl-load-com)
 (if (setq ss (ssget '((0 . "LEADER"))))
  (progn (or poi (setq poi "E"))
         (initget "E S")
         (setq poi (getstring (strcat "\nDiem thay doi [End/Start] <" poi ">: ")))
         (if (eq poi "")
          (setq poi "E"))
         (or *delta* (setq *delta* 0))
         (setq *delta* (cond ((getdist (strcat "\nNhap so gia <" (rtos *delta*) ">: ")))
                             (*delta*)))
         (repeat (setq i (sslength ss))
          (setq ent (ssname ss (setq i (1- i)))
                obj (vlax-ename->vla-object ent)
                lst (vl-remove-if-not '(lambda (x) (member (car x) '(10))) (entget ent))
                spt (cdr (car lst))
                ept (cdr (last lst))
                lsn (vl-remove (last (cdr lst)) (cdr lst)))
          (foreach x lsn (setq lpt (cons (cdr x) lpt)))
          (if (eq poi "E")
           (setq ang (angle (cdr (nth (- (length lst) 2) lst)) ept)
                 ept (polar ept ang *delta*))
           (setq ang (angle spt (cdr (nth 1 lst)))
                 spt (polar spt (+ ang pi) *delta*)))
          (if lsn
           (setq lst-coor (list spt (apply 'append (reverse lpt)) ept))
           (setq lst-coor (list spt ept)))
          (vlax-put obj 'Coordinates (apply 'append lst-coor))
          (setq lpt nil))))
 (princ))
  • Vote tăng 1

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
taipham    5

 

Sửa lại theo Y/c đây:

(defun c:EDL  (/ ang ept ent lpt lst lsn obj poi sel spt lst-coor i ss)
 (vl-load-com)
 (if (setq ss (ssget '((0 . "LEADER"))))
  (progn (or poi (setq poi "E"))
         (initget "E S")
         (setq poi (getstring (strcat "\nDiem thay doi [End/Start] <" poi ">: ")))
         (if (eq poi "")
          (setq poi "E"))
         (or *delta* (setq *delta* 0))
         (setq *delta* (cond ((getdist (strcat "\nNhap so gia <" (rtos *delta*) ">: ")))
                             (*delta*)))
         (repeat (setq i (sslength ss))
          (setq ent (ssname ss (setq i (1- i)))
                obj (vlax-ename->vla-object ent)
                lst (vl-remove-if-not '(lambda (x) (member (car x) '(10))) (entget ent))
                spt (cdr (car lst))
                ept (cdr (last lst))
                lsn (vl-remove (last (cdr lst)) (cdr lst)))
          (foreach x lsn (setq lpt (cons (cdr x) lpt)))
          (if (eq poi "E")
           (setq ang (angle (cdr (nth (- (length lst) 2) lst)) ept)
                 ept (polar ept ang *delta*))
           (setq ang (angle spt (cdr (nth 1 lst)))
                 spt (polar spt (+ ang pi) *delta*)))
          (if lsn
           (setq lst-coor (list spt (apply 'append (reverse lpt)) ept))
           (setq lst-coor (list spt ept)))
          (vlax-put obj 'Coordinates (apply 'append lst-coor))
          (setq lpt nil))))
 (princ))

Cảm ơn anh nhiều nhé! Lisp chạy rất oke, chúc anh và diễn đàn luôn phát triển! :)

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


×