Đến nội dung


Hình ảnh
- - - - -

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


  • 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 03 March 2016 - 08:52 AM

Để 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!


  • 0

#2 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

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

Đã gửi 03 March 2016 - 09:38 AM

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

  • 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 03 March 2016 - 12:44 PM

 

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)	       

)


  • 0

#4 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

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

Đã gửi 08 March 2016 - 10:13 AM

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

  • 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 08 March 2016 - 11:27 AM

 

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é!


  • 0