Chuyển đến nội dung
Diễn đàn CADViet
mr.thanh2610

[NHỜ SỬA LISP] LISP Chọn số

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

Chào các anh em diễn đàn, em có sưu tầm một lisp của các bác trên diễn đàn mình mà thấy chủ đề cũng rất lâu rồi nên nay em xin mạn phép lập chủ đề mới xin nhờ các anh em giúp đỡ.Vấn đề như sau:

-Chức năng Lisp cũ: chọn các Text là số (số, số nguyên, số thực...)

-Mong muốn chỉnh sửa Lisp: Chọn được cả Mtext, Text và phần chọn số thực chọn được dấu ngăn cách với phần thập phân là dấu phẩy(lisp đang lấy dấu chấm) ; Ví dụ: 1.2("một chấm hai" lisp lấy được), giờ muốn lấy theo kiểu 1,2 (một phẩy hai).Xin chân thành cảm ơn ạ.


;; --------------------LOC TEXT LA SO NAM TRONG KHOANG GIA TRI CHO TRUOC---------------------
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=5733&st=20
(defun c:SN1(/ ss i ent content so ans snho slon skhoang socuctieu socucdai)
;copyright by TUE_NV
(setq ss (ssget '((0 . "*TEXT"))) snho (ssadd) slon (ssadd) skhoang (ssadd))
(setq i 0)
(initget "L N K") 
(setq ans (getkword 
	"\n chon so Nho hon N , Chon so Lon hon L , Chon so trong khoang K < N/L/K > : "))

(if (= ans "N")
(progn 
	(setq so (getreal "\n Nhap so nho hon : "))

	(while (< i (sslength ss))
		(setq ent (ssname ss i))
		(if (and (setq content (distof(cdr(assoc 1 (entget ent))))) (< content so))
			(setq snho (ssadd ent snho))
		)
		(setq i (1+ i))
	);while
	(sssetfirst snho snho)
);progn
);if
	(setq i 0)
(if (= ans "L")
(progn 
	(setq so (getreal "\n Nhap so lon hon : "))

	(while (< i (sslength ss))
		(setq ent (ssname ss i))
		(if (and (setq content (distof(cdr(assoc 1 (entget ent))))) (> content so))
			(setq slon (ssadd ent slon))
		)
		(setq i (1+ i))
	);while
	(sssetfirst slon slon)
);progn
);if
	(setq i 0)
(if (= ans "K")
(progn 
	(setq socuctieu (getreal "\n Nhap so cuc tieu MIN : "))
	(setq socucdai (getreal "\n Nhap so cuc dai MAX: "))

	(while (< i (sslength ss))
		(setq ent (ssname ss i))
		(if (and (setq content (distof(cdr(assoc 1 (entget ent))))) 
			 (> content socuctieu)
			 (< content socucdai))
			(setq skhoang (ssadd ent skhoang))
		)
		(setq i (1+ i))
	);while
	(sssetfirst skhoang skhoang)
))
(princ)
)

;; --------------------LOC TEXT LA SO---------------------
(defun c:SN (/ ss ent str ss1)
 (setq ss1 (ssadd))
 (if (setq ss (ssget (list (cons 0 "*TEXT"))))
   (progn
     (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(setq str (cdr(assoc 1 (entget ent))))
(if (distof str 2)
  (ssadd ent ss1)
  )
)      
     (if (> (sslength ss1) 0)
       (progn
         (sssetfirst nil)
  (princ (strcat "\nChon duoc " (itoa (sslength ss1)) " doi tuong Text co noi dung la so."))
         (sssetfirst nil ss1)
  )
)
     )
   )
 )

;; --------------------LOC TEXT LA SO THUC---------------------

(defun c:STH(/ ent i ss ss1 str)
 (if (setq ss (ssget (list (cons 0 "*TEXT"))))
   (progn
     (setq i -1 ss1 (ssadd))
     (while (setq ent (ssname ss (setq i (1+ i))))
       (setq str (cdr(assoc 1 (entget ent))))
       (if (and (distof str 2)
	 (= (type (read str)) 'REAL ))
  (ssadd ent ss1) ))
     (if (> (sslength ss1) 0)
       (progn
         (sssetfirst nil)
  (princ (strcat "\nChon duoc " (itoa (sslength ss1)) " doi tuong Text co noi dung la so thuc."))
         (sssetfirst nil ss1)  )) ) ))

;; --------------------LOC TEXT LA SO NGUYEN---------------------

(defun c:SNG(/ ent i ss ss1 str)
 (if (setq ss (ssget (list (cons 0 "*TEXT"))))
   (progn
     (setq i -1 ss1 (ssadd))
     (while (setq ent (ssname ss (setq i (1+ i))))
       (setq str (cdr(assoc 1 (entget ent))))
       (if (and (distof str 2)
	 (= (type (read str)) 'INT ))
  (ssadd ent ss1) ))
     (if (> (sslength ss1) 0)
       (progn
         (sssetfirst nil)
  (princ (strcat "\nChon duoc " (itoa (sslength ss1)) " doi tuong Text co noi dung la so thuc."))
         (sssetfirst nil ss1)  )) ) ))

 

16.LOC TEXT LA SO(SN, SN1, STH, SNG).lsp

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

×