Chuyển đến nội dung
Diễn đàn CADViet
Học AutoCAD Online cùng CADViet
Đăng nhập để thực hiện theo  
ginger

Lisp Nhân Chia Dim!

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

P/s : mình đã sửa bài cho bạn, khi copy code lisp thì cho vào tag Code bạn nhé 

@Ketxu

 

 

em copy được lisp cộng trừ dim trên mạng nhờ các bác sửa giúp thành lisp nhân chia dim ạ ! hoặc cho em xin lisp nhân chia dim cũng được ! em cảm ơn 

 

(defun c:ccc(/ ss n i S duyet ent sst nt j St duyett entt Skq)
(prompt "\n Chon cac Dim cong:")
(setq ss (ssget '((0 . "DIMENSION"))))


(setq n (sslength ss) i 0 S 0 duyet 0)


(while (< i n)
(setq ent (entget(ssname ss i)))


(if (= (cdr(assoc 1 ent)) "")
(setq duyet (cdr(assoc 42 ent)))
(setq duyet (atof(cdr(assoc 1 ent))))
)
(setq S (+ S duyet))
(setq i (1+ i))
)




(alert (rtos S 2 0))


(princ)
)
(defun c:ttt(/ ss n i S duyet ent sst nt j St duyett entt Skq)
(prompt "\n Chon cac Dim lam so bi tru :")
(setq ss (ssget '((0 . "DIMENSION"))))


(prompt "\n Chon cac Dim lam so tru :")
(setq sst (ssget '((0 . "DIMENSION"))))


(setq n (sslength ss) i 0 S 0 duyet 0)
(setq nt (sslength sst) j 0 St 0 duyett 0)


(while (< i n)
(setq ent (entget(ssname ss i)))


(if (= (cdr(assoc 1 ent)) "")
(setq duyet (cdr(assoc 42 ent)))
(setq duyet (atof(cdr(assoc 1 ent))))
)
(setq S (+ S duyet))
(setq i (1+ i))
)


(while (< j nt)
(setq entt (entget(ssname sst j)))


(if (= (cdr(assoc 1 entt)) "")
(setq duyett (cdr(assoc 42 entt)))
(setq duyett (atof(cdr(assoc 1 entt))))
)
(setq St (+ St duyett))
(setq j (1+ j))
)


(setq Skq (- S St))


(alert (rtos Skq 2 0))


(princ)
)
  • Vote giảm 2

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

:D  :D  :D  Nhân chia Dimention kiểu gì nhỉ?

Bạn cứ đưa hình ảnh ví dụ ra là sẽ có ngay thôi. 

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

Có đọc bên Page, giúp bạn 1 cái (4 trong 1):

(defun c:tt (/ tongdim gandim fun tt1 tt2 ttf)

(defun tongdim (msg / ss ttd)

(setq ttd 0)

(princ msg)

(if (setq ss (ssget '((0 . "DIMENSION"))))

(foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))

(setq ttd (+ ttd

(cond ((distof (cdr (assoc 1 (entget x)))))

((cdr (assoc 42 (entget x))))))))

(setq ttd nil))

ttd)

(defun gandim (val / ent obj pre)

(and (setq ent (car (entsel (strcat "\nPick Dim de gan <" (vl-princ-to-string val) ">: "))))

(eq (cdr (assoc 0 (entget ent))) "DIMENSION")

(setq pre (vla-get-PrimaryUnitsPrecision (setq obj (vlax-ename->vla-object ent))))

(vla-put-TextOverride obj (rtos val 2 pre))))

;; *** Main ***

(if (setq tt1 (tongdim "\nChon nhom thu Nhat !"))

(if (setq tt2 (tongdim "\nChon nhom thu Hai !"))

(progn (if (equal tt2 1e-13)

(progn (not (initget "+ - *")) (setq fun (getkword "\nPhep tinh [+/-/*] ")))

(progn (not (initget "+ - * :")) (setq fun (getkword "\nPhep tinh [+/-/*/:] "))))

(and (cond ((eq fun "+") (setq ttf (+ tt1 tt2)))

((eq fun "-") (setq ttf (- tt1 tt2)))

((eq fun "*") (setq ttf (* tt1 tt2)))

((eq fun ":") (and (not (zerop tt2)) (setq ttf (/ tt1 tt2)))))

(princ (strcat "\nKet qua: " (vl-princ-to-string ttf)))

(gandim ttf)))

(and (princ (strcat "\nKet qua tong dim chon lan 1: " (vl-princ-to-string tt1)))

(gandim tt1))))

(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

hê hê . không biết mới hỏi chứ em biết viết lisp thì em đã tự viết , mấy bố cứ cho - em cũng chả hiểu như nào cả ? nhưng nếu trừ mà được việc thì cứ - thôi anh ketxu ạ !

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

Có đọc bên Page, giúp bạn 1 cái (4 trong 1):

(defun c:tt (/ tongdim gandim fun tt1 tt2 ttf)

(defun tongdim (msg / ss ttd)

(setq ttd 0)

(princ msg)

(if (setq ss (ssget '((0 . "DIMENSION"))))

(foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))

(setq ttd (+ ttd

(cond ((distof (cdr (assoc 1 (entget x)))))

((cdr (assoc 42 (entget x))))))))

(setq ttd nil))

ttd)

(defun gandim (val / ent obj pre)

(and (setq ent (car (entsel (strcat "\nPick Dim de gan <" (vl-princ-to-string val) ">: "))))

(eq (cdr (assoc 0 (entget ent))) "DIMENSION")

(setq pre (vla-get-PrimaryUnitsPrecision (setq obj (vlax-ename->vla-object ent))))

(vla-put-TextOverride obj (rtos val 2 pre))))

;; *** Main ***

(if (setq tt1 (tongdim "\nChon nhom thu Nhat !"))

(if (setq tt2 (tongdim "\nChon nhom thu Hai !"))

(progn (if (equal tt2 1e-13)

(progn (not (initget "+ - *")) (setq fun (getkword "\nPhep tinh [+/-/*] ")))

(progn (not (initget "+ - * :")) (setq fun (getkword "\nPhep tinh [+/-/*/:] "))))

(and (cond ((eq fun "+") (setq ttf (+ tt1 tt2)))

((eq fun "-") (setq ttf (- tt1 tt2)))

((eq fun "*") (setq ttf (* tt1 tt2)))

((eq fun ":") (and (not (zerop tt2)) (setq ttf (/ tt1 tt2)))))

(princ (strcat "\nKet qua: " (vl-princ-to-string ttf)))

(gandim ttf)))

(and (princ (strcat "\nKet qua tong dim chon lan 1: " (vl-princ-to-string tt1)))

(gandim tt1))))

(princ))

được rồi anh ạ ! em cảm ơn bác 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  

×