Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
4 replies to this topic

#1 taipham

taipham

    biết vẽ ellipse

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

Đã gửi 19 February 2016 - 01:10 PM

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!

 


  • -1

#2 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 673 Bài viết
Điểm đánh giá: 315 (khá)

Đã gửi 20 February 2016 - 12:44 AM

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

  • 1

#3 taipham

taipham

    biết vẽ ellipse

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

Đã gửi 20 February 2016 - 01:47 AM

 

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


  • -1

#4 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 673 Bài viết
Điểm đánh giá: 315 (khá)

Đã gửi 21 February 2016 - 03:35 PM

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

  • 1

#5 taipham

taipham

    biết vẽ ellipse

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

Đã gửi 22 February 2016 - 09:11 AM

 

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! :)


  • 0