Đến nội dung


Hình ảnh
- - - - -

Lisp Nhân Chia Dim!


  • Please log in to reply
6 replies to this topic

#1 ginger

ginger

    biết lệnh move

  • Advance Member
  • PipPipPip
  • 121 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 04 November 2016 - 10:44 AM

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

  • -2

#2 Danh Cong

Danh Cong

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 252 Bài viết
Điểm đánh giá: 40 (tàm tạm)

Đã gửi 04 November 2016 - 11:18 AM

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


  • 0

             ***  Vô lo - Vô nghĩ - Vô sầu hận  ***

***  Chẳng thương - Chẳng giận - Chẳng đau lòng  ***


#3 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5681 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 04 November 2016 - 12:03 PM

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


  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#4 Bee

Bee

    biết lệnh extend

  • Members
  • PipPipPip
  • 195 Bài viết
Điểm đánh giá: 66 (tàm tạm)

Đã gửi 04 November 2016 - 12:43 PM

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

#5 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

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

Đã gửi 04 November 2016 - 03:56 PM

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

  • 1

#6 ginger

ginger

    biết lệnh move

  • Advance Member
  • PipPipPip
  • 121 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 04 November 2016 - 04:30 PM

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


  • 0

#7 ginger

ginger

    biết lệnh move

  • Advance Member
  • PipPipPip
  • 121 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 04 November 2016 - 04:34 PM

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é


  • 0