- page 147

Info

File

Tác giả: hiepttr
Bài viết gốc: 267469
Tên lệnh: a3

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

Download lisp

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

Download lisp

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.

Download lisp

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)
(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,?

Download lisp

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

Download lisp

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

Download lisp

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

Download lisp

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.

Download lisp

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

Download lisp

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

Download lisp

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

Download lisp

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

Download lisp

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

Download lisp

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

Download lisp

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


)

Download lisp

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

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

Download lisp

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

Download lisp

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

Download lisp

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

Download lisp

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

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

)
  )
  )

Download lisp

Filename: 270043_vth.lsp

Trang 147/330