Jump to content
InfoFile
Tác giả: hiepttr
Bài viết gốc: 267469
Tên lệnh: a3
Vẽ khung giấy

Chào cả nhà!
Em có đoạn lisp tạo khổ giấy a3 như sau em đã mày mò mặc định được nét vẽ cho khung giấy. Hai hình vuông cùng 1 nét vẽ. Nay em muốn khai triển hai hình vuông trên mặc định 2 layer khác nhau ma làm mãi không dc. Anh em nào làm được giúp mình với. Thanks nhiều nhiều
 
(Defun c:A3 ()
(setq...

>>

Chào cả nhà!
Em có đoạn lisp tạo khổ giấy a3 như sau em đã mày mò mặc định được nét vẽ cho khung giấy. Hai hình vuông cùng 1 nét vẽ. Nay em muốn khai triển hai hình vuông trên mặc định 2 layer khác nhau ma làm mãi không dc. Anh em nào làm được giúp mình với. Thanks nhiều nhiều
 
(Defun c:A3 ()
(setq oldlayer (getvar 'clayer)) (setvar 'clayer "0")
(SETQ OLDERR *error*
      *error* myerror)
(setvar 'clayer "0")
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
   (setvar "OSMODE" 0)
   (setq mv_sc 100)
   (setq x3  420)
   (setq y3  297)
   (setq x3 (* mv_sc x3) 
         y3 (* mv_sc y3))
   (command  
    "LIMITS" "0,0" (list x3 y3)
    "PLINE" "0,0" (list 0 y3) (list x3 y3) (list x3 0) "0,0" "_C"
    "RECTANG" "2500,1000" "@38500,27700"
    "ZOOM" "_a"  )
   (setvar "OSMODE" 4263)
(SETVAR "OSMODE" OSM)
(SETVAR "CMDECHO" CMD)
(setvar 'clayer oldlayer)
(princ))

Khá rảnh nên ôn bài tí :D :D :D

Bạn thêm dòng này: 

(if (not (tblsearch "layer" "net_moi"))
(command "-layer" "m" "net_moi" "c" 11 "" "l" "continuous" "" "")
(setvar 'clayer "net_moi"))

vào trước dòng:

"RECTANG" "2500,1000" "@38500,27700"

để cái Rectang vẽ ra mang layer "net_moi"

(Defun c:A3 ()
(setq oldlayer (getvar 'clayer)) (setvar 'clayer "0")
(SETQ OLDERR *error*
      *error* myerror)
(setvar 'clayer "0")
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
   (setvar "OSMODE" 0)
   (setq mv_sc 100)
   (setq x3  420)
   (setq y3  297)
   (setq x3 (* mv_sc x3) 
         y3 (* mv_sc y3))
   (command  
    "LIMITS" "0,0" (list x3 y3)
    "PLINE" "0,0" (list 0 y3) (list x3 y3) (list x3 0) "0,0" "_C")
(if (not (tblsearch "layer" "net_moi"))
(command "-layer" "m" "net_moi" "c" 11 "" "l" "continuous" "" "")
(setvar 'clayer "net_moi"))
    (command "RECTANG" "2500,1000" "@38500,27700"
    "ZOOM" "_a"  )
   (setvar "OSMODE" 4263)
(SETVAR "OSMODE" OSM)
(SETVAR "CMDECHO" CMD)
(setvar 'clayer oldlayer)
(princ))

 


<<

Filename: 267469_a3.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 267638
Tên lệnh: ha
cần lisp lọc số trong khoảng AB

Chi mà phải mở nhiều topic thế!

;Doan Van Ha - CADViet.com - Ngay 26/11/2013
;Muc dich: Chon cac doi tuong *Text nam giua 2 gioi han.
(defun C:HA( / duoi tren ss )
 (if
  (and
   (not (initget 1)) (setq duoi (getreal "\nNhap gioi han duoi: "))
   (not (initget 1)) (setq tren (getreal "\nNhap gioi han tren: "))
   (princ "\nChon cac doi tuong Text...")
   (setq ss (ssget '((0 . "*Text"))) ss1 (ssadd)))
  (progn  
 ...
>>

Chi mà phải mở nhiều topic thế!

;Doan Van Ha - CADViet.com - Ngay 26/11/2013
;Muc dich: Chon cac doi tuong *Text nam giua 2 gioi han.
(defun C:HA( / duoi tren ss )
 (if
  (and
   (not (initget 1)) (setq duoi (getreal "\nNhap gioi han duoi: "))
   (not (initget 1)) (setq tren (getreal "\nNhap gioi han tren: "))
   (princ "\nChon cac doi tuong Text...")
   (setq ss (ssget '((0 . "*Text"))) ss1 (ssadd)))
  (progn  
   (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    (if
     (>= tren (distof (cdr (assoc 1 (entget ent)))) duoi)
     (setq ss1 (ssadd ent ss1))))
   (sssetfirst nil ss1))))
 

<<

Filename: 267638_ha.lsp
Tác giả: duongsatdn
Bài viết gốc: 12359
Tên lệnh: thunghiem
Các lệnh cơ bản của AutoCAD

Lệnh LEN ở một số trường hợp cũng có thể dùng thay cho STRETCH.

Filename: 12359_thunghiem.lsp
Tác giả: quansla
Bài viết gốc: 266738
Tên lệnh: 111111
Sửa lisp xuất tọa độ Pline


(defun c:111111 (/ ELV ENT FH FN HND ITM ITM2 NUM OBJ PNT SSET X0 Y0)
  (setq sset (ssget '((-4 . "<OR")(0 . "POINT")
                      (0 . "LWPOLYLINE")(-4 . "OR>"))))
  (if sset
    (progn
      (setq itm 0 num (sslength sset))
      (setq fn (getfiled "Point Export File" "" "txt" 1))
      (if (/= fn nil)
        (progn
          (setq fh (open fn "w"))
          (while (< itm num)
   ...

>>


(defun c:111111 (/ ELV ENT FH FN HND ITM ITM2 NUM OBJ PNT SSET X0 Y0)
  (setq sset (ssget '((-4 . "<OR")(0 . "POINT")
                      (0 . "LWPOLYLINE")(-4 . "OR>"))))
  (if sset
    (progn
      (setq itm 0 num (sslength sset))
      (setq fn (getfiled "Point Export File" "" "txt" 1))
      (if (/= fn nil)
        (progn
          (setq fh (open fn "w"))
          (while (< itm num)
            (setq hnd (ssname sset itm))
            (setq ent (entget hnd))
            (setq obj (cdr (assoc 0 ent)))
            (cond
              ((= obj "POINT")
                (setq pnt (cdr (assoc 10 ent)))
                (princ (strcat (rtos (car pnt) 2 2) " "
                               (rtos (cadr pnt) 2 2) " "
                               (rtos (caddr pnt) 2 2)) fh)
                (princ "\n" fh)
              )
              ((= obj "LWPOLYLINE")
                (if (= (cdr (assoc 38 ent)) nil)
                  (setq elv 0.0)
                  (setq elv (cdr (assoc 38 ent)))
                )
      (setq itm2 0)
                (foreach rec ent
                  (if (= (car rec) 10)    
                    (progn
     (setq pnt (cdr rec))
     (if (= (setq itm2 (1+ itm2)) 1)
(progn
 (setq x0 (car pnt) y0 (cadr pnt))
 (princ(strcat (rtos x0 2 4) " " (rtos y0 2 4) " " (rtos elv 2 4)) fh)
 (princ "\n" fh))
(progn
 (princ (strcat (rtos (- (car pnt) x0) 2 4) " "
(rtos (- (cadr pnt) y0) 2 4) " "
(rtos elv 2 4)) fh)
 (princ "\n" fh)
 )
                    )
                  )
                )
              ))
              (t nil)
            )
            (setq itm (1+ itm))
          )
          (close fh)
        )
      )
    )
  )
  (princ)
)


mình đã đổi tên lệnh thành 111111 (6 số 1) bạn đổi lại cho phù hợp với công việc của mình.
Và vấn đề nữa là code của bạn khi dùng chẳng phải sẽ không phân biệt được list point10 của các đối tượng khác nhau sao.
Vậy khi làm chỉ có cách quét từng đối tượng để xử lý àh,?


<<

Filename: 266738_111111.lsp
Tác giả: quansla
Bài viết gốc: 267934
Tên lệnh: thunghiem
Sửa lisp xuất tọa độ Pline

Tên lệnh là Thunghiem
Ban có thể đối lại tên tuỳ ý
có gì cần sửa PM lại mình nhé
sử dụng: Gọi lệnh "THUNGHIEM"
Quét chọn đối tượng Polyline (quét thi quét thoải mái) nhưng lisp chỉ xử lý cho 1 đối tượng đầu tiên của tập chọn thôi.

Nhập tên file cần ghi data, líp cho phép xem trước KQ, chọn Yes để ghi kết quả , No để không ghi kết quả
Nếu quá lằng nhằng, luôn...

>>

Tên lệnh là Thunghiem
Ban có thể đối lại tên tuỳ ý
có gì cần sửa PM lại mình nhé
sử dụng: Gọi lệnh "THUNGHIEM"
Quét chọn đối tượng Polyline (quét thi quét thoải mái) nhưng lisp chỉ xử lý cho 1 đối tượng đầu tiên của tập chọn thôi.

Nhập tên file cần ghi data, líp cho phép xem trước KQ, chọn Yes để ghi kết quả , No để không ghi kết quả
Nếu quá lằng nhằng, luôn kiểm soát được việc quét đối tượng là chính xác, PM lại mình bỏ luôn đoạn hỏi

Yes/No đi

 

(defun c:thunghiem (/ dt en i ls lst N x xy0 lst2 f k ten x y)
(if (and (setq ten (getfiled"\nchon file" "" "txt;*" 7))
(setq dt (ssname (ssget '((0 . "LWPOLYLINE"))) 0)))
(progn
(setq f (open ten "w"))
(setq i -1 en (entget dt) N (length en) lst '())
(while (<(setq i (1+ i)) N)
(if (= (car( nth i en)) 10)
(setq lst (append lst (list (cdr(nth i en)))))))
(setq lst2 (append '((0 0 0)) (reverse(cdr(reverse lst)))))
(setq ls(mapcar '(lambda (x y)
(list
(- (car x) (car y))
(- (cadr x) (cadr y))))
lst lst2))
(prompt "\nInthu\n")(princ)
(foreach i ls
(princ (strcat (rtos (car i) 2 4) "\t" (rtos (cadr i) 2 4) "\n"))
(princ)
)
(textscr)
(initget 1 "Yes No")
(setq k (strcase(getkword "\nBan co muon ghi ra file ketqua tren? ")))
(if (= k "YES")
(foreach i ls
(princ (strcat (rtos (car i) 2 4) "\t" (rtos (cadr i) 2 4) "\n") f)
)
(prompt "\nKhong ghi ket qua ra file nua"))
(close f)))
(princ)
)


<<

Filename: 267934_thunghiem.lsp
Tác giả: ketxu
Bài viết gốc: 268058
Tên lệnh: ciso cuniso
Ẩn hiện đối tượng theo màu

Tí quên ^^ Của bạn đây. Mình quick code iso 1 màu thôi nhé :)  1 cái CISO và 1 cái CUNISO

(defun get_col(e)(setq e (entget e))(cdr (cond ((assoc 62 e))((assoc 62 (tblsearch "layer"  (cdr (assoc 8 e))))))))
(defun C:ciso(/ e col s o)
	(while (not (setq e (nentsel "\nSelect object :"))))
	(cond
		(
			(and
				(setq col (get_col  (car e)))
				(setq s (ssget "X") i -1)
			)
			(while (setq o (ssname s (setq i (1+ i))))
				(if (/=...
>>

Tí quên ^^ Của bạn đây. Mình quick code iso 1 màu thôi nhé :)  1 cái CISO và 1 cái CUNISO

(defun get_col(e)(setq e (entget e))(cdr (cond ((assoc 62 e))((assoc 62 (tblsearch "layer"  (cdr (assoc 8 e))))))))
(defun C:ciso(/ e col s o)
	(while (not (setq e (nentsel "\nSelect object :"))))
	(cond
		(
			(and
				(setq col (get_col  (car e)))
				(setq s (ssget "X") i -1)
			)
			(while (setq o (ssname s (setq i (1+ i))))
				(if (/= (get_col o) col)(entmod (append (entget o) (list (cons 60 1)))))
			)
		)
	)
	(princ)
)
(defun c:cuniso(/ s o)
(setq s (ssget "_X" '((60 . 1))))
(or
	(and acet-ss-visible (acet-ss-visible s 0))
	(while (setq o (ssname s (setq i (1+ i))))(entmod (append (entget o) (list (cons 60 0)))))
)

(prompt (strcat "Hi\U+1EC7n l\U+1EA1i c\U+00E1c \U+0111\U+1ED1i t\U+01B0\U+1EE3ng \U+0111\U+00E3 b\U+1ECB \U+1EA9n :" (vl-princ-to-string (sslength s))))
(princ)
)
			

<<

Filename: 268058_ciso_cuniso.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 268109
Tên lệnh: gop
Xin lisp gộp các lệnh trong file lisp thành 1

Lisp gộp đây. Lỗi bạn tự chịu trách nhiệm.

(defun C:GOP()
 (C:A)
 (C:B)
 (C:C))

Filename: 268109_gop.lsp
Tác giả: NguyenNgocSon
Bài viết gốc: 225349
Tên lệnh: mnu
Gọi lisp bằng VBA
Đơn giản thế này nhé. Load lisp này

;Goi lenh tao Menu khi khoi dong xong
(Defun C:Mnu()
(Command "Vbarun" "TaoMenu")
(princ))

Còn gọi Thủ tục trong Menu bằng lisp thì cũng tương tự thôi.

Filename: 225349_mnu.lsp
Tác giả: ketxu
Bài viết gốc: 268211
Tên lệnh: cisov cunisov
Ẩn hiện đối tượng theo màu

Chui vào bên trong xem tốc độ có ổn hơn không. Mình sử dụng VL

 

(defun c:cisov(/ _table _vlacol lays adoc col)
	(vl-load-com) 
	(defun _table (s / d r)
		(while (setq d (tblnext s (null d)))
			(setq r (append  (list (cons (cdr (assoc 2 d)) (cdr (assoc 62 d)))) r))
		)	
	)
	(defun _vlacol(obj lays / col)(if (/= (setq col (vla-get-color obj)) 256) col (cdr (assoc (vla-get-layer obj) lays))))
	(setq lays (table "LAYER"))
	(setq...
>>

Chui vào bên trong xem tốc độ có ổn hơn không. Mình sử dụng VL

 

(defun c:cisov(/ _table _vlacol lays adoc col)
	(vl-load-com) 
	(defun _table (s / d r)
		(while (setq d (tblnext s (null d)))
			(setq r (append  (list (cons (cdr (assoc 2 d)) (cdr (assoc 62 d)))) r))
		)	
	)
	(defun _vlacol(obj lays / col)(if (/= (setq col (vla-get-color obj)) 256) col (cdr (assoc (vla-get-layer obj) lays))))
	(setq lays (table "LAYER"))
	(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
	(setq col (get_vlacol (vlax-ename->vla-object (car(entsel))) lays)) 
	(vla-startundomark adoc)
	(vlax-for block (vla-get-blocks adoc)     
		  (vlax-for   ent block 
			(if (/= (get_vlacol ent lays) col) (vla-put-visible ent 0))
		)
	)
	(vla-endundomark adoc)
)

(defun c:cunisov(/ adoc)
	(vl-load-com) 	
	(setq adoc (vla-get-activedocument (vlax-get-acad-object)))	
	(vlax-for block (vla-get-blocks adoc)     
		  (vlax-for   ent block 
			(vla-put-visible ent 1)
		)
	)
)

<<

Filename: 268211_cisov_cunisov.lsp
Tác giả: luonhamhochoi
Bài viết gốc: 211193
Tên lệnh: xoa
[Yêu cầu] Lisp xóa text và mũi tên dưới text?


;**************Xoa do doc tren trac ngang****************

(defun c:xoa ( / SS i N ent P0 P1 A lstent)
(FNN)
(setq SS (ssget '((8 . "ENTTNTHIETKE") (0 . "POLYLINE")))
i 0
N (sslength SS)
)
(ss2ent SS)
(repeat (- N 1)
(setq ent (nth i lstent)
P0 (vlax-curve-getPointAtParam ent 0)
P1 (vlax-curve-getPointAtParam ent 2)
A (angle P0 P1)
i (1+ i)
)
(if (or (equal A 0...
>>


;**************Xoa do doc tren trac ngang****************

(defun c:xoa ( / SS i N ent P0 P1 A lstent)
(FNN)
(setq SS (ssget '((8 . "ENTTNTHIETKE") (0 . "POLYLINE")))
i 0
N (sslength SS)
)
(ss2ent SS)
(repeat (- N 1)
(setq ent (nth i lstent)
P0 (vlax-curve-getPointAtParam ent 0)
P1 (vlax-curve-getPointAtParam ent 2)
A (angle P0 P1)
i (1+ i)
)
(if (or (equal A 0 0.005) (equal A 3.142 0.005) (equal A 0.381 0.005)
(equal A 2.761 0.005) (equal A 2.159 0.005) (equal A 0.983 0.005))
(command "ERASE" ent "")
)
)
)
;-----------------------------
(defun ss2ent (ss / sodt index)
(setq
sodt (cond
(ss (sslength ss))
(t 0)
)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
lstent
)
;--------------------------------
(defun FNN ( / ss t1 t2 t3 t4 e)
(setq
t1 "40%"
t2 "150%"
t3 "0%"
ss (ssget '((0 . "TEXT")))
ss1 (ssadd)
ss2 (ssadd)
ss3 (ssadd)
)
(while (setq e (ssname ss 0))
(setq t (cdr (assoc 1 (entget e))))
(if (vl-string-search t1 t) (setq ss1 (ssadd e ss1)))
(if (vl-string-search t2 t) (setq ss2 (ssadd e ss2)))
(if (vl-string-search t3 t) (setq ss3 (ssadd e ss3)))
(ssdel e ss)
)
(command "ERASE" ss1 ss2 ss3 "")
)

<<

Filename: 211193_xoa.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 268682
Tên lệnh: obi
các sử dụng tài nguyên trong list đã chọn!?

Câu hỏi của bạn đã lãnh đủ 2 dấu trừ của ai đó tặng, ấy là do bạn mà thôi.

(defun C:OBI( / obi-lst d vitri)
 (setq obi-lst '((12 5 6) (4 8 9) (5 7 8)))
 (initget 7) (setq d (getint "\nNhap do lon truc: "))
 (if (setq vitri (vl-position d (car obi-lst)))
  (list d (nth vitri (cadr obi-lst)) (nth vitri (caddr obi-lst)))
  (alert "Khong co B va D tuong ung voi gia tri d")))
 

Filename: 268682_obi.lsp
Tác giả: quansla
Bài viết gốc: 268285
Tên lệnh: thunghiem
Sửa lisp xuất tọa độ Pline

Xuất tọa độ hình tròn mình nhờ bạn đấy
Mình có 1 lisp xuất tọa độ và đường kính hình tròn rồi
Nhưng nó lại xuất cho rất nhiều đối tượng và có rất nhiều sự lựa chọn
bạn lược bớt cho đơn giản hộ mình nhé
1-Quét được nhiều đường tròn cùng 1 lúc
2-Chỉ xuất tọa độ X Y và đường...

>>

Xuất tọa độ hình tròn mình nhờ bạn đấy
Mình có 1 lisp xuất tọa độ và đường kính hình tròn rồi
Nhưng nó lại xuất cho rất nhiều đối tượng và có rất nhiều sự lựa chọn
bạn lược bớt cho đơn giản hộ mình nhé
1-Quét được nhiều đường tròn cùng 1 lúc
2-Chỉ xuất tọa độ X Y và đường kính sắp xếp giống lisp Pline bên trên thôi nhưng cho vào file "csv" theo 3 cột được không?
Cảm ơn rất nhiều
Mình ngồi vọc để hiểu mà mãi k bỏ được các thứ đó đi =))

P/s Mình xin lỗi vì không pm bài bạn sớm hơn, dạo này hơi bận chút, trước mắt mình sửa lại thế này, phần về đường tròn, trong Code mình có sử dụng hàm của Ẽxpress Tools (quen rồi) nếu trên máy bạn chưa cài , líp sẽ không chạy , bạn PM lại mình sửa lại sau. chúc vui. Gợi ý thêm: phần quét chọn hình tròn bạn có yêu cầu gì thêm không( ví dụ xắp xếp theo tăng giảm Radius, xắp xếp theo X,Y của đường tròn, ...) Rất mừng khi bạn cũng quan tâm đến Líp, mình chỉ mới biết líp thôi, bạn có cùng sở thích, cùng học nhé.

http://www.cadviet.com/upfiles/3/101306_thunghiemtron.lsp
Đây là lisp thực hiện với đường tròn (bạn có thể đổi lại tên lệnh, tên hiện tại là thunghiemTron; bạn có thể bỏ đi dòng mà trong code mình đánh dấu có thể bỏ đi, để phù hợp với công việc)
 
Mình đã sửa lại yêu cầu của bạn , mình post lại dưới đây nhé.
http://www.cadviet.com/upfiles/3/101306_thunghiem_1.lsp

;;;; THUNGHIEM --- Lam viec voi Poly
(defun c:thunghiem (/ dt en i ls lst N x xy0 lst2 f k ten x y)
 
(if (and (setq ten (getfiled "\nchon file" "" "txt;*" 7))
 
(setq dt (ssname (ssget '((0 . "LWPOLYLINE"))) 0)))
 
(progn
 
(setq f (open ten "w"))
 
(setq i -1 en (entget dt) N (length en) lst '())
 
(while (<(setq i (1+ i)) N)
 
(if (= (car( nth i en)) 10)
 
(setq lst (append lst (list (cdr(nth i en)))))))
 
(setq lst2 (append '((0 0 0)) (reverse(cdr(reverse lst)))))
 
(setq ls(mapcar '(lambda (x y)
 
(list
 
(- (car x) (car y))
 
(- (cadr x) (cadr y))))
 
lst lst2))
 
(prompt "\nInthu\n")(princ)
 
(foreach i ls
 
(princ (strcat (rtos (car i) 2 4) "\t" (rtos (cadr i) 2 4) "\n"))
 
(princ)
 
)
 
;(textscr)
 
;(initget 1 "Yes No")
 
;(setq k (strcase(getkword "\nBan co muon ghi ra file ketqua tren? ")))
 
(foreach i ls
 
(princ (strcat (rtos (car i) 2 4) "\t" (rtos (cadr i) 2 4) "\n") f)
 
)
 
(close f)))
 
(princ)
 
)





(defun c:thunghiemTron (/ ls dt ent i f ten)
(vl-load-com)
(if (and (setq ten (getfiled "\nchon file" "" "csv;txt;*" 7))
(setq ss (acet-ss-to-list(ssget '(( 0 . "Circle"))))))
(progn
(setq ls '())
(setq f (open ten "w"))
(princ "X\tY\tRadius\n" f) ;;;; co the bo dong nay di
(foreach dt ss
(setq ls (append ls (list(list
(car(acet-dxf 10 (setq ent (entget dt))))
(cadr (acet-dxf 10 ent))
(acet-dxf 40 ent))))))
(foreach i ls
(princ (strcat (rtos (car i) 2 4)"\t"(rtos (cadr i) 2 4)"\t"(rtos (caddr i) 2 4) "\n") f)
)
(close f)))
(princ)
)

<<

Filename: 268285_thunghiem.lsp
Tác giả: quansla
Bài viết gốc: 268285
Tên lệnh: thunghiemtron
Sửa lisp xuất tọa độ Pline

Xuất tọa độ hình tròn mình nhờ bạn đấy
Mình có 1 lisp xuất tọa độ và đường kính hình tròn rồi
Nhưng nó lại xuất cho rất nhiều đối tượng và có rất nhiều sự lựa chọn
bạn lược bớt cho đơn giản hộ mình nhé
1-Quét được nhiều đường tròn cùng 1 lúc
2-Chỉ xuất tọa độ X Y và đường...

>>

Xuất tọa độ hình tròn mình nhờ bạn đấy
Mình có 1 lisp xuất tọa độ và đường kính hình tròn rồi
Nhưng nó lại xuất cho rất nhiều đối tượng và có rất nhiều sự lựa chọn
bạn lược bớt cho đơn giản hộ mình nhé
1-Quét được nhiều đường tròn cùng 1 lúc
2-Chỉ xuất tọa độ X Y và đường kính sắp xếp giống lisp Pline bên trên thôi nhưng cho vào file "csv" theo 3 cột được không?
Cảm ơn rất nhiều
Mình ngồi vọc để hiểu mà mãi k bỏ được các thứ đó đi =))

P/s Mình xin lỗi vì không pm bài bạn sớm hơn, dạo này hơi bận chút, trước mắt mình sửa lại thế này, phần về đường tròn, trong Code mình có sử dụng hàm của Ẽxpress Tools (quen rồi) nếu trên máy bạn chưa cài , líp sẽ không chạy , bạn PM lại mình sửa lại sau. chúc vui. Gợi ý thêm: phần quét chọn hình tròn bạn có yêu cầu gì thêm không( ví dụ xắp xếp theo tăng giảm Radius, xắp xếp theo X,Y của đường tròn, ...) Rất mừng khi bạn cũng quan tâm đến Líp, mình chỉ mới biết líp thôi, bạn có cùng sở thích, cùng học nhé.

http://www.cadviet.com/upfiles/3/101306_thunghiemtron.lsp
Đây là lisp thực hiện với đường tròn (bạn có thể đổi lại tên lệnh, tên hiện tại là thunghiemTron; bạn có thể bỏ đi dòng mà trong code mình đánh dấu có thể bỏ đi, để phù hợp với công việc)
 
Mình đã sửa lại yêu cầu của bạn , mình post lại dưới đây nhé.
http://www.cadviet.com/upfiles/3/101306_thunghiem_1.lsp

;;;; THUNGHIEM --- Lam viec voi Poly
(defun c:thunghiem (/ dt en i ls lst N x xy0 lst2 f k ten x y)
 
(if (and (setq ten (getfiled "\nchon file" "" "txt;*" 7))
 
(setq dt (ssname (ssget '((0 . "LWPOLYLINE"))) 0)))
 
(progn
 
(setq f (open ten "w"))
 
(setq i -1 en (entget dt) N (length en) lst '())
 
(while (<(setq i (1+ i)) N)
 
(if (= (car( nth i en)) 10)
 
(setq lst (append lst (list (cdr(nth i en)))))))
 
(setq lst2 (append '((0 0 0)) (reverse(cdr(reverse lst)))))
 
(setq ls(mapcar '(lambda (x y)
 
(list
 
(- (car x) (car y))
 
(- (cadr x) (cadr y))))
 
lst lst2))
 
(prompt "\nInthu\n")(princ)
 
(foreach i ls
 
(princ (strcat (rtos (car i) 2 4) "\t" (rtos (cadr i) 2 4) "\n"))
 
(princ)
 
)
 
;(textscr)
 
;(initget 1 "Yes No")
 
;(setq k (strcase(getkword "\nBan co muon ghi ra file ketqua tren? ")))
 
(foreach i ls
 
(princ (strcat (rtos (car i) 2 4) "\t" (rtos (cadr i) 2 4) "\n") f)
 
)
 
(close f)))
 
(princ)
 
)





(defun c:thunghiemTron (/ ls dt ent i f ten)
(vl-load-com)
(if (and (setq ten (getfiled "\nchon file" "" "csv;txt;*" 7))
(setq ss (acet-ss-to-list(ssget '(( 0 . "Circle"))))))
(progn
(setq ls '())
(setq f (open ten "w"))
(princ "X\tY\tRadius\n" f) ;;;; co the bo dong nay di
(foreach dt ss
(setq ls (append ls (list(list
(car(acet-dxf 10 (setq ent (entget dt))))
(cadr (acet-dxf 10 ent))
(acet-dxf 40 ent))))))
(foreach i ls
(princ (strcat (rtos (car i) 2 4)"\t"(rtos (cadr i) 2 4)"\t"(rtos (caddr i) 2 4) "\n") f)
)
(close f)))
(princ)
)

<<

Filename: 268285_thunghiemtron.lsp
Tác giả: Tue_NV
Bài viết gốc: 72722
Tên lệnh: ntdt
Viết lisp theo yêu cầu [phần 2]

centurion laboratories filitra State police say four of the boys claimed they were molested at Miller"s home in 1992. The boys at the time were attending the Hole in the Wall Gang Camp in Ashford, a camp that actor Paul Newman opened in 1988 for sick children. The alleged abuse happened when Miller, who was a counselor there from 1989 to 1992, took the children away from the camp on unsanctioned trips, authorities...
>>
centurion laboratories filitra State police say four of the boys claimed they were molested at Miller"s home in 1992. The boys at the time were attending the Hole in the Wall Gang Camp in Ashford, a camp that actor Paul Newman opened in 1988 for sick children. The alleged abuse happened when Miller, who was a counselor there from 1989 to 1992, took the children away from the camp on unsanctioned trips, authorities said.
zandu vigorex mrp In the letter addressed to commission Chairman Irving Williamson, Froman said that the decision doesn’t mean that the patent owner is not entitled to a remedy but the patent owner may continue to pursue its rights in courts. He added that the veto was based on the technical policy considerations as well as their effect on competitive conditions in the US economy and its effect on the consumers.
stallion pro male virility coffee Prosecutors say Tsarnaev, a Muslim, wrote about his motivations for the bombing on the inside walls and beams of the boat where he was captured. He wrote the U.S. government was "killing our innocent civilians."
free extagen “He got hookers all the time,” one unidentified staffer told author Michael Gross for his upcoming book, “House of Outrageous Fortune: Fifteen Central Park West, The World’s Most Powerful Address.”
what does ziapro do "Unless the public knows what the laws mean, it can"t reallyassess how much power (it has) given its government," saidPatrick Toomey, a national security fellow at the American CivilLiberties Union.
zeagra gel "I respectfully disagree with a number of people, including my own sister, on this subject, but no doubt we"ll all continue to say our piece," he said, adding of his chat with the singer: "My daughters for once were envious of their dad."
mandelay climax control gel Prof Andy Shepherd, from Leeds University, said: "Now that we have three years of data, we can see that some parts of the ice pack have thinned more rapidly than others. At the end of winter, the ice was thinner than usual. Although this summer's extent will not get near its all-time satellite-era minimum set last year, the very thin winter floes going into the melt season could mean that the summer volume still gets very close to its record low," he told BBC News.
alprostadil vitaros "Steve sometimes doesn't really do the voice and he'll be improvising and coming out with stuff and then he'll say 'I saw a great episode of Air Crash Investigation last night' and you'll think 'oh that's good' and start to write it down. And he'll be like 'no I really did watch a great episode'. He very much blurs the line."
test x180 ignite reviews The schools" management said it ended fiscal 2013 with a $6million deficit but expects to report a surplus of approximately$6 million in 2014 due to school closures and possible midyearbudget cuts, S&P said.
progene forum First off, economics is a social science, not a hard science, so don"t kid yourself that anyone has the final word on anything. You may as well go to the opera in hopes of finding out whether it will rain next week.

<<

Filename: 72722_ntdt.lsp
Tác giả: loc2210
Bài viết gốc: 268892
Tên lệnh: l2d1
Sửa lisp xuất tọa độ Pline

lisp lấy tọa độ của bạn đây.

(defun c:l2d1 ()
  
  	(setq tenk (getstring "Nhap ten Suon ; Duong Nuoc ; Cat Doc : "))
	(setq rong t)
	(setq tdx (list)
	      tdy (list) 
		tdxy (list )
	      dulieu (list))
  	  		
		(while rong
		  
			(progn
				(setq p1 (getpoint "\nChon mot diem:"))
					(if p1
						(progn
							(setq tdx (append (list (rtos (car p1) 2 2)) tdx )
)
						  (setq tdy (append (list (rtos (cadr p1) 2 2)) tdy...
>>

lisp lấy tọa độ của bạn đây.

(defun c:l2d1 ()
  
  	(setq tenk (getstring "Nhap ten Suon ; Duong Nuoc ; Cat Doc : "))
	(setq rong t)
	(setq tdx (list)
	      tdy (list) 
		tdxy (list )
	      dulieu (list))
  	  		
		(while rong
		  
			(progn
				(setq p1 (getpoint "\nChon mot diem:"))
					(if p1
						(progn
							(setq tdx (append (list (rtos (car p1) 2 2)) tdx )
)
						  (setq tdy (append (list (rtos (cadr p1) 2 2)) tdy )
							tdxy (append (list(rtos (/ (car p1) 1000) 2 2)","(rtos (/ (cadr p1) 1000) 2 2)) tdxy)
							dulieu (append (list (strcat (rtos (/ (car p1) 1000) 2 2)","(rtos (/ (cadr p1) 1000) 2 2))) dulieu))
						  
(setq rong t)
)
(setq rong nil)
)
)
)
  
(setq tdx (reverse tdx)
      tdy (reverse tdy))
  (princ tenk)
  (princ "\n")
(princ "Toa do X")
  (princ "\n")
  
  (princ tdx)
  (princ "\n")
  
  (princ "Toa do Y")
  
  (princ "\n")
  (princ tdy)
  
  (princ "\n")
   (princ "\n")
  (princ dulieu)
  
  (alert "Chuong trinh duoc viet boi  - Bui Cong Loc ")


)

<<

Filename: 268892_l2d1.lsp
Tác giả: tran.designer.int
Bài viết gốc: 239769
Tên lệnh: btm
lisp chuyển các đối tượng về 1 layer

Chào cả nhà! 

Mình mới nghiên cứu về lisp, không biết trên diễn đàn đã có ai hỏi về vấn đề  vẽ bậc thang chưa? Mình có đoạn lisp về cầu thang cần mọi người góp ý! 

Mình muốn vẽ mủi bậc thang cách điểm chọn 1 góc tọa độ xoy (20mm,20mm). Mong các bác giúp đỡ! Thank các bác nhìu nhìu!

>>

Chào cả nhà! 

Mình mới nghiên cứu về lisp, không biết trên diễn đàn đã có ai hỏi về vấn đề  vẽ bậc thang chưa? Mình có đoạn lisp về cầu thang cần mọi người góp ý! 

Mình muốn vẽ mủi bậc thang cách điểm chọn 1 góc tọa độ xoy (20mm,20mm). Mong các bác giúp đỡ! Thank các bác nhìu nhìu!

http://www.cadviet.com/upfiles/3/118057_btm.lsp

(defun c:BTM (/ p c r sb oldos)
(setq
nb 20.0
bk 10.0
p (getpoint "\nVao diem dau tien: ")
c (getdist p "\nVao chieu cao bac: ")
r (getdist p "\nVao chieu rong bac: ")
sb (getint "\nVao so bac: ")
oldos (getvar "osmode"))
(setvar "osmode" 0 )
(command ".pline")
(command p)
(repeat sb
(command
(strcat "@0," (rtos (- c (* 2.0 bk))))
(strcat "@" (rtos (- bk nb)) ",0")
"a"
(strcat "@0," (rtos (* 2.0 bk)))
"l"
(strcat "@" (rtos (+ (- nb bk) r)) ",0")))
(command "")
(princ))

 118057_hinh_minh_hoa.jpg

(defun c:BTM (/ p c r sb oldos)
(setq
nb 20.0
bk 10.0
p (getpoint "\nVao diem dau tien: ")
c (getdist p "\nVao chieu cao bac: ")
r (getdist p "\nVao chieu rong bac: ")
sb (getint "\nVao so bac: ")
oldos (getvar "osmode"))
(setvar "osmode" 0 )
(command ".pline")
(command p)
(repeat sb
(command
(strcat "@0," (rtos (- c (* 2.0 bk))))
(strcat "@" (rtos (- bk nb)) ",0")
"a"
(strcat "@0," (rtos (* 2.0 bk)))
"l"
(strcat "@" (rtos (+ (- nb bk) r)) ",0")))
(command "")
 
(defun c:BTM (/ p c r sb oldos)
(setq
nb 20.0
bk 10.0
p (getpoint "\nVao diem dau tien: ")
c (getdist p "\nVao chieu cao bac: ")
r (getdist p "\nVao chieu rong bac: ")
sb (getint "\nVao so bac: ")
oldos (getvar "osmode"))
(setvar "osmode" 0 )
(command ".pline")
(command p)
(repeat sb
(command
(strcat "@0," (rtos (- c (* 2.0 bk))))
(strcat "@" (rtos (- bk nb)) ",0")
"a"
(strcat "@0," (rtos (* 2.0 bk)))
"l"
(strcat "@" (rtos (+ (- nb bk) r)) ",0")))
(command "")
(princ))
(defun c:BTM (/ p c r sb oldos)
(setq
nb 20.0
bk 10.0
p (getpoint "\nVao diem dau tien: ")
c (getdist p "\nVao chieu cao bac: ")
r (getdist p "\nVao chieu rong bac: ")
sb (getint "\nVao so bac: ")
oldos (getvar "osmode"))
(setvar "osmode" 0 )
(command ".pline")
(command p)
(repeat sb
(command
(strcat "@0," (rtos (- c (* 2.0 bk))))
(strcat "@" (rtos (- bk nb)) ",0")
"a"
(strcat "@0," (rtos (* 2.0 bk)))
"l"
(strcat "@" (rtos (+ (- nb bk) r)) ",0")))
(command "")
(princ))

<<

Filename: 239769_btm.lsp
Tác giả: ndtnv
Bài viết gốc: 269217
Tên lệnh: c2e
(Nhờ vả) Lisp chuyển text từ cad sang excel dạng cột!

Em có file cad như đính kèm, bây giờ e muốn dùng lisp để chuyển đổi các text trong bản vẽ sang excel theo dang cột như file excel kèm theo ạ, mong các bác trên diễn đàn giúp đỡ, cám ơn các bác nhiều.

Ps:e có dùng lisp kèm theo nhưng kết quả không được như mong muốn ạ

 

Em có file cad như đính kèm, bây giờ e muốn dùng lisp để chuyển đổi các text trong bản vẽ sang excel theo dang cột như file excel kèm theo ạ, mong các bác trên diễn đàn giúp đỡ, cám ơn các bác nhiều.

Ps:e có dùng lisp kèm theo nhưng kết quả không được như mong muốn ạ

 

http://www.cadviet.com/upfiles/3/61123_11_2.rar

Thử lisp này xem

(defun c:c2e ( / ss lst fuzz fid sosanh)
  (defun sosanh    (e1 e2 / p1 p2)
    (setq p1 (car e1)      p2 (car e2)    )
    (if    (equal (car p1) (car p2) fuzz)
            (> (cadr p1) (cadr p2))
      (< (car p1) (car p2))
    )  )
 (setq   lst        (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "TEXT"))))))
     fuzz    (* (cdr (assoc 40 (entget (car lst)))) 10.0)   
                    lst    (mapcar '(lambda (e) (cons (cdr (assoc 10 (entget e))) (cdr (assoc 1 (entget e))))) lst)   
        lst (vl-sort lst 'sosanh)  
   fid     (open (getfiled "Chon file de save" "" "csv" 1) "w")  )  
  (foreach e lst
        (princ (strcat (cdr e)"\n") fid)              )    
  (close fid))

<<

Filename: 269217_c2e.lsp
Tác giả: gia_bach
Bài viết gốc: 268376
Tên lệnh: test
cần giúp AUTOLISP

Thử Lisp này xem (chỉ áp dụng cho số nguyên)

(defun c:test(/ start end num)
  (setq start 8 end 20)
  (while
    (not
      (and
	(setq num (getint (strcat "Nhap so trong khoang <" (itoa start)  " ~ " (itoa end)">")))
	(< start num end ) ) )
    (princ "\nGia tri khong hop le. Nhap lai! ")    )
  (alert (strcat "Gia tri : " (itoa num) )  )
  (princ))

Filename: 268376_test.lsp
Tác giả: HoaVien
Bài viết gốc: 269472
Tên lệnh: gh
Nhờ sửa lisp xuất toạ độ polyline

Sài tạm Lisp này nhé.

(defun c:gh(/ ent fh fn pnt sset)
  (princ "Chon PLine:" )
  (if (and (setq sset (ssget "_+.:S:E"'((0 . "LWPOLYLINE"))))
	   (setq fn (getfiled "POLYLINE Export File" "" "hdm" 1)))
    (progn      
      (setq fh (open fn "w")
	    ent (entget (ssname sset 0)))
      (princ "BEGIN" fh)
      (foreach rec ent
	(if (= (car rec) 10)
	  (princ (strcat "\n"(rtos (car (setq pnt (cdr rec)))) "," (rtos (cadr pnt)) ) fh) )  )
     ...
>>

Sài tạm Lisp này nhé.

(defun c:gh(/ ent fh fn pnt sset)
  (princ "Chon PLine:" )
  (if (and (setq sset (ssget "_+.:S:E"'((0 . "LWPOLYLINE"))))
	   (setq fn (getfiled "POLYLINE Export File" "" "hdm" 1)))
    (progn      
      (setq fh (open fn "w")
	    ent (entget (ssname sset 0)))
      (princ "BEGIN" fh)
      (foreach rec ent
	(if (= (car rec) 10)
	  (princ (strcat "\n"(rtos (car (setq pnt (cdr rec)))) "," (rtos (cadr pnt)) ) fh) )  )
      (close fh)) )
  (princ))

<<

Filename: 269472_gh.lsp
Tác giả: quangthanhdu
Bài viết gốc: 270043
Tên lệnh: vth
Lệnh cho text chèn nền bản vẽ

Áp dụng cho đối tượng MTEXT nha bạn. Bấm Ctrl+1 hiện bảng Properties, để  thông số Background Mask về "yes" hoặc "no
nha.... nếu làm biếng nữa thì dùng tạm cái Lisp này (tui sưu tầm thôi) hihi

(defun C:vth (/ ss x ob1)

(vl-load-com)

(setq ss (ssget '((0 . "MTEXT"))))

(if ss

(mapcar '(lambda (x)

(setq ob1 (vlax-ename->vla-object x))

(if (= (vla-get-backgroundfill ob1)...
>>

Áp dụng cho đối tượng MTEXT nha bạn. Bấm Ctrl+1 hiện bảng Properties, để  thông số Background Mask về "yes" hoặc "no
nha.... nếu làm biếng nữa thì dùng tạm cái Lisp này (tui sưu tầm thôi) hihi

(defun C:vth (/ ss x ob1)

(vl-load-com)

(setq ss (ssget '((0 . "MTEXT"))))

(if ss

(mapcar '(lambda (x)

(setq ob1 (vlax-ename->vla-object x))

(if (= (vla-get-backgroundfill ob1) :vlax-true)

(vla-put-backgroundfill ob1 :vlax-false)

(vla-put-backgroundfill ob1 :vlax-true)

)

)

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

)
  )
  )


<<

Filename: 270043_vth.lsp

Trang 147/308

147