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  
taipham

Nhờ Sửa Lisp Copy Cộng Dồn Khoảng Cách

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

taipham    5

Để giảm bớt thao tác lập lại, em nhờ các anh chị sửa Lisp với nội dung là thêm phần lưu giá trị khoảng cách cho lần tiếp theo. Ví dụ: khi nhập khoảng cách copy là 100 cho lần thứ nhất, thì lần thứ 2 khi enter sẽ nhận giá trị là 100 hoặc nhập giá trị mới là 200, lần thứ 3 khi enter thì sẽ nhận giá trị là 200 hoặc nhập giá trị khác....Mong các anh chị hiểu ý và giúp đỡ.

(defun c:cco (/ oldos css ss p0 p1 p2 a e d)
(defun css (ss p0 p1 a)
((lambda (i / e obj o1 i) (while (setq e (ssname ss (setq i (1+ i))))
(setq obj (vlax-ename->vla-object e)) (setq o1 (vla-copy obj)) 
(if p0 (vla-move o1 (vlax-3d-point p0) (vlax-3d-point p1)))
(vla-move o1 (vlax-3d-point p1) (vlax-3d-point (polar p1 a d))) )) -1) )
(princ "\n Chon doi tuong can copy") (setq ss (ssget) 
p0 (getpoint "\n Chon diem chuan")
p1 (getpoint p0 "\n Chon diem goc") 
p2 (getpoint p1 "\n Chon diem dinh huong copy") 
a (angle p1 p2) e (entlast))
(while (setq d (getdist "\n Nhap khoang cach can copy tiep theo: "))
(css ss p0 p1 a) (setq ss (ssadd))
(while (setq e (entnext e)) (setq ss (ssadd e ss))) 
(setq p0 nil e (entlast)) )
(princ))
 

Xin cảm ơ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
quocmanh04tt    385

Thử xem có đúng ý bạn không nhé:

(defun c:cco  (/ oldos css ss p0 p1 p2 a e d)
 (defun css  (ss p0 p1 a)
  ((lambda (i / e obj o1 i)
    (while (setq e (ssname ss (setq i (1+ i))))
     (setq obj (vlax-ename->vla-object e))
     (setq o1 (vla-copy obj))
     (if p0
      (vla-move o1 (vlax-3d-point p0) (vlax-3d-point p1)))
     (vla-move o1 (vlax-3d-point p1) (vlax-3d-point (polar p1 a d))))) -1))
 (princ "\n Chon doi tuong can copy")
 (setq ss (ssget)
       p0 (getpoint "\n Chon diem chuan: ")
       p1 (getpoint p0 "\n Chon diem goc: ")
       p2 (getpoint p1 "\n Chon diem dinh huong copy: ")
       a  (angle p1 p2)
       e  (entlast))
 (or dis-copy-m (setq dis-copy-m 100))
 (while (not (eq (setq d (getdist (strcat "\n Nhap khoang cach can copy tiep theo [0->Exit] <" (rtos dis-copy-m)">: "))) 0))
  (if (not d)(setq d dis-copy-m)(setq dis-copy-m d))
  (css ss p0 p1 a)
  (setq ss (ssadd))
  (while (setq e (entnext e)) (setq ss (ssadd e ss)))
  (setq p0 nil
        e  (entlast)))
 (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

 

Thử xem có đúng ý bạn không nhé:

(defun c:cco  (/ oldos css ss p0 p1 p2 a e d)
 (defun css  (ss p0 p1 a)
  ((lambda (i / e obj o1 i)
    (while (setq e (ssname ss (setq i (1+ i))))
     (setq obj (vlax-ename->vla-object e))
     (setq o1 (vla-copy obj))
     (if p0
      (vla-move o1 (vlax-3d-point p0) (vlax-3d-point p1)))
     (vla-move o1 (vlax-3d-point p1) (vlax-3d-point (polar p1 a d))))) -1))
 (princ "\n Chon doi tuong can copy")
 (setq ss (ssget)
       p0 (getpoint "\n Chon diem chuan: ")
       p1 (getpoint p0 "\n Chon diem goc: ")
       p2 (getpoint p1 "\n Chon diem dinh huong copy: ")
       a  (angle p1 p2)
       e  (entlast))
 (or dis-copy-m (setq dis-copy-m 100))
 (while (not (eq (setq d (getdist (strcat "\n Nhap khoang cach can copy tiep theo [0->Exit] <" (rtos dis-copy-m)">: "))) 0))
  (if (not d)(setq d dis-copy-m)(setq dis-copy-m d))
  (css ss p0 p1 a)
  (setq ss (ssadd))
  (while (setq e (entnext e)) (setq ss (ssadd e ss)))
  (setq p0 nil
        e  (entlast)))
 (princ))

Hehe, rất oke, cảm ơn anh nhiều nhé! Tiện thể nhờ anh sửa giúp em Lisp tính toán cộng trừ nhân chia, là khi nhập lệnh TT enter sau đó hoặc ENTER để thực hiện phép tính cộng hoặc nhập các phép tính khác, cảm ơn anh!

(defun c:TT()

  (vl-load-com)

  (initget 1 "1 2 3 4")

  (setq ptinh (getkword "Chon phep tinh <1 2 3 4>: "))

  

  (cond ((= ptinh "1")  ;;; cong

	 (prompt "\nChon text de cong:")

	 (setq ss (ssget '((0 . "TEXT")))

	       kqua 0)

	 (while (and ss (> (sslength ss) 0))

	   (setq kqua (+ kqua (atof (cdr (assoc 1 (entget (setq ent (ssname ss 0))))))))

	   (ssdel ent ss))

	 (princ kqua))

	

	((= ptinh "3")  ;;;nhan

	 (prompt "\nChon text de nhan:")

	 (setq ss (ssget '((0 . "TEXT")))

	       kqua 1)

	 (while (and ss (> (sslength ss) 0))

	   (setq kqua (* kqua (atof (cdr (assoc 1 (entget (setq ent (ssname ss 0))))))))

	   (ssdel ent ss))

	 (princ kqua))



	((= ptinh "2")  ;;;tru

	 (setq sobitru (car (entsel "\nChon so bi tru:"))

	       sotru (car (entsel "\nChon so tru:\n"))

	       kqua (- (atof (cdr (assoc 1 (entget sobitru))))

		     (atof (cdr (assoc 1 (entget sotru))))))	  

	 (princ kqua))



	((= ptinh "4")  ;;;chia

	 (setq sobichia (car (entsel "\nChon so bi chia:"))

	       sochia (car (entsel "\nChon so chia:\n"))

	       kqua (/ (atof (cdr (assoc 1 (entget sobichia))))

		     (atof (cdr (assoc 1 (entget sochia))))))	  

	 (princ kqua))	

  )  

  (if (not ssle) (setq ssle 0))

  (setq obj (vlax-ename->vla-object (car (entsel "\nChon text de ghi ket qua:")))

		ssle1 (getint (strcat "\nSo so le <" (itoa ssle) ">: ")))

  (if ssle1 (setq ssle ssle1))

  (vla-put-TextString obj (rtos kqua 2 ssle))  

  (princ)	       

)

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

Gửi bạn: (bổ sung => hoặc chọn text để ghi kết quả hoặc chèn text mới)

(defun c:TT  (/ ent kqua obj sobichia sobitru sochia sotru ss ent-l poi)
 (vl-load-com)
 (initget "1 2 3 4")
 (or phep_tinh (setq phep_tinh "1"))
 (setq phep_tinh (cond ((getkword (strcat "\nChon phep tinh [1+/2-/3*/4:] <" phep_tinh ">: ")))
                       (phep_tinh)))
 (cond ;; cong
       ((= phep_tinh "1")
        (prompt "\nChon text de cong:")
        (setq ss   (ssget '((0 . "*TEXT")))
              kqua 0)
        (while (and ss (> (sslength ss) 0))
         (setq kqua (+ kqua (atof (cdr (assoc 1 (entget (setq ent (ssname ss 0))))))))
         (ssdel ent ss)))
       ;;nhan
       ((= phep_tinh "3")
        (prompt "\nChon text de nhan:")
        (setq ss   (ssget '((0 . "*TEXT")))
              kqua 1)
        (while (and ss (> (sslength ss) 0))
         (setq kqua (* kqua (atof (cdr (assoc 1 (entget (setq ent (ssname ss 0))))))))
         (ssdel ent ss)))
       ;;tru
       ((= phep_tinh "2")
        (and (princ "\nChon so bi tru:")
             (setq sobitru (ssget "_+.:E:S" '((0 . "*TEXT"))))
             (setq sobitru (distof (cdr (assoc 1 (entget (setq ent (ssname sobitru 0)))))))
             (princ "\nChon so tru:")
             (setq sotru (ssget "_+.:E:S" '((0 . "*TEXT"))))
             (setq sotru (distof (cdr (assoc 1 (entget (setq ent (ssname sotru 0)))))))
             (setq kqua (- sobitru sotru))))
       ;;chia
       ((= phep_tinh "4")
        (and (princ "\nChon so bi chia:")
             (setq sobichia (ssget "_+.:E:S" '((0 . "*TEXT"))))
             (setq sobichia (distof (cdr (assoc 1 (entget (setq ent (ssname sobichia 0)))))))
             (princ "\nChon so chia:")
             (setq sochia (ssget "_+.:E:S" '((0 . "*TEXT"))))
             (setq sochia (distof (cdr (assoc 1 (entget (setq ent (ssname sochia 0)))))))
             (not (eq sochia 0))
             (setq kqua (/ sobichia sochia)))))
 (if (and (or ss (and sobitru sotru) (and sobichia sochia)) kqua)
  (progn (or ssle (setq ssle 0))
         (setq ssle (cond ((getint (strcat "\nSo so le <" (itoa ssle) ">: ")))
                          (ssle)))
         (princ (strcat "\nChon text de ghi ket qua [Enter->Insert Text] <" (rtos kqua 2 ssle) ">: "))
         (if (setq ss (ssget "_+.:E:S" '((0 . "*TEXT"))))
          (progn (setq obj (vlax-ename->vla-object (ssname ss 0)))
                 (vla-put-TextString obj (rtos kqua 2 ssle)))
          (and (setq poi (getpoint "\nDiem chen Text: "))
               (setq ent-l (vl-remove-if-not '(lambda (x) (member (car x) '(0 1 7 8 40 41 42 50 51 62 100))) (entget ent))
                     ent-l (append (subst (cons 1 (rtos kqua 2 ssle)) (assoc 1 ent-l) ent-l) (list (cons 10 poi))))
               (entmakex ent-l)))))
 (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

 

Gửi bạn: (bổ sung => hoặc chọn text để ghi kết quả hoặc chèn text mới)

(defun c:TT  (/ ent kqua obj sobichia sobitru sochia sotru ss ent-l poi)
 (vl-load-com)
 (initget "1 2 3 4")
 (or phep_tinh (setq phep_tinh "1"))
 (setq phep_tinh (cond ((getkword (strcat "\nChon phep tinh [1+/2-/3*/4:] <" phep_tinh ">: ")))
                       (phep_tinh)))
 (cond ;; cong
       ((= phep_tinh "1")
        (prompt "\nChon text de cong:")
        (setq ss   (ssget '((0 . "*TEXT")))
              kqua 0)
        (while (and ss (> (sslength ss) 0))
         (setq kqua (+ kqua (atof (cdr (assoc 1 (entget (setq ent (ssname ss 0))))))))
         (ssdel ent ss)))
       ;;nhan
       ((= phep_tinh "3")
        (prompt "\nChon text de nhan:")
        (setq ss   (ssget '((0 . "*TEXT")))
              kqua 1)
        (while (and ss (> (sslength ss) 0))
         (setq kqua (* kqua (atof (cdr (assoc 1 (entget (setq ent (ssname ss 0))))))))
         (ssdel ent ss)))
       ;;tru
       ((= phep_tinh "2")
        (and (princ "\nChon so bi tru:")
             (setq sobitru (ssget "_+.:E:S" '((0 . "*TEXT"))))
             (setq sobitru (distof (cdr (assoc 1 (entget (setq ent (ssname sobitru 0)))))))
             (princ "\nChon so tru:")
             (setq sotru (ssget "_+.:E:S" '((0 . "*TEXT"))))
             (setq sotru (distof (cdr (assoc 1 (entget (setq ent (ssname sotru 0)))))))
             (setq kqua (- sobitru sotru))))
       ;;chia
       ((= phep_tinh "4")
        (and (princ "\nChon so bi chia:")
             (setq sobichia (ssget "_+.:E:S" '((0 . "*TEXT"))))
             (setq sobichia (distof (cdr (assoc 1 (entget (setq ent (ssname sobichia 0)))))))
             (princ "\nChon so chia:")
             (setq sochia (ssget "_+.:E:S" '((0 . "*TEXT"))))
             (setq sochia (distof (cdr (assoc 1 (entget (setq ent (ssname sochia 0)))))))
             (not (eq sochia 0))
             (setq kqua (/ sobichia sochia)))))
 (if (and (or ss (and sobitru sotru) (and sobichia sochia)) kqua)
  (progn (or ssle (setq ssle 0))
         (setq ssle (cond ((getint (strcat "\nSo so le <" (itoa ssle) ">: ")))
                          (ssle)))
         (princ (strcat "\nChon text de ghi ket qua [Enter->Insert Text] <" (rtos kqua 2 ssle) ">: "))
         (if (setq ss (ssget "_+.:E:S" '((0 . "*TEXT"))))
          (progn (setq obj (vlax-ename->vla-object (ssname ss 0)))
                 (vla-put-TextString obj (rtos kqua 2 ssle)))
          (and (setq poi (getpoint "\nDiem chen Text: "))
               (setq ent-l (vl-remove-if-not '(lambda (x) (member (car x) '(0 1 7 8 40 41 42 50 51 62 100))) (entget ent))
                     ent-l (append (subst (cons 1 (rtos kqua 2 ssle)) (assoc 1 ent-l) ent-l) (list (cons 10 poi))))
               (entmakex ent-l)))))
 (princ))

Hehe, quá Pro, cảm ơn anh nhiều nhé!

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  

×