Lisp Nhân Chia Dim!

[ginger 11]

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

[Danh Cong 424]

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

[ketxu 3000]

Ăn nhiều dấu - quá rồi Vũ Khương ạ :)

[Bee 154]

Thay cộng bằng nhân. Thay trừ bằng chia là xong nhỉ ^_^

[quocmanh04tt 638]

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

[ginger 11]

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

[ginger 11]

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é