bach1212
-
Số lượng nội dung
193 -
Đã tham gia
-
Lần ghé thăm cuối
Bài đăng được đăng bởi bach1212
-
-
Dùng lisp này xem
;; free lisp from cadviet.com ;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=12103&st=20 (defun c:dcs(/ tlv blm blname dmo cdm cd dm cdmi dmoc bl) (setvar "attreq" 1) (setvar "cmdecho" 0) (setq oldim (getvar "DimZin")) (setvar "Dimzin" 0) (setq tlv (/ 1 (getreal "\n Nhap ti le ve : 1/"))) (setq bl (car(entsel "\n Pick chon Block mau / Text mau :"))) (setq blm (entget bl)) (setq dmo (getpoint "\n Pick diem moc : ")) (setq cdm (getreal "\n Nhap cao do cua diem moc \ Enter pick text cao do : ")) (if (null cdm) (setq cdm (atof (cdr(assoc 1 (entget(car (entsel "pick text cao do : "))))))) ) (if cdm (progn (if (= cdm 0) (setq cd (strcat "%%p" (rtos cdm 2 2)))) (if (> cdm 0) (setq cd (strcat "+" (rtos cdm 2 2)))) (if (< cdm 0) (setq cd (rtos cdm 2 2))) (setq dmoc dmo) (while (setq dm (getpoint dmoc "\n Pick diem tiep theo :")) (if (> (cadr dm) (cadr dmo)) (setq cdmi (+ (* (- (cadr dm) (cadr dmo)) tlv) cdm) ) ) (if (<= (cadr dm) (cadr dmo)) (setq cdmi (- cdm (* (- (cadr dmo) (cadr dm)) tlv) ) ) ) (if (= cdmi 0) (setq cdi (strcat "%%p" (rtos cdmi 2 2)))) (if (> cdmi 0) (setq cdi (strcat "+" (rtos cdmi 2 2)))) (if (< cdmi 0) (setq cdi (rtos cdmi 2 2))) (command "copy" bl "" "_non" (cdr(assoc 10 blm)) "_non" dm) (if (and (wcmatch (cdr(assoc 0 (entget (entlast)))) "INSERT") (= (cdr(assoc 66 (entget (entlast)))) 1)) (setq el (entget (entnext (entlast)) ))) (if (wcmatch (cdr(assoc 0 (entget (entlast)))) "TEXT") (setq el (entget (entlast))) ) (entmod (subst (cons 1 cdi) (assoc 1 el) el)) (setq dmoc dm) ) (setvar "Dimzin" oldim) )) (princ) )
-
3
-
-
Bác nào có bản vẽ cống bản vượt nhịp 4.1m không cho e xin với? Thanks
-
Bạn đúng là k có cảm quan nghệ thuật lisp :) Bác ĐVH nói rõ dòng lấy osnap hiện thời rồi , sao không thử đặt chế độ mình ưng ý rồi thực hiện xem nó là số mấy ?
iem thử mấy số nhưng hok được số nào cho bắt all bác ah. hjj :D Dùng thì được chứ sáng tác e yếu lém ah.
-
(setvar "osmode" 1)
muốn dòng này chọn chế độ bắt điểm là all thì thay số 1 bằng bao nhiu ah?
-
: Ha Van Khanh 3/2003 ; ; * Chuong trinh duoc lap bang ngon ngu AUTOLISP. ; ------------------------------------------------------------------------------ (vmon) (defun C:bang (/ 1x 1y a1 2x 2y a2 3x 3y a3 b p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13 p14 p15 p16x p16y p16 p17x p17y p17) (setvar "cmdecho" 0) (initget 7) (setq osm (getvar "osmode" )) (setvar "osmode" 0) (command "-Style" "hoatbif" "hoatbif " "2.0" "" "" "" "" "") (command "-Layer" "n" "Text" "c" "4" "Text" "") (setq p1 (getpoint "\nChon diem dat bang thong ke :")) (setq S (getint "\nSo diem can tinh toa do :")) (setq p2 (polar p1 (/ (* Pi 3) 2) (+ 16 (* 8 S)))) (setq p3 (polar p2 0 91)) (setq p4 (polar p1 0 91)) (setq p5 (polar p1 0 21)) (setq p6 (polar p2 0 21)) (setq p7 (polar p5 0 35)) (setq p8 (polar p6 0 35)) (setq p9 (polar p5 (/ (* Pi 3) 2) 8)) (setq p10 (polar p4 (/ (* Pi 3) 2) 8)) (setq p12 (polar p9 0 35)) (setq p11 (polar p9 0 -10.5)) (setq p13 (polar p1 (/ (* Pi 3) 2) 16)) (setq p14 (polar p4 (/ (* Pi 3) 2) 16)) (setq p15 (polar p7 (/ (* pi 3 ) 2) 4)) (setq p16x (/ (+ (car p5) (car p7)) 2)) (setq p16y (/ (+ (cadr p9) (cadr p13)) 2)) (setq p17x (/ (+ (car p4) (car p7)) 2)) (setq p17y (/ (+ (cadr p9) (cadr p13)) 2)) (setq p16 (list p16x p16y)) (setq p17 (list p17x p17y)) (command "Plinewid" "0.5") (command "Pline" p1 p2 p3 p4 p1 "") (command "Line" p5 p6 "") (command "Line" p12 p8 "") (command "Line" p9 p10 "") (command "Line" p13 p14 "") (command "Array" "l" "" "Rec" S "1" "-8") (command "text" "j" "mc" p11 "0" "Tªn ga" ) (command "text" "j" "mc" p15 "0" "To¹ ®é" ) (command "text" "j" "mc" p16 "0" "X" ) (command "text" "j" "mc" p17 "0" "Y" ) (setvar "osmode" 1) ;------------------------------------------------- ; PhÇn sö lý ch÷ (setq b 0) (while (< b s ) (setq b (+ b 1)) (setq td (getstring "\Nhap ten diem lay toa do : ")) (if (or (= td "") (= td " ")) (setq td (cdr (assoc 1 (entget (car (entsel "\n Chon text san co tren ban ve")))))) ) (setq tp (getpoint "\n Chon diem : ")) (setq tx (rtos (car tp) 2 4 )) (setq ty (rtos (cadr tp) 2 4 )) (setq 1x (/ (+ (car p1) (car p5)) 2)) (setq 1y (- (- (cadr p11) 4) (* 8 B))) (setq a1 (list 1x 1y)) (setq 2x (/ (+ (car p5) (car p7)) 2)) (setq 2y (- (cadr p16) (* 8 B))) (setq a2 (list 2x 2y)) (setq 3x (/ (+(car p7) (car p4)) 2)) (setq 3y (- (cadr p17) (* 8 B))) (setq a3 (list 3x 3y)) (command "text" "j" "mc" a1 "0" td "" ) (command "text" "j" "mc" a3 "0" tx "" ) (command "text" "j" "mc" a2 "0" ty "" ) ) )
Lisp trên để lấy tọa độ của 1 điểm.
Cho e hỏi dòng lệnh nào quy định chế độ bắt điểm của lisp trên ah?
-
em làm 3 tuyến trên đường . đã chạy hết trắc dọc và ngang 3 tuyến . nhưng khi muốn quay lại sửa tuyến thứ 1 đánh lệnh CS thì lại ko thấy tên tuyến 1 đâu để chọn làm hiện thời . mặc dù bản vẽ của tuyến 1 vẫn còn . giúp em mới các cao thủ ơi đây là link bản vẽ của em http://www.4shared.com/photo/kEqlNeBT/Drawing3.html?Lỗi này chưa gặp bao giờ. Chia buồn nhé. Chắc bạn thao tác nhẩm rồi. Chạy lại thôi. Các đối tượng thuộc tuyến 1 không nhận nữa rồi vì trong CS đã xóa mất
-
Lisp đã wonderul. Đa tạ các cao nhân a hùng đã ra tay giúp đỡ. :P :D
Đây là bản chỉnh sửa lần cuối, bạn nào cần lisp này như mình thì mời xơi ở đây nhé :D
;; free lisp from cadviet.com ;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=12103&st=20 (defun c:dcd(/ blname dmo cdm cd dm cdmi dmoc) (setvar "attreq" 1) (setvar "cmdecho" 0) (setq oldim (getvar "DimZin")) (setvar "Dimzin" 0) (or tlv (setq tlv (/ 1 (getreal "\n Nhap ti le ve : 1/")))) (or bl (setq bl (car(entsel "\n Pick chon Block mau / Text mau :")))) (or blm (setq blm (entget bl))) (setq dmo (getpoint "\n Pick diem moc : ")) (setq cdm (getreal "\n Nhap cao do cua diem moc \ Enter pick text cao do : ")) (if (null cdm) (setq cdm (atof (cdr(assoc 1 (entget(car (entsel "pick text cao do : "))))))) ) (if cdm (progn (if (= cdm 0) (setq cd (strcat "%%p" (rtos cdm 2 2)))) (if (> cdm 0) (setq cd (strcat "+" (rtos cdm 2 2)))) (if (< cdm 0) (setq cd (rtos cdm 2 2))) (setq dmoc dmo) (while (setq dm (getpoint dmoc "\n Pick diem tiep theo :")) (if (> (cadr dm) (cadr dmo)) (setq cdmi (+ (* (- (cadr dm) (cadr dmo)) tlv) cdm) ) ) (if (<= (cadr dm) (cadr dmo)) (setq cdmi (- cdm (* (- (cadr dmo) (cadr dm)) tlv) ) ) ) (if (= cdmi 0) (setq cdi (strcat "%%p" (rtos cdmi 2 2)))) (if (> cdmi 0) (setq cdi (strcat "+" (rtos cdmi 2 2)))) (if (< cdmi 0) (setq cdi (rtos cdmi 2 2))) (command "copy" bl "" "_non" (cdr(assoc 10 blm)) "_non" dm) (if (and (wcmatch (cdr(assoc 0 (entget (entlast)))) "INSERT") (= (cdr(assoc 66 (entget (entlast)))) 1)) (setq el (entget (entnext (entlast)) ))) (if (wcmatch (cdr(assoc 0 (entget (entlast)))) "TEXT") (setq el (entget (entlast))) ) (entmod (subst (cons 1 cdi) (assoc 1 el) el)) (entupd (entlast)) (setq dmoc dm) ) (setvar "Dimzin" oldim) ))) (princ) )
-
Phần đỏ là bạn phải xóa đi
Phần xanh là thêm vào
Với code ở bài #24, đã sửa theo gợi ý của Ketxu. Nhưng chưa bớt được thao tác nhập ban đầu: chọn blog mẫu
;; free lisp from cadviet.com ;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=12103&st=20 (defun c:dcd(/ blname dmo cdm cd dm cdmi dmoc bl) (setvar "attreq" 1) (setvar "cmdecho" 0) (setq oldim (getvar "DimZin")) (setvar "Dimzin" 0) (or tlv (setq tlv (/ 1 (getreal "\n Nhap ti le ve : 1/")))) (or bl (setq bl (car(entsel "\n Pick chon Block mau / Text mau :")))) (or blm (setq blm (entget bl))) (setq dmo (getpoint "\n Pick diem moc : ")) (setq cdm (getreal "\n Nhap cao do cua diem moc \ Enter pick text cao do : ")) (if (null cdm) (setq cdm (atof (cdr(assoc 1 (entget(car (entsel "pick text cao do : "))))))) ) (if cdm (progn (if (= cdm 0) (setq cd (strcat "%%p" (rtos cdm 2 2)))) (if (> cdm 0) (setq cd (strcat "+" (rtos cdm 2 2)))) (if (< cdm 0) (setq cd (rtos cdm 2 2))) (setq dmoc dmo) (while (setq dm (getpoint dmoc "\n Pick diem tiep theo :")) (if (> (cadr dm) (cadr dmo)) (setq cdmi (+ (* (- (cadr dm) (cadr dmo)) tlv) cdm) ) ) (if (<= (cadr dm) (cadr dmo)) (setq cdmi (- cdm (* (- (cadr dmo) (cadr dm)) tlv) ) ) ) (if (= cdmi 0) (setq cdi (strcat "%%p" (rtos cdmi 2 2)))) (if (> cdmi 0) (setq cdi (strcat "+" (rtos cdmi 2 2)))) (if (< cdmi 0) (setq cdi (rtos cdmi 2 2))) (command "copy" bl "" "_non" (cdr(assoc 10 blm)) "_non" dm) (if (and (wcmatch (cdr(assoc 0 (entget (entlast)))) "INSERT") (= (cdr(assoc 66 (entget (entlast)))) 1)) (setq el (entget (entnext (entlast)) ))) (if (wcmatch (cdr(assoc 0 (entget (entlast)))) "TEXT") (setq el (entget (entlast))) ) (entmod (subst (cons 1 cdi) (assoc 1 el) el)) (entupd (entlast)) (setq dmoc dm) ) (setvar "Dimzin" oldim) ))) (princ) )
-
Mình chạy thì không cần RE mà Block vẫn đổi giá trị
Vậy bạn thêm dòng này :
(entupd (entlast))
xuống dưới dòng (entmod (subst (cons 1 cd) (assoc 1 el) el))
và xuống dưới dòng : (entmod (subst (cons 1 cdi) (assoc 1 el) el))
ở code lisp của bài viết số #24
Bạn thử xem
Các bác cho e hỏi: E muốn giữ lại tỉ lệ vẽ, và blog mẫu đã chọn để mỗi lần thực hiện lệnh lần tiếp theo không phải chọn lại tỉ lệ vẽ và blog mẫu thì xây dựng thêm code như thế nào ah?
Khi kết thúc lệnh lần đầu và thực hiện lệnh tiếp tục sẽ bắt đầu ngay ở bước: Pick điểm mốc
-
Lisp đầu trước khi sửa có bị tình trạng như vậy
Lisp sau khi sửa ở bài viết số #24 chạy ok, không bị vậy nữa
Tue_NV thử lisp chạy ở bài viết số #24 -> ok
Thanks bác. E vừa tìm ra nguyên nhân. Blog insert ra theo lisp #24 rất chuẩn.
Nhưng sau khi có kết quả phải re lại bản vẽ nó mới hiện lên cao độ của điểm mới. Lúc đầu e chọn blog mẫu xong, nhập cao độ mốc xong, thì vẫn thấy cao độ điểm mới bằng cao độ của blog mẫu. Hjj làm phiền bác Tuenv ngày chủ nhật vui vẻ roài. (Lúc đầu e lại ko có dùng re) :P :D
-
;; free lisp from cadviet.com ;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=12103&st=0 (defun c:dcs(/ tlv blm blname dmo cdm cd dm cdmi dmoc) (setvar "attreq" 1) (setvar "cmdecho" 0) (setq oldim (getvar "DimZin")) (setvar "Dimzin" 0) (setq tlv (/ 1 (getreal "\n Nhap ti le ve : 1/"))) (setq blm (entget(car(entsel "\n Pick chon Block mau :")))) (setq blname (cdr(assoc 2 blm))) (setq TLX (cdr(assoc 41 blm))) (setq TLY (cdr(assoc 42 blm))) (setq dmo (getpoint "\n Pick diem moc : ")) (setq cdm (getreal "\n Nhap cao do cua diem moc \ Enter pick text cao do : ")) (if (null cdm) (setq cdm (atof (cdr(assoc 1 (entget(car (entsel "pick text cao do : "))))))) ) (if cdm (progn)) (if (= cdm 0) (setq cd (strcat "%%p" (rtos cdm 2 2)))) (if (> cdm 0) (setq cd (strcat "+" (rtos cdm 2 2)))) (if (< cdm 0) (setq cd (rtos cdm 2 2))) ;(command "insert" blname dmo TLX TLY "0" cd) (setq dmoc dmo) (while (setq dm (getpoint dmoc "\n Pick diem tiep theo :")) (if (> (cadr dm) (cadr dmo)) (setq cdmi (+ (* (- (cadr dm) (cadr dmo)) tlv) cdm) ) ) (if (<= (cadr dm) (cadr dmo)) (setq cdmi (- cdm (* (- (cadr dmo) (cadr dm)) tlv) ) ) ) (if (= cdmi 0) (setq cdi (strcat "%%p" (rtos cdmi 2 2)))) (if (> cdmi 0) (setq cdi (strcat "+" (rtos cdmi 2 2)))) (if (< cdmi 0) (setq cdi (rtos cdmi 2 2))) (command "insert" blname dm TLX TLY "0" cdi) (setq dmoc dm) ) (setvar "Dimzin" oldim) (princ) )
Đoạn lisp trên e kết hợp 2 lần chỉnh sửa của bác Tuenv và đã cho ra kết quả đúng của dạng blog.
Tuy nhiên khi blog insert ra thì lại bị scan nhỏ đi rất nhiều so với blog mẫu.
Các bác cho e hỏi nguyên nhân tại sao lại như vậy?
-
Tue_NV chỉnh sửa lại Lisp(defun c:dcd(/ tlv blm blname dmo cdm cd dm cdmi dmoc bl) (setvar "attreq" 1) (setvar "cmdecho" 0) (setq oldim (getvar "DimZin")) (setvar "Dimzin" 0) (setq tlv (/ 1 (getreal "\n Nhap ti le ve : 1/"))) (setq bl (car(entsel "\n Pick chon Block mau / Text mau :"))) (setq blm (entget bl)) (setq dmo (getpoint "\n Pick diem moc : ")) (setq cdm (getreal "\n Nhap cao do cua diem moc \ Enter pick text cao do : ")) (if (null cdm) (setq cdm (atof (cdr(assoc 1 (entget(car (entsel "pick text cao do : "))))))) ) (if cdm (progn (if (= cdm 0) (setq cd (strcat "%%p" (rtos cdm 2 3)))) (if (> cdm 0) (setq cd (strcat "+" (rtos cdm 2 3)))) (if (< cdm 0) (setq cd (rtos cdm 2 3))) (command "copy" bl "" "_non" (cdr(assoc 10 blm)) "_non" dmo) (if (and (wcmatch (cdr(assoc 0 (entget (entlast)))) "INSERT") (= (cdr(assoc 66 (entget (entlast)))) 1)) (setq el (entget (entnext (entlast)) ))) (if (wcmatch (cdr(assoc 0 (entget (entlast)))) "TEXT") (setq el (entget (entlast))) ) (entmod (subst (cons 1 cd) (assoc 1 el) el)) (setq dmoc dmo) (while (setq dm (getpoint dmoc "\n Pick diem tiep theo :")) (if (> (cadr dm) (cadr dmo)) (setq cdmi (+ (* (- (cadr dm) (cadr dmo)) tlv) cdm) ) ) (if (<= (cadr dm) (cadr dmo)) (setq cdmi (- cdm (* (- (cadr dmo) (cadr dm)) tlv) ) ) ) (if (= cdmi 0) (setq cdi (strcat "%%p" (rtos cdmi 2 3)))) (if (> cdmi 0) (setq cdi (strcat "+" (rtos cdmi 2 3)))) (if (< cdmi 0) (setq cdi (rtos cdmi 2 3))) (command "copy" bl "" "_non" (cdr(assoc 10 blm)) "_non" dm) (if (and (wcmatch (cdr(assoc 0 (entget (entlast)))) "INSERT") (= (cdr(assoc 66 (entget (entlast)))) 1)) (setq el (entget (entnext (entlast)) ))) (if (wcmatch (cdr(assoc 0 (entget (entlast)))) "TEXT") (setq el (entget (entlast))) ) (entmod (subst (cons 1 cdi) (assoc 1 el) el)) (setq dmoc dm) ) (setvar "Dimzin" oldim) )) (princ) )
Có thể sử dụng với Text
E tìm mãi ko ra. Không biết dòng nào của bác Tuenv làm cho blog insert ra có giá trị đều giống blog mẫu mà không nhận cao độ. Hic... Còn phần mở rộng thêm cho text thì oki rùi.
-
lisp dc của ketxu mình cũng sưu tầm nó lâu rùi. Lisp đó rất chuẩn. Nhưng công việc mình đang cần theo dạng của bác Tuenv như trên, lựa chọn vị trí điểm mốc, chọn cao độ mốc là text trên bản vẽ (hoặc nhập tay vào) ==> chọn vị trí điểm mới và chèn blog cao độ vào đó. (mà không cần chèn blog cao độ vào điểm mốc)
-
hjhj đúng là con đẻ của bác Duy. Lần trước cũng là bác Duy tốt bụng viết nó cho mình. Bác Duy ơi..............help me!
-
Cám ơn anh giabach.
Em đang viết và cố gắng hoàn thành xong code này để giúp cho bạn auduongphuc.
Có gì trở ngại mong anh gia bách và mọi người hỗ trợ thêm.
Chào anh. Chúc anh thật nhiều sức khoẻ.
-----------
Tue_NV đã hoàn thành xong code này
Bạn auduongphuc chạy thử xem :
Chỉ Có 2 yêu cầu nhỏ khi chạy code :
1. Lisp chấp nhận bất cứ Block cao độ nào miễn là Block đó có 1 Atrtibute và Block đó phải có trên CAD để mà ta Pick chon Block mau
2. Điểm chèn Block đó nên nằm ngay cos cao độ chèn
Mong bạn auduongphuc hiểu
(defun c:dcd(/ tlv blm blname dmo cdm cd dm cdmi dmoc)(setvar "attreq" 1)(setvar "cmdecho" 0)(setq oldim (getvar "DimZin"))(setvar "Dimzin" 0)(setq tlv (/ 1 (getreal "\n Nhap ti le ve : 1/")))(setq blm (entget(car(entsel "\n Pick chon Block mau :"))))(setq blname (cdr(assoc 2 blm)))(setq TLX (cdr(assoc 41 blm)))(setq TLY (cdr(assoc 42 blm)))(setq dmo (getpoint "\n Pick diem moc : "))(setq cdm (getreal "\n Nhap cao do cua diem moc :"))(if (= cdm 0) (setq cd (strcat "%%p" (rtos cdm 2 3))))(if (> cdm 0) (setq cd (strcat "+" (rtos cdm 2 3))))(if (< cdm 0) (setq cd (rtos cdm 2 3)))(command "insert" blname dmo TLX TLY "0" cd)(setq dmoc dmo)(while (setq dm (getpoint dmoc "\n Pick diem tiep theo :"))(setq cdmi (* (- (cadr dm) cdm (cadr dmo)) tlv))(if (= cdmi 0) (setq cdi (strcat "%%p" (rtos cdmi 2 3))))(if (> cdmi 0) (setq cdi (strcat "+" (rtos cdmi 2 3))))(if (< cdmi 0) (setq cdi (rtos cdmi 2 3)))(command "insert" blname dm TLX TLY "0" cdi)(setq dmoc dm))(setvar "Dimzin" oldim)(princ))
Lisp này của bác rất tuyệt. Mong bác chỉnh sửa thêm cho lisp hoàn thiện:
- Lỗi gặp phải là cao độ điểm mốc khác 0 thì lisp tính phần cao độ tại các điểm thấp hơn chưa đúng. (Thay vì trừ đi khoảng cách giữa 2 điểm thì nó lại lấy cao độ mốc cộng thêm vào và điền dấu trừ phía trước, mặc dù cao độ mốc là 5.00 và khoảng cách giảm xuống là 2.00: Kết quả đúng phải là +3.00 nhưng lisp tính là: -7.00)
- Khi lựa chọn cao độ mốc, thêm chức năng chọn text trực tiếp trên bản vẽ (Hiện tại chỉ có 1 lựa chọn nhập số bằng tay)
Thanks
-
E đang dùng lisp này để trừ 1 text có sẵn cho 1 số được nhập vào bằng tay. Kết quả được ed vào 1 text có trước.
Mong các bác chỉnh sửa thêm chức năng cho lisp ở thao tác: chọn số trừ
- Có thể chọn số trừ là khoảng cách d giữa 2 điểm A-B trên cad bằng cách pick vào lần lượt 2 điểm đó. Lisp sẽ tự động xác định khoảng cách d và chọn d làm số trừ.
Kết hợp cả 2 hình thức lựa chọn số bị trừ là d và nhập số bằng tay sẽ hoàn thiện lisp hơn và làm được nhiều việc hơn.
Mong được các bác giúp đỡ. Thanks
;; free lisp from cadviet.com ;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=4077&pid=192557&st=0entry192557 (defun c:ths (/ Ename Elist Msg Oldtext Oldlist Newtext Newlist) (command "undo" "be") (setq donvi (/ (getvar "viewsize") 40)) (setq ddd (entsel "\nChon text bi tru")) (while (or (null ddd) (/= "TEXT" (cdr (assoc 0 (entget (car ddd))))) ) (princ "\nDoi tuong khong phai la text! Chon lai") (setq ddd (entsel "\nChon text bi tru")) ) (setq DTDTT (car ddd)) (setq DTTT (entget DTDTT)) (setq NDTTT (cdr (assoc 1 DTTT))) (setq NDTTT (atof NDTTT)) (setq DIEMVIETTEXT (cdr (assoc 10 DTTT))) (setq diemvt1 (polar DIEMVIETTEXT pi donvi)) (setq diemvt2 (polar DIEMVIETTEXT (* 2 pi) donvi)) (setq diemvt3 (polar DIEMVIETTEXT (/ pi 2) donvi)) (setq diemvt4 (polar DIEMVIETTEXT (- 0 (/ pi 2)) donvi)) (grdraw diemvt1 diemvt2 3) (grdraw diemvt3 diemvt4 3) (if (= droffln nil) (setq droffln1 2.00) (setq droffln1 droffln) ) (setq droffln (GETREAL (strcat "\nNhap hang so tru: <" (rtos droffln1 2 2) ">")) ) (if (= droffln nil) (setq droffln droffln1) ) (setq ketquaxuat (- NDTTT droffln)) (setq ketquaxuat (rtos ketquaxuat 2 2)) (setq dddsn (entsel "\nChon text xuat ket qua")) (while (or (null dddsn) (/= "TEXT" (cdr (assoc 0 (entget (car dddsn))))) ) (princ "\nDoi tuong khong phai la text! Chon lai") (setq dddsn (entsel "\nChon text tru")) ) (setq DTDTTsn (car dddsn)) (setq DTMs (entget DTDTTsn)) (setq DTMs (subst (cons 1 ketquaxuat) (assoc 1 DTMs) DTMs)) (entmod DTMs) (command "undo" "end") (Princ))
-
các bác ơi, e cài nova 4.01 trên chạy trên nền acad 2002 nhưng e cài trên win 7 32 bit ko được, có bác nào biết cách cài ko ạ chỉ giúp e cài với, e cảm ơn các bác nhiều nhiều
Sao bạn ko dùng bản cài trên cad2005 đi? Sẽ oki ngay
-
- Bao gồm các phép tính đơn giản mà mình hay dùng :
Plus - cộng các số, Subtract - trừ 1 số với nhiều số, Multiply - nhân các số, Divide - chia một số với nhiều số, Average - tính trung bình, Max-min - số lớn nhất, nhỏ nhất trong các tập hợp chọn, Add by - cộng các số với một số cho trước, Multiply by - nhân các số với một số cho trước, Precision - độ chính xác của kết quả.
- Tùy chọn xuất kết quả: ghi đè lên 1 Text, tạo Text mới hoặc chỉ xem.
- Xuất biểu thức để kiểm tra, hỗ trợ vòng lặp cho 1 phép tính.
;;----------------------------------------------;; ;; Text calculation tool - Skywings ;; ;;----------------------------------------------;; ;;***SUB-FUNCTION*** (defun GET-TEXT () (princ "\nSelect NUMBERs : ") (while (null (setq Numbers (ssget '((0 . "*TEXT"))))) (princ "\n**NOTHING selected!**") ) ) (defun GET-DATA (/ ss-mt ss-t n) (setq ss-mt (ssadd) ss-t (ssadd) n 0 sw 0 ) (repeat (sslength Numbers) (setq ent (ssname Numbers n)) (if (= (cdr (assoc 0 (entget ent))) "MTEXT") (setq ss-mt (ssadd ent ss-mt)) (setq ss-t (ssadd ent ss-t)) ) (setq n (1+ n)) ) (if (/= (sslength ss-mt) 0) (setq Numbers (acet-explode ss-mt) sw 1 ) ) (setq n 0) (repeat (sslength ss-t) (setq ent (ssname ss-t n) Numbers (ssadd ent Numbers) n (1+ n) ) ) ) (defun GET-VALUE (name / sw) (princ (strcat "\nSelect " name " : ")) (cond ((= (cdr (assoc 0 (entget ename))) "MTEXT") (command ".explode" ename "") (setq value (read (cdr (assoc 1 (entget (entlast))))) sw 1 ) ) ((setq value (read (cdr (assoc 1 (entget ent)))))) ) (if (= sw 1) (command ".undo" 1) ) value ) (defun OPT () (if (null option) (setq option "Replace" save2 option ) ) (initget "Replace Create Do-nothing") (setq option (getkword (strcat "\nOptions: [Replace/Create/Do-nothing] <" option "> " ) ) ) (if (null option) (setq option save2) (setq save2 option) ) (setq switch 1) ) (defun ACTION (option result / txt pnt) (cond ((= option "Replace") (while (null (setq txt (entsel "\nChoose TEXT to replace: "))) (princ "\n**NOTHING selected!**") ) (setq txt (entget (car txt)) txt (subst (cons 1 result) (assoc 1 txt) txt) ) (entmod txt) ) ((= option "Create") (setq pnt (getpoint "\nSpecify start point of text:")) (entmake (list (assoc 0 ent) (assoc 8 ent) (cons 1 result) (cons 10 (trans pnt 1 0)) (assoc 40 ent) (assoc 7 ent) (assoc 50 ent) ) ) ) ) ) (defun GET-ORDER () (princ (strcat "\nCurrent setting: Precision = " (rtos precision 2 0) " <" (rtos 0 2 precision) ">" ) ) (initget "Plus Subtract Multiply Divide Average maX-min ADd-by mUltiply-by preCision" ) (setq operation (getkword (strcat "\nOperations: [Plus/Subtract/Multiply/Divide/Average/maX-min/ADd-by/mUltiply-by/preCision]: <" operation "> " ) ) ) (if (null operation) (setq operation save1) (setq save1 operation) ) ) ;;***MAIN FUNCTION***: (defun c:TCAL (/ Numbers DIVIDEND DIVISOR ENT ID INDEX MINUEND NUM-MAX NUM-MIN NUM-SET RESULT SUBTRAHEND SWITCH VALUE sw ) (princ "** Text calculation tool - Skywings **" ) (setvar "CMDECHO" 0) (setvar "QAFLAGS" 1) (if (null precision) (setq precision 2 save3 precision ) ) (if (null operation) (setq operation "Plus" save1 operation ) ) (GET-ORDER) (while (= operation "preCision") (initget 4) (setq precision (getint (strcat "\nSpecify new precision: <" (rtos precision 2 0) "> " ) ) ) (if (null precision) (setq precision save3) (setq save3 precision) ) (GET-ORDER) ) (cond ;; PLUS: ((= operation "Plus") (GET-TEXT) (setq switch 0) (while (/= Numbers nil) (GET-DATA) (setq index 0 result 0 ) (princ "\n>>Expression: ") (repeat (sslength Numbers) (setq ent (entget (ssname Numbers index)) value (read (cdr (assoc 1 ent))) index (1+ index) ) (if (numberp value) (progn (setq result (+ result value)) (if (/= index 1) (princ " + ") ) (princ (rtos value 2 precision)) ) ) ) (if (= sw 1) (command ".undo" 1)) (princ (strcat "\n>>RESULT = " (rtos result 2 precision))) (if (= switch 0) (OPT) ) (ACTION option (rtos result 2 precision)) (setq Numbers nil Numbers (ssget '((0 . "*TEXT"))) ) ) ) ;; MULTIPLY: ((= operation "Multiply") (GET-TEXT) (setq switch 0) (while (/= Numbers nil) (GET-DATA) (setq index 0 result 1 ) (princ "\n>>Expression: ") (repeat (sslength Numbers) (setq ent (entget (ssname Numbers index)) value (read (cdr (assoc 1 ent))) index (1+ index) ) (if (numberp value) (progn (setq result (* result value)) (if (/= index 1) (princ " * ") ) (princ (rtos value 2 precision)) ) ) ) (if (= sw 1) (command ".undo" 1) ) (princ (strcat "\n>>RESULT = " (rtos result 2 precision))) (if (= switch 0) (OPT) ) (ACTION option (rtos result 2 precision)) (setq Numbers nil Numbers (ssget '((0 . "*TEXT"))) ) ) ) ;; SUBTRACT: ((= operation "Subtract") (setq switch 0 sw 0 ) (while (null (setq ename (car (entsel (strcat "\nSelect MINUEND : ")))))) (setq minuend (GET-VALUE "MINUEND")) (while (null (numberp minuend)) (while (null (setq ename (car (entsel (strcat "\nSelect MINUEND : ")))))) (setq minuend (GET-VALUE "MINUEND")) ) (princ minuend) (redraw ename 3) (princ "\nSelect SUBTRAHENDs : ") (while (null (setq Numbers (ssget '((0 . "*TEXT"))))) (princ "\nSelect SUBTRAHENDs : ") ) (redraw ename 4) (while (/= ename nil) (GET-DATA) (setq index 0 result 0 minuend (float minuend) ) (princ (strcat "\n>>Expression: " (rtos minuend 2 precision) " - (" ) ) (repeat (sslength Numbers) (setq ent (entget (ssname Numbers index)) subtrahend (read (cdr (assoc 1 ent))) index (1+ index) ) (if (numberp subtrahend) (progn (setq result (+ result subtrahend)) (if (/= index 1) (princ " + ") ) (princ (rtos subtrahend 2 precision)) ) ) ) (princ ")") (if (= sw 1) (command ".undo" 1) ) (setq result (- minuend result)) (princ (strcat "\n>>RESULT = " (rtos result 2 precision))) (if (= switch 0) (OPT) ) (ACTION option (rtos result 2 precision)) (setq ename nil ename (car (entsel (strcat "\nSelect MINUEND : "))) ) (if (or (null ename) (null (numberp (setq minuend (GET-VALUE "MINUEND")))) ) (progn (setvar "QAFLAGS" 0) (vl-exit-with-error "") ) ) (princ minuend) (princ "\nSelect SUBTRAHENDs <TEXT>: ") (while (null (setq Numbers (ssget '((0 . "*TEXT"))))) (princ "\nSelect SUBTRAHENDs : ") ) ) ) ;; DIVIDE: ((= operation "Divide") (setq switch 0 sw 0 ) (while (null (setq ename (car (entsel (strcat "\nSelect DIVIDEND : ")))))) (setq dividend (GET-VALUE "DIVIDEND")) (while (null (numberp dividend)) (while (null (setq ename (car (entsel (strcat "\nSelect DIVIDEND : ")))))) (setq dividend (GET-VALUE "DIVIDEND")) ) (princ dividend) (redraw ename 3) (princ "\nSelect DIVISORs : ") (while (null (setq Numbers (ssget '((0 . "*TEXT"))))) (princ "\nSelect DIVISORs : ") ) (redraw ename 4) (while (/= ename nil) (GET-DATA) (setq index 0 result 1 dividend (float dividend) ) (princ (strcat "\n>>Expression: " (rtos dividend 2 precision) " / (" ) ) (repeat (sslength Numbers) (setq ent (entget (ssname Numbers index)) divisor (read (cdr (assoc 1 ent))) index (1+ index) ) (if (numberp divisor) (progn (setq result (* result divisor)) (if (/= index 1) (princ " * ") ) (princ (rtos divisor 2 precision)) ) ) ) (princ ")") (if (= sw 1) (command ".undo" 1) ) (setq result (/ dividend result)) (princ (strcat "\n>>RESULT = " (rtos result 2 precision))) (if (= switch 0) (OPT) ) (ACTION option (rtos result 2 precision)) (setq ename nil ename (car (entsel (strcat "\nSelect DIVIDEND : "))) ) (if (or (null ename) (null (numberp (setq dividend (GET-VALUE "DIVIDEND")))) ) (progn (setvar "QAFLAGS" 0) (vl-exit-with-error "") ) ) (princ dividend) (princ "\nSelect DIVISORs : ") (while (null (setq Numbers (ssget '((0 . "*TEXT"))))) (princ "\nSelect DIVISORs : ") ) ) ) ;; AVERAGE: ((= operation "Average") (GET-TEXT) (setq switch 0) (while (/= Numbers nil) (GET-DATA) (setq index 0 id 0 result 0 ) (princ "\n>>Expression: (") (repeat (sslength Numbers) (setq ent (entget (ssname Numbers index)) value (read (cdr (assoc 1 ent))) index (1+ index) ) (if (numberp value) (progn (setq result (+ result value) id (1+ id) ) (if (/= index 1) (princ " + ") ) (princ (rtos value 2 precision)) ) ) ) (if (= sw 1) (command ".undo" 1)) (setq result (rtos (/ (float result) id) 2 precision)) (princ (strcat ") / " (rtos id 2 0))) (princ (strcat "\n>>RESULT = " result)) (if (= switch 0) (OPT) ) (ACTION option result) (setq Numbers nil Numbers (ssget '((0 . "*TEXT"))) ) ) ) ;; MAX-MIN: ((= operation "maX-min") (GET-TEXT) (setq switch 0) (while (/= Numbers nil) (GET-DATA) (setq index 0 Num-set nil ) (repeat (sslength Numbers) (setq ent (entget (ssname Numbers index)) value (read (cdr (assoc 1 ent))) index (1+ index) ) (if (numberp value) (setq Num-set (cons value Num-set)) ) ) (setq Num-set (vl-sort Num-set '>) num-max (car Num-set) num-min (last Num-set) result (strcat "MAX = " (rtos num-max 2 precision) " MIN = " (rtos num-min 2 precision) ) ) (if (= sw 1) (command ".undo" 1)) (princ "\n>>Numbers set: ") (princ Num-set) (print) (princ result) (if (= switch 0) (OPT) ) (ACTION option result) (setq Numbers nil Numbers (ssget '((0 . "*TEXT"))) ) ) ) ;; ADD-BY...: ((= operation "ADd-by") (if (null number0) (setq number0 0.00 save4 number0 ) ) (setq number0 (getreal (strcat "Add by: <" (rtos number0 2 2) "> ")) index 0 ) (if (null number0) (setq number0 save4) (setq save4 number0) ) (GET-TEXT) (GET-DATA) (repeat (sslength Numbers) (setq ent (entget (ssname Numbers index)) value (read (cdr (assoc 1 ent))) index (1+ index) ) (if (numberp value) (setq value (+ (float value) number0) ent (subst (cons 1 (rtos value 2 precision)) (assoc 1 ent) ent ) ) ) (entmod ent) ) ) ;;MULTIPLY-BY...: ((= operation "mUltiply-by") (if (null number0) (setq number0 0.00 save4 number0 ) ) (setq number0 (getreal (strcat "Multiply by: <" (rtos number0 2 2) "> ")) index 0 ) (if (null number0) (setq number0 save4) (setq save4 number0) ) (GET-TEXT) (GET-DATA) (repeat (sslength Numbers) (setq ent (entget (ssname Numbers index)) value (read (cdr (assoc 1 ent))) index (1+ index) ) (if (numberp value) (setq value (* (float value) number0) ent (subst (cons 1 (rtos value 2 precision)) (assoc 1 ent) ent ) ) ) (entmod ent) ) ) ) (princ "<Exit>") (setvar "QAFLAGS" 0) (princ) )E không hiểu tự nhiên bây giờ mang ra dùng lisp này, đối tượng là text, khi dùng TCAL để trừ và chia thì đều báo lỗi:
Command: TCAL
** Text calculation tool - Skywings **
Current setting: Precision = 2 <0.00>
Operations:
[Plus/Subtract/Multiply/Divide/Average/maX-min/ADd-by/mUltiply-by/preCision]:
<Subtract> S
Select MINUEND :
Select MINUEND : ; error: bad argument type: lentityp nil
Select DIVIDEND :
Select DIVIDEND : ; error: bad argument type: lentityp nil
-
Hic, cài lại cad được mấy hôm, hôm nay lại bị lỗi lệnh Ctrl+Shift+C, với Ctrl+C như trước rồi. :ph34r:
-
Giúp tìm font
trong Sử dụng AutoCAD
Search trên google: Fontcad full là có cả 1 núi font ngay thui bạn ah
-
Thêm 1 chú nữa:
;; free lisp from cadviet.com ;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=37567 ;;----------------------------------------------;; ;; Text calculation tool - Skywings ;; ;;----------------------------------------------;; ;;***SUB-FUNCTION*** (defun GET-TEXT () (princ "\nSelect NUMBERs : ") (while (null (setq Numbers (ssget '((0 . "*TEXT"))))) (princ "\n**NOTHING selected!**") ) ) (defun GET-DATA (/ ss-mt ss-t n) (setq ss-mt (ssadd) ss-t (ssadd) n 0 sw 0 ) (repeat (sslength Numbers) (setq ent (ssname Numbers n)) (if (= (cdr (assoc 0 (entget ent))) "MTEXT") (setq ss-mt (ssadd ent ss-mt)) (setq ss-t (ssadd ent ss-t)) ) (setq n (1+ n)) ) (if (/= (sslength ss-mt) 0) (setq Numbers (acet-explode ss-mt) sw 1 ) ) (setq n 0) (repeat (sslength ss-t) (setq ent (ssname ss-t n) Numbers (ssadd ent Numbers) n (1+ n) ) ) ) (defun GET-VALUE (name / sw) (princ (strcat "\nSelect " name " : ")) (cond ((= (cdr (assoc 0 (entget ename))) "MTEXT") (command ".explode" ename "") (setq value (read (cdr (assoc 1 (entget (entlast))))) sw 1 ) ) ((setq value (read (cdr (assoc 1 (entget ent)))))) ) (if (= sw 1) (command ".undo" 1) ) value ) (defun OPT () (if (null option) (setq option "Replace" save2 option ) ) (initget "Replace Create Do-nothing") (setq option (getkword (strcat "\nOptions: [Replace/Create/Do-nothing] <" option "> " ) ) ) (if (null option) (setq option save2) (setq save2 option) ) (setq switch 1) ) (defun ACTION (option result / txt pnt) (cond ((= option "Replace") (while (null (setq txt (entsel "\nChoose TEXT to replace: "))) (princ "\n**NOTHING selected!**") ) (setq txt (entget (car txt)) txt (subst (cons 1 result) (assoc 1 txt) txt) ) (entmod txt) ) ((= option "Create") (setq pnt (getpoint "\nSpecify start point of text:")) (entmake (list (assoc 0 ent) (assoc 8 ent) (cons 1 result) (cons 10 (trans pnt 1 0)) (assoc 40 ent) (assoc 7 ent) (assoc 50 ent) ) ) ) ) ) (defun GET-ORDER () (princ (strcat "\nCurrent setting: Precision = " (rtos precision 2 0) " <" (rtos 0 2 precision) ">" ) ) (initget "Plus Subtract Multiply Divide Average maX-min ADd-by mUltiply-by preCision" ) (setq operation (getkword (strcat "\nOperations: [Plus/Subtract/Multiply/Divide/Average/maX-min/ADd-by/mUltiply-by/preCision]: <" operation "> " ) ) ) (if (null operation) (setq operation save1) (setq save1 operation) ) ) ;;***MAIN FUNCTION***: (defun c:TCAL (/ Numbers DIVIDEND DIVISOR ENT ID INDEX MINUEND NUM-MAX NUM-MIN NUM-SET RESULT SUBTRAHEND SWITCH VALUE sw ) (princ "** Text calculation tool - Skywings **" ) (setvar "CMDECHO" 0) (setvar "QAFLAGS" 1) (if (null precision) (setq precision 2 save3 precision ) ) (if (null operation) (setq operation "Plus" save1 operation ) ) (GET-ORDER) (while (= operation "preCision") (initget 4) (setq precision (getint (strcat "\nSpecify new precision: <" (rtos precision 2 0) "> " ) ) ) (if (null precision) (setq precision save3) (setq save3 precision) ) (GET-ORDER) ) (cond ;; PLUS: ((= operation "Plus") (GET-TEXT) (setq switch 0) (while (/= Numbers nil) (GET-DATA) (setq index 0 result 0 ) (princ "\n>>Expression: ") (repeat (sslength Numbers) (setq ent (entget (ssname Numbers index)) value (read (cdr (assoc 1 ent))) index (1+ index) ) (if (numberp value) (progn (setq result (+ result value)) (if (/= index 1) (princ " + ") ) (princ (rtos value 2 precision)) ) ) ) (if (= sw 1) (command ".undo" 1)) (princ (strcat "\n>>RESULT = " (rtos result 2 precision))) (if (= switch 0) (OPT) ) (ACTION option (rtos result 2 precision)) (setq Numbers nil Numbers (ssget '((0 . "*TEXT"))) ) ) ) ;; MULTIPLY: ((= operation "Multiply") (GET-TEXT) (setq switch 0) (while (/= Numbers nil) (GET-DATA) (setq index 0 result 1 ) (princ "\n>>Expression: ") (repeat (sslength Numbers) (setq ent (entget (ssname Numbers index)) value (read (cdr (assoc 1 ent))) index (1+ index) ) (if (numberp value) (progn (setq result (* result value)) (if (/= index 1) (princ " * ") ) (princ (rtos value 2 precision)) ) ) ) (if (= sw 1) (command ".undo" 1) ) (princ (strcat "\n>>RESULT = " (rtos result 2 precision))) (if (= switch 0) (OPT) ) (ACTION option (rtos result 2 precision)) (setq Numbers nil Numbers (ssget '((0 . "*TEXT"))) ) ) ) ;; SUBTRACT: ((= operation "Subtract") (setq switch 0 sw 0 ) (while (null (setq ename (car (entsel (strcat "\nSelect MINUEND : ")))))) (setq minuend (GET-VALUE "MINUEND")) (while (null (numberp minuend)) (while (null (setq ename (car (entsel (strcat "\nSelect MINUEND : ")))))) (setq minuend (GET-VALUE "MINUEND")) ) (princ minuend) (redraw ename 3) (princ "\nSelect SUBTRAHENDs : ") (while (null (setq Numbers (ssget '((0 . "*TEXT"))))) (princ "\nSelect SUBTRAHENDs : ") ) (redraw ename 4) (while (/= ename nil) (GET-DATA) (setq index 0 result 0 minuend (float minuend) ) (princ (strcat "\n>>Expression: " (rtos minuend 2 precision) " - (" ) ) (repeat (sslength Numbers) (setq ent (entget (ssname Numbers index)) subtrahend (read (cdr (assoc 1 ent))) index (1+ index) ) (if (numberp subtrahend) (progn (setq result (+ result subtrahend)) (if (/= index 1) (princ " + ") ) (princ (rtos subtrahend 2 precision)) ) ) ) (princ ")") (if (= sw 1) (command ".undo" 1) ) (setq result (- minuend result)) (princ (strcat "\n>>RESULT = " (rtos result 2 precision))) (if (= switch 0) (OPT) ) (ACTION option (rtos result 2 precision)) (setq ename nil ename (car (entsel (strcat "\nSelect MINUEND : "))) ) (if (or (null ename) (null (numberp (setq minuend (GET-VALUE "MINUEND")))) ) (progn (setvar "QAFLAGS" 0) (vl-exit-with-error "") ) ) (princ minuend) (princ "\nSelect SUBTRAHENDs <TEXT>: ") (while (null (setq Numbers (ssget '((0 . "*TEXT"))))) (princ "\nSelect SUBTRAHENDs : ") ) ) ) ;; DIVIDE: ((= operation "Divide") (setq switch 0 sw 0 ) (while (null (setq ename (car (entsel (strcat "\nSelect DIVIDEND : ")))))) (setq dividend (GET-VALUE "DIVIDEND")) (while (null (numberp dividend)) (while (null (setq ename (car (entsel (strcat "\nSelect DIVIDEND : ")))))) (setq dividend (GET-VALUE "DIVIDEND")) ) (princ dividend) (redraw ename 3) (princ "\nSelect DIVISORs : ") (while (null (setq Numbers (ssget '((0 . "*TEXT"))))) (princ "\nSelect DIVISORs : ") ) (redraw ename 4) (while (/= ename nil) (GET-DATA) (setq index 0 result 1 dividend (float dividend) ) (princ (strcat "\n>>Expression: " (rtos dividend 2 precision) " / (" ) ) (repeat (sslength Numbers) (setq ent (entget (ssname Numbers index)) divisor (read (cdr (assoc 1 ent))) index (1+ index) ) (if (numberp divisor) (progn (setq result (* result divisor)) (if (/= index 1) (princ " * ") ) (princ (rtos divisor 2 precision)) ) ) ) (princ ")") (if (= sw 1) (command ".undo" 1) ) (setq result (/ dividend result)) (princ (strcat "\n>>RESULT = " (rtos result 2 precision))) (if (= switch 0) (OPT) ) (ACTION option (rtos result 2 precision)) (setq ename nil ename (car (entsel (strcat "\nSelect DIVIDEND : "))) ) (if (or (null ename) (null (numberp (setq dividend (GET-VALUE "DIVIDEND")))) ) (progn (setvar "QAFLAGS" 0) (vl-exit-with-error "") ) ) (princ dividend) (princ "\nSelect DIVISORs : ") (while (null (setq Numbers (ssget '((0 . "*TEXT"))))) (princ "\nSelect DIVISORs : ") ) ) ) ;; AVERAGE: ((= operation "Average") (GET-TEXT) (setq switch 0) (while (/= Numbers nil) (GET-DATA) (setq index 0 id 0 result 0 ) (princ "\n>>Expression: (") (repeat (sslength Numbers) (setq ent (entget (ssname Numbers index)) value (read (cdr (assoc 1 ent))) index (1+ index) ) (if (numberp value) (progn (setq result (+ result value) id (1+ id) ) (if (/= index 1) (princ " + ") ) (princ (rtos value 2 precision)) ) ) ) (if (= sw 1) (command ".undo" 1)) (setq result (rtos (/ (float result) id) 2 precision)) (princ (strcat ") / " (rtos id 2 0))) (princ (strcat "\n>>RESULT = " result)) (if (= switch 0) (OPT) ) (ACTION option result) (setq Numbers nil Numbers (ssget '((0 . "*TEXT"))) ) ) ) ;; MAX-MIN: ((= operation "maX-min") (GET-TEXT) (setq switch 0) (while (/= Numbers nil) (GET-DATA) (setq index 0 Num-set nil ) (repeat (sslength Numbers) (setq ent (entget (ssname Numbers index)) value (read (cdr (assoc 1 ent))) index (1+ index) ) (if (numberp value) (setq Num-set (cons value Num-set)) ) ) (setq Num-set (vl-sort Num-set '>) num-max (car Num-set) num-min (last Num-set) result (strcat "MAX = " (rtos num-max 2 precision) " MIN = " (rtos num-min 2 precision) ) ) (if (= sw 1) (command ".undo" 1)) (princ "\n>>Numbers set: ") (princ Num-set) (print) (princ result) (if (= switch 0) (OPT) ) (ACTION option result) (setq Numbers nil Numbers (ssget '((0 . "*TEXT"))) ) ) ) ;; ADD-BY...: ((= operation "ADd-by") (if (null number0) (setq number0 0.00 save4 number0 ) ) (setq number0 (getreal (strcat "Add by: <" (rtos number0 2 2) "> ")) index 0 ) (if (null number0) (setq number0 save4) (setq save4 number0) ) (GET-TEXT) (GET-DATA) (repeat (sslength Numbers) (setq ent (entget (ssname Numbers index)) value (read (cdr (assoc 1 ent))) index (1+ index) ) (if (numberp value) (setq value (+ (float value) number0) ent (subst (cons 1 (rtos value 2 precision)) (assoc 1 ent) ent ) ) ) (entmod ent) ) ) ;;MULTIPLY-BY...: ((= operation "mUltiply-by") (if (null number0) (setq number0 0.00 save4 number0 ) ) (setq number0 (getreal (strcat "Multiply by: <" (rtos number0 2 2) "> ")) index 0 ) (if (null number0) (setq number0 save4) (setq save4 number0) ) (GET-TEXT) (GET-DATA) (repeat (sslength Numbers) (setq ent (entget (ssname Numbers index)) value (read (cdr (assoc 1 ent))) index (1+ index) ) (if (numberp value) (setq value (* (float value) number0) ent (subst (cons 1 (rtos value 2 precision)) (assoc 1 ent) ent ) ) ) (entmod ent) ) ) ) (princ "<Exit>") (setvar "QAFLAGS" 0) (princ) )Tcal dùng lựa chọn AD (add-by) nhập hằng số K là -K nếu muốn trừ, K nếu muốn cộng
-
1
-
-
*Tên biến: Pickfirst
Tác dụng: Điều khiển việc chọn các đối tượng trước khi thực hiện lệnh
0= vô hiệu
1= hiệu lực hóa
Hề hề, e làm theo nhưng hôk được bác ah. Căn bệnh này có vẻ nan y khó chữa roài. :D
Lỗi này phát sinh khi e mở 1 bản vẽ copy ở nơi khác về. Kể từ đó là bị dính đòn ngay
-
Ôi zời, cài lại cad thì tất nhiên là được rùi mà bác.
E là e xem có cách nào để không mất công gỡ đi rùi cài lại, thiết lập lại các chương trình làm việc cơ.
Nhưng mà các bác hết cách thì e cũng phải cắn răng cắn cỏ cài lại thoai :D
-
Cả Ctrl+C cũng bị hiện tượng tương tự: không chọn đối tượng được trước khi dùng lệnh.
Hiccccccc, chưa có ai bị lỗi như thế này ah????????
Lisp các phép tính đại số tự động cập nhật khi giá trị nguồn thay đổi
trong AutoLisp
Đã đăng · Trả lời báo cáo
Lisp rất hay. Nhưng e thấy tồn tại vấn đề như thế này:
Khi chọn text trong tất cả các lệnh: các đối tượng text ko quét được mà phải chọn từng text một rất mất thời gian
Lệnh LH: ko trừ được cho nhìu số trừ.
Mong bác chỉnh sửa bổ sung thêm cho lisp hoàn thiện ah.
Thanks