Jump to content
InfoFile
Tác giả: NTD
Bài viết gốc: 208175
Tên lệnh: ha
Lisp chọn đối tượng thì các style của nó hiện hành

;Doan Van Ha - CADViet.com - Ngay 03/4/2012
;Muc dich: Set Curent theo doi tuong chon: Layer, Linetype, Colour, Textstyle (*text) or...
>>

;Doan Van Ha - CADViet.com - Ngay 03/4/2012
;Muc dich: Set Curent theo doi tuong chon: Layer, Linetype, Colour, Textstyle (*text) or Dimstyle (dimension).
(defun C:HA()
(setq lst (entget (car (entsel "\nChon 1 doi tuong Text/Mtext/Dimension de Set Current: "))))
(setvar "CLAYER" (cdr (assoc 8 lst)))				;Layer
(setvar "CELTYPE" (cond ((cdr (assoc 6 lst))) ("BYLAYER")))		;Linetype
(setvar "CECOLOR" (_GetColour lst))				;Colour
(cond							;TextStyle or DimStyle
 ((wcmatch (cdr (assoc 0 lst)) "*TEXT") (setvar "TEXTSTYLE" (cdr (assoc 7 lst))))
 ((wcmatch (cdr (assoc 0 lst)) "DIMENSION") (command "DIMSTYLE" "r" (cdr (assoc 3 lst)))))
(princ))
;-----
(defun _GetColour ( e / c )  
(if (setq c (cdr (assoc 62 e)))    
 (cond
  ((cdr (assoc c '((0 . "ByBlock") (1 . "Red") (2 . "Yellow") (3 . "Green") (4 . "Cyan") (5 . "Blue") (6 . "Magenta") (7 . "White")))))
  ((itoa c)))
 "ByLayer"))

Thanks bác , Lisp hay quá , bác thêm cho trường hợp Linetype Scale đc ko ? . Tức là Global scale factor trong Linetype Manager vẫn ko thay đổi nhưng những đối tượng vẽ ra sau khi dùng Lisp của bác sẽ có Linetype Scale theo đối tượng đc chọn . Cảm ơn bác lần nữa


<<

Filename: 208175_ha.lsp
Tác giả: buratino1703
Bài viết gốc: 9681
Tên lệnh: co
Đánh số thứ tự tăng dần

Lệnh copy thông minh:

Command: co

mình dùng thấy thú vị hơn lệnh Tcount, tuy nhiên mỗi cái có điểm hay riêng.

;;;Edit by...
>>
Lệnh copy thông minh:

Command: co

mình dùng thấy thú vị hơn lệnh Tcount, tuy nhiên mỗi cái có điểm hay riêng.

;;;Edit by Interwar1283
;*********************************************************************
(defun ketthuc ()
(setvar	"cmdecho"	luuecho)
(setq *error*	luu
	luu		nil	
	luuecho	nil
);setq
(princ)
)		
;*********************************************************************
(defun modau ()
(setq 	luu *error
	luuecho	(getvar	"cmdecho")
	*error	(ketthuc)
)
)
;*********************************************************************
(defun xulytext (text / kytu ma sokt luusokt lui )
(setq 	kytu	(substr text (strlen text))
	ma	(ascii kytu)
	sokt	(read kytu) 
	lui	1
)
(if (numberp sokt)
	(progn
		(setq luusokt	(1+ sokt))
		(if (and 	(numberp sokt) 
				(> (strlen text) 1)
		    )	
		   (progn
			(setq 	kytu	(substr text (1- (strlen text)))
					sokt	(read kytu) 
									)
			(if 	(numberp sokt) 
				(setq luusokt (1+	sokt)
						lui 	2

					)
			)
		    );progn	
		)
		(if (= luusokt	100)	(setq 	luusokt	0))
		(setq 	kytu		(rtos luusokt 2 0)

				text	(strcat	(substr text 1 (- (strlen text) lui))  kytu)
		)
	);progn			 
	(if   (or 	(= kytu "z")
			(= kytu "Z")
		)
		(setq 	text		(strcat 	text	"0")
			textxl		"0"
		)
		(setq		ma	(1+	ma)
				text	(strcat	(substr text 1 (1- (strlen text)))  (chr ma))
		)
	);if
);if
)
;*********************************************************************
(defun doitext(tendoituong / chuoi doituong thoat tam dsach kieu text vitri10 vitri11 dem canle)
;Neu doi tuong la text thi tiep tuc
(setq 	doituong 	(entget  tendoituong)
kieu		(cdr (assoc 	0	doituong))
canle		(cdr (assoc 	72	doituong))
)	
(if (or (= kieu		"TEXT")
(= kieu 	"MTEXT")	
   ) 	
(progn
	(setq	textxl	(xulytext textxl)
		text	(cons 1 textxl)
		vitri10 	(cdr (assoc 10 doituong))
		vitri10 	(list (+ (car vitri10) (car vitrilech)) (+ (nth 1 vitri10) (nth 1 vitrilech)))
		vitri10		(cons 10 vitri10)
		vitri11 	(cdr (assoc 11 doituong))
		vitri11 	(list (+ (car vitri11) (car vitrilech)) (+ (nth 1 vitri11) (nth 1 vitrilech)))
		vitri11		(cons 11 vitri11)
		dem	0
		dsach	nil
	)
	(foreach tam 	doituong
		(cond
			((= (car tam)	1)	(setq dsach 	(append dsach (list text))))
			((= (car tam)	10)	(setq dsach 	(append dsach (list vitri10))))
			((= (car tam)	11)	(setq dsach 	(append dsach (list vitri11))))
			((setq dsach 	(append dsach (list tam))))
		)
	)
	(entmake dsach)
);progn
);if
);
;*********************************************************************
;sao doi tuong cu sang vi tri moi

(defun copy_dt (tendoituong )
(command "copy" tendoituong "" goc toi )
);defun

;*********************************************************************
(defun c:co ( / cumdt dodai thoat dem ten doituong textxl dem goc toi)
; Khoi dau cua chuong trinh
(princ "\nCopy Inteligent...\n")
(setq 	luuecho	(getvar	"cmdecho")
luu	*error*
*error*	ketthuc
cumdt 	(ssget)
dodai 	(sslength cumdt)
goc		(getpoint "\nSelect base point:")
thoat		nil
dem		0
textxl		nil
);
(setvar "cmdecho" 0)
; Loc ra duoc ong text de xu ly
(while	(and 	(= thoat	nil)
	(< dem	dodai)
)
(setq 	ten	(ssname cumdt dem)
	dem	(1+ 	dem)
	doituong (entget ten)
	kieu	 (cdr (assoc 	0	doituong))			
)

(if (or (= kieu		"TEXT")
	(= kieu 	"MTEXT")	
   	    )
	(setq 	thoat	T
		textxl 	(cdr (assoc 1 doituong)) 	
	)
)
);
(while T 
(setq	toi		(getpoint "\nSelect next point: " goc)
vitrilech 	(list 	(- (car toi) (car goc)) (- (nth 1 toi) (nth 1 goc)))
dem		0
)
(while	(< dem dodai)
(setq 	ten	(ssname cumdt dem)
	dem	(1+ 	dem)
	doituong (entget ten)
	kieu	 (cdr (assoc 	0	doituong))			
)

(if (or (= kieu		"TEXT")
	(= kieu 	"MTEXT")	
   	    )
	(doitext	ten)
	(copy_dt	ten)

);if
)
);while
(ketthuc)
);defun
(princ "Type \"DG\" to start")
;Note: bien toan cuc: textxl vitrilech

Lệnh của bác đến 100 thì die, vì khi đánh số đến 101 thì nó hiện 1, 102 hiện 2(quay vòng)! Khắc phục bằng cách nào vậy bác?


<<

Filename: 9681_co.lsp
Tác giả: trieubb
Bài viết gốc: 267103
Tên lệnh: ha
(Yêu cầu) Lisp cộng một số không đổi vào lý trình khi thiết kế đườn

 

Thử cái này xem đã đúng ý chưa.

;Doan Van Ha - CADViet.com - Ngay 02/4/2012
;Muc dich:...
>>

 

Thử cái này xem đã đúng ý chưa.

;Doan Van Ha - CADViet.com - Ngay 02/4/2012
;Muc dich: tang/giam nhieu ly trinh voi cung 1 gia tri (VD ky hieu ly trinh: "Km:0+00.00", can tang 100.00)
;So chu so le phu thuoc ket qua.
(defun C:HA( / entlst tang)
 (princ "\nChon cac Text ly trinh can tang/giam...")
 (setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "*TEXT") (1 . "Km:*")))))))
 (setq tang (getreal "\nNhap gia tri (met) tang/giam: "))
 (foreach ent entlst
  (entmod (subst (cons 1 (HA (cdr (assoc 1 (entget ent))) tang)) (assoc 1 (entget ent)) (entget ent))))
 (princ))
;----- VD: txtcu = "Km:0+20.32" ; tang = 100.00
(defun HA(txtcu tang / trai phai txtmoi)
 (setq somoi (+ (* (atoi (TRAI_STR (substr txtcu 4) "+")) 1000) (atof (PHAI_STR (substr txtcu 4) "+")) tang))
 (setq trai (fix (/ somoi 1000.0)))
 (setq phai (- somoi (* trai 1000)))
 (strcat "Km:" (itoa trai) "+" (if (= phai (atoi (rtos phai 2 0))) (rtos phai 2 0) (rtos phai 2 2))))
(defun TRAI_STR(str str1) (if (acet-str-find str1 str) (substr str 1 (- (acet-str-find str1 str) 1))))
(defun PHAI_STR(str str1) (if (TRAI_STR str str1) (substr str (+ 1 (strlen str1) (strlen (TRAI_STR str str1))))))

Lisp hay nhưng bác xem lại có 1 lỗi như sau: VD Km:1+5.45 cộng vào 5m nữa kết quả thành Km:0+10.45

Thứ hai là bác có thể sửa cái chữ số m ấy lúc nào cũng là 3 số VD Km:1+5.45 thành Km:1+005.45


<<

Filename: 267103_ha.lsp
Tác giả: gia_bach
Bài viết gốc: 25764
Tên lệnh: xsc
Scale đối tượng một chiều
Đây là đọan code scale đối tượng một chiều

Lệnh là XSC hoặc XSCALE

 

;Scale the mot chieu
(DEFUN EXCUTE()
..................
 (setq P0...
>>
Đây là đọan code scale đối tượng một chiều

Lệnh là XSC hoặc XSCALE

 

;Scale the mot chieu
(DEFUN EXCUTE()
..................
 (setq P0 (getpoint "\nChon diem goc: "))
 (initget 1 "X Y X S")
 (setq C (getkword "\nScale theo ? :"))
 (setq hs (getreal "Cho biet he so scale: "))
 (DELBLOCK "vkc_temp")
 (CREATEBLOCK ss P0)  
 (Command "-Insert" "vkc_temp" C hs P0 "")   
 (setq dt (entlast))
 (Command "Explode" dt)
 (setvar "CMDECHO" oldvalue)
 (princ)
)
........

(DEFUN DELBLOCK (bname)
 (if (IsExistBlock bname)
(Command "-Purge" "B" bname "Y" "Y")	
 )
)
..............
(DEFUN C:XSC()
 (CREALIBLK)
 (EXCUTE)
)

 

Trường hợp trên bản vẽ có Block name vkc_temp thì hàm DELBLOCK sẽ không có tác dụng--> báo lỗi,

do đó Vndesperados nên đặt tên Block theo cách khác.


<<

Filename: 25764_xsc.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 183525
Tên lệnh: lbhg
Lisp thống kê cao độ ga và cống

Bác bach1212 có cái lisp lập bảng tọa độ ngon rùi, nên mình mượn...

>>

Bác bach1212 có cái lisp lập bảng tọa độ ngon rùi, nên mình mượn lại biến tấu chút thì cái vụ nhập hố ga của bạn cũng tạm ổn rùi đấy

Bạn chạy lại bằng code lisp này xem nhé.

Nếu bảng chưa đẹp, đúng như bác phamthanhbinh nói, nên thêm mắm muối vào nữa cho vừa khẩu vị từng người.

Lưu ý rằng: free code lisp from CADViet - em chỉ xào nấu chút thui


: Ha Van Khanh 3/2003
;
; * Chuong trinh duoc lap bang ngon ngu AUTOLISP.
; Free lisp code from CADViet - Edit by mathan
; ------------------------------------------------------------------------------
(vmon)
(defun C:LBHG (/ 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.5" "" "" "" "" "")
(command "-Layer" "n" "Text" "c" "4" "Text" "")
 (setq p1 (getpoint "\nChon diem dat bang thong ke :"))
 (setq S (getint "\nSo ho ga can thong ke:"))
(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"  "Ten Ga"  )
(command "text" "j" "mc"  p15 "0"  "Cao do" )
(command "text" "j" "mc"  p16 "0"  "D" )
(command "text" "j" "mc"  p17 "0"  "Y" )
(setvar "osmode" 1)
;-------------------------------------------------
; Phan chinh
(prompt "\nBan can pick tung text theo thu tu Ten ho ga; cao do dinh va cao do day ga: ")
(setq b 0)
(while (< b s )
(setq b (+ b 1))
(setq ss (car (entsel "\nDS> Ten ho ga: ")))
(setq tenga (cdr (assoc 1 (entget ss))))
(setq ss (car (entsel "\nDS> Cao do dinh: ")))
(setq cddinh (cdr (assoc 1 (entget ss))))
(setq ss (car (entsel "\nDS> Cao do day: ")))
(setq cdday (cdr (assoc 1 (entget ss))))
(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"  tenga "" )
(command "text" "j" "mc"  a3  "0"  cddinh "" )
(command "text" "j" "mc"  a2  "0"  cdday "" )
)
)

Bác bach1212 dùng vui vẻ nhé.

Tiện thể cho e mượn code em đồ thêm mấy cái lisp khác nha.

Thank all

Hề hề hề,

Bác cho hỏi là cái hàm (vmon) dùng làm cái chi vậy ạ????


<<

Filename: 183525_lbhg.lsp
Tác giả: hugo007
Bài viết gốc: 164066
Tên lệnh: cdt
Lisp cắt đối tượng

Bạn dùng thử cái này xem nhé.

(defun C:CDT( / sl dt giao )
(setq oldos (getvar "osmode") oldcm (getvar...
>>

Bạn dùng thử cái này xem nhé.

(defun C:CDT( / sl dt giao )
(setq oldos (getvar "osmode") oldcm (getvar "cmdecho"))
(setvar "osmode" 0) (setvar "cmdecho" 0)
(princ "Chon cac Line can cat: ")
(setq sl (acet-ss-to-list (ssget '((0 . "LINE")))))
(setq dt (entsel "Chon Line cat: "))
(foreach n sl
 (setq giao (inters (cdr (assoc 10 (entget n))) (cdr (assoc 11 (entget n))) (cdr (assoc 10 (entget (car dt)))) (cdr (assoc 11 (entget (car dt))))))
 (command "break" n  giao giao))
(setvar "osmode" oldos) 
(setvar "cmdecho" oldcm)
(princ))
(princ "Lenh cat doi tuong: CDT")

Đường polyline không cắt được sao bạn?Nhờ bạn sửa cho chọn được nhiều line cắt,sau khi cắt xong các đoạn thẳng vừa mới bị cắt ra,đoạn ngắn nhất thì sẽ bị xoá đi.Thanks.


<<

Filename: 164066_cdt.lsp
Tác giả: Hai_YenLang
Bài viết gốc: 196968
Tên lệnh: tl
viết lisp tính chiều dài đường ống nước

Còn một cái mơ hồ mơ hồ chưa rõ ràng nữa là đường ống tổng chính, tổng phụ, và các nhánh chia về các hộ gia đình phải có tiết diện to nhỏ khác nhau. Tính gộp cả tổng chiều dài hổ lốn các đoạn ống có tiết diện khác nhau như thế, chả hiểu có ý nghĩa gì về mặt thống kê?

- Có thể chia từng nhánh thành các layer khác nhau để tính tổng cho từng loại

- Khóa layer các...

>>

Còn một cái mơ hồ mơ hồ chưa rõ ràng nữa là đường ống tổng chính, tổng phụ, và các nhánh chia về các hộ gia đình phải có tiết diện to nhỏ khác nhau. Tính gộp cả tổng chiều dài hổ lốn các đoạn ống có tiết diện khác nhau như thế, chả hiểu có ý nghĩa gì về mặt thống kê?

- Có thể chia từng nhánh thành các layer khác nhau để tính tổng cho từng loại

- Khóa layer các đường ống, chỉ để lại layer text , sử dụng lệnh Li có thể biết được tổng số hộ.

- Bạn thử tham khảo các lisp sau:

 

Lisp tính tổng chiều dài của mọi đối tượng có thuộc tính chiều dài (line, pline, spline, arc, circle, ellipse). Lệnh TL:

 

;;;--------------------------------------------------------------------(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)));;;--------------------------------------------------------------------(defun C:TL( / ss L e)(setq    ss (ssget  (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))    L 0.0)(vl-load-com)(while (setq e (ssname ss 0))    (setq L (+ L (length1 e)))    (ssdel e ss))(alert (strcat "Total length = " (rtos L))));;;--------------------------------------------------------------------

 

Mặc dù bài viết này đã lâu rồi nhưng mình vẫn trả lời (biết đâu có người cần dùng).

Lisp Lencal sau đây có thể tính tổng chiều dài các loại đường trong một bản vẽ theo cùng layer, cùng loại nét hay cùng màu sắc.

http://www.cadviet.c.../lencal_v17.lsp

(lệnh: lencal)

Tác giả: Lee Mac. Nguồn: CadTutor


<<

Filename: 196968_tl.lsp
Tác giả: thong_kt
Bài viết gốc: 62755
Tên lệnh: sct
Cách scale nhiều đối tượng một lúc?
Tue_NV đồng ý với ý kiến của anh Duy782006.

Đây là lisp scale tất cả đường tròn cùng một lúc nhưng có tâm scale là tâm của từng đường tròn

>>
Tue_NV đồng ý với ý kiến của anh Duy782006.

Đây là lisp scale tất cả đường tròn cùng một lúc nhưng có tâm scale là tâm của từng đường tròn

(defun c:SCT(/ ci tl n i)
(prompt "\n Moi ban chon CIRCLE")
(setq ci (ssget '((0 . "CIRCLE"))))
(setq tl (getreal "\n Nhap ti le scale :") n (sslength ci) i 0)

(while (< i n)
(setq ent (ssname ci i))
(command "scale" ent "" (cdr(assoc 10 (entget ent))) tl)
(setq i (1+ i))
)
(princ)
)

:s_big:

Cảm ơn anh. Với text thì em đã thấy lisp scale tại điểm chèn của text rùi. Với block thì việc scale là đơn giản. Em muôn hỏi với một hình bất kỳ. Nếu là hình scale nhiều hình chữ nhật, wipeout một lúc. Tâm scale tại điểm pick chuột trên cạnh của hình chữ nhật. Cũng giống như với hình tròn nhưng giơ tâm scale là điểm pick chuột trên cạnh hình chữ nhật hay một điểm lằm bên cạnh hình chữ nhật. Mong anh giúp đỡ.


<<

Filename: 62755_sct.lsp
Tác giả: Tue_NV
Bài viết gốc: 106409
Tên lệnh: tichso
Viết lisp theo yêu cầu [phần 2]
hề hề, làm gì mà bác nóng tính thế. em up cái hình lên đây, hy vọng biểu đạt được ý nguyện của mình

thực ra mình cũng đã viết 1 lisp để làm công việc nhân...

>>
hề hề, làm gì mà bác nóng tính thế. em up cái hình lên đây, hy vọng biểu đạt được ý nguyện của mình

thực ra mình cũng đã viết 1 lisp để làm công việc nhân nhiều số với 1 số, nhưng nó vẫn còn 1 số hạn chế :

chưa áp dụng được cho số thực ( mình cũng đã chỉnh lại kiểu dữ liệu nhập vào là với số thực, nhưng chẳng hiểu sao lúc được lúc không, lúc lại cho ra KQ ko đúng)

nếu tích số nhận xong là số nguyên, nó không có ".0"

 

(defun c:tichso()
 (setq i (getint "\n Enter number to calculate :"))
 (prompt "Select objects:")
 (setq ss (ssget))
 (setq cnt 0)
  (progn
  (repeat (sslength ss)
(setq ent (entget (ssname ss cnt)))
(setq nd1 (cdr (assoc 1 ent)))
(setq nd2 (distof nd1))
(setq nd3 (/ nd2 i))
(setq nd4 (rtos nd3 2 1))
(setq nd nd4)
(setq ent (subst (cons 1 (strcat nd)) (assoc 1 ent) ent))
(entmod ent)
(setq cnt (1+ cnt))
   )
  )
 )

1. Bạn đã thử chức năng tìm kiếm của diễn đàn chưa? Hãy Tìm kiếm với từ khoá Nhan 2 cot so

->> nên sử dụng Table của CAD hơn là phải sử dụng Text như thế. Mình chỉ sử dụng Lisp này để kiểm tra lại mấy anh sử dụng Text để thống kê, chứ tuyệt đối không dùng Text để nhân 2 cột số vì nó không ưu điểm bằng Table của ACAD

 

2. Theo ý của bạn master_worse. hoặc sử dụng Lisp này của Tue_NV :

Chương trình tính toán Cộng trừ Nhân Chia giá trị của Block Attribute; Text với 1 số hoặc 1 biểu thức

Chương trình cũng có tính năng làm tròn số tới một số nào đó do User định trước


<<

Filename: 106409_tichso.lsp
Tác giả: kloud7
Bài viết gốc: 195239
Tên lệnh: ha
Lisp chọn đối tượng thì các style của nó hiện hành

;Doan Van Ha - CADViet.com - Ngay 03/4/2012
;Muc dich: Set Curent theo doi tuong chon: Layer, Linetype, Colour, Textstyle (*text) or...
>>

;Doan Van Ha - CADViet.com - Ngay 03/4/2012
;Muc dich: Set Curent theo doi tuong chon: Layer, Linetype, Colour, Textstyle (*text) or Dimstyle (dimension).
(defun C:HA()
(setq lst (entget (car (entsel "\nChon 1 doi tuong Text/Mtext/Dimension de Set Current: "))))
(setvar "CLAYER" (cdr (assoc 8 lst)))				;Layer
(setvar "CELTYPE" (cond ((cdr (assoc 6 lst))) ("BYLAYER")))		;Linetype
(setvar "CECOLOR" (_GetColour lst))				;Colour
(cond							;TextStyle or DimStyle
 ((wcmatch (cdr (assoc 0 lst)) "*TEXT") (setvar "TEXTSTYLE" (cdr (assoc 7 lst))))
 ((wcmatch (cdr (assoc 0 lst)) "DIMENSION") (command "DIMSTYLE" "r" (cdr (assoc 3 lst)))))
(princ))
;-----
(defun _GetColour ( e / c )  
(if (setq c (cdr (assoc 62 e)))    
 (cond
  ((cdr (assoc c '((0 . "ByBlock") (1 . "Red") (2 . "Yellow") (3 . "Green") (4 . "Cyan") (5 . "Blue") (6 . "Magenta") (7 . "White")))))
  ((itoa c)))
 "ByLayer"))

 

Thks bác, cái này mà bản vẽ nhiều dim nhiều linetype thì tiện phải biết cheer !!


<<

Filename: 195239_ha.lsp
Tác giả: kimvantoan
Bài viết gốc: 229850
Tên lệnh: ca
Lisp kết hợp lệnh Array và Copy

 

Rất cảm ơn Ketxu đã có 1 số góp ý để Lisp được hoàn thiện hơn.

Lệnh này Copy_Array các đối tượng, kể...

>>

 

Rất cảm ơn Ketxu đã có 1 số góp ý để Lisp được hoàn thiện hơn.

Lệnh này Copy_Array các đối tượng, kể cả Text (Mtext). Riêng Text chứa số thì có thể tăng/giảm theo gia số, nó chấp nhận cả số có tiền và/hoặc hậu tố.

Nếu có nhiều Text số được chọn thì chỉ 1 Text số chọn sau cùng được tăng/giảm. Số chữ số thập phân (nếu có) sẽ lấy theo Text chọn.

; Doan Van Ha CADViet.com
; Copy-Array cac doi tuong ke ca Text (Mtext), rieng Text co chua so thi tang giam theo gia so, chap nhan so co tien to va hau to.
; Neu co nhieu Text chua so duoc chon thi chi 1 Text chon sau cung duoc tang/giam. So chu so thap phan (neu co) lay theo Text chon.
; P/S (01-03-2012): bo sung them so chu so 0 dau num de phu hop voi text mau. VD: "CN: 01" tang thanh "CN: 02"...
(defun C:CA (/ dsdt dt dt1 dt2 p1 p2 sl x kwrd strt strp num sym ds daup giaso)
 (vl-load-com)
 (command "undo" "be")
 (setq osm (getvar "osmode") cmd (getvar "cmdecho"))
 (princ "\nChon cac doi tuong can Copy-Array...")
 (setq dsdt (vl-remove-if 'listp (mapcar 'cadr (ssnamex (setq dt (ssget)))))
       	dt1 dt p1 (getpoint "\nDiem goc: ") p2 (getpoint p1 "\nDiem den: ") sl (getint "\nSo lan: ") x 1)
 (setvar "osmode" 0) (setvar "cmdecho" 0)
 (foreach n dsdt
  (if (or (= "TEXT" (cdr (assoc 0 (entget n)))) (= "MTEXT" (cdr (assoc 0 (entget n)))))
   (if (KT_NUM (cdr (assoc 1 (entget n))))
	(setq dt2 n))))
 (if dt2 (setq dt1 (ssdel dt2 dt)))
 (if dt2
  (progn
   (initget "Y N")
   (setq kwrd (getkword "\nBan muon Text tang dan ?   ") giaso (getreal "\nGia so: "))
   (setq x 1)
   (repeat (1- sl)
	(command ".copy" dt2 "" p1 (polar p1 (angle p1 p2) (* (distance p1 p2) x)))
	(if (eq kwrd "Y")
 	(progn
  	(CHIA3 (cdr (assoc 1 (entget dt2))))
  	(setq daup (if (not (vl-string-search "." (cadr ds))) 0 (- (strlen (cadr ds)) (vl-string-search "." (cadr ds)) 1)))
  	(entmod (subst (cons 1 (strcat (car ds) (THEM0 (cadr ds) (rtos (+ (atof (cadr ds)) (* x giaso)) 2 daup)) (caddr ds))) (assoc 1 (entget (entlast))) (entget (entlast))))
  	(entupd (entlast))))
	(setq x (1+ x)))))
 (if dt1
  (progn
   (setq x 1)
   (repeat (1- sl)
	(command ".copy" dt1 "" p1 (polar p1 (angle p1 p2) (* (distance p1 p2) x)))
	(setq x (1+ x)))))
 (command "undo" "e")
 (setvar "osmode" osm) (setvar "cmdecho" cmd)
 (princ))
;----- Chia text ra tiento_num_hauto.
(defun CHIA3 (str / trai phai lstt lstn)
 (setq lstt (vl-string->list str) lstn (reverse lstt))
 (while lstt
  (cond ((or (< (car lstt) 48) (> (car lstt) 57)) (setq trai (cons (car lstt) trai) lstt (cdr lstt)))
         	(T (setq lstt nil))))
 (while lstn
  (cond ((or (< (car lstn) 48) (> (car lstn) 57)) (setq phai (cons (car lstn) phai) lstn (cdr lstn)))
         	(T (setq lstn nil))))
 (setq ds (list (vl-list->string (reverse trai))
                    	(if (= (strlen str) (strlen (vl-list->string (reverse trai)))) "" (vl-string-right-trim (vl-list->string phai) (vl-string-left-trim (vl-list->string trai) str)))
                    	(if (= (strlen str) (strlen (vl-list->string (reverse trai)))) "" (vl-list->string phai)))))
;----- Kiem tra 1 text co chua num hay khong?
(defun KT_NUM(str / ds kt)
 (foreach n (vl-string->list str)
  (if (and (>= n 48) (<= n 57)) (setq kt T)))
 kt)
 ;----- Thong ke so chu so truoc dau thap phan.
(defun KT_FIX(str / m)
 (setq m 0)
 (while (and (> (strlen str) 0) (/= (substr str 1 1) "."))
  (setq m (1+ m) str (substr str 2)))
 m)
;----- Them so chu so 0 vao dau text cho phu hop.
(defun THEM0(strt strs)
 (while (> (- (KT_FIX strt) (KT_FIX strs)) 0)
  (setq strs (strcat "0" strs)))
 strs)
P/S: sửa 07/02/2012 để không còn dùng các hàm Acet.

P/S: sửa 01/03/2012 để thêm số chữ số 0 vào đầu Num của Text để phù hợp với Text gốc.

Chào bác Doan Van Ha! Không biết bác có còn theo dõi topic này nữa không. Nếu bác còn theo dõi thì giải quyết giúp tôi vấn đề này với. Tôi đã dowload lisp của bác về dùng. Lisp dùng rất hay và đáp ứng được nhu cầu sử dụng của tôi. Nhưng tôi muốn thay đổi việc "nhập hai điểm đầu tiên là khoảng cách các text và nhập số lần là số text cần copy" bằng việc "nhập hai điểm đầu tiên là khoảng mà text sẽ copy(ví dụ trong khoảng 100m) và chọn hai điểm tiếp theo để lấy khoảng cách giữa hai text(ví dụ là 1m). Tôi thấy làm như thế thì sẽ tiện hơn khi sử dụng(theo tôi là như vậy). Tôi có sưu tầm được một lisp copy và array như thế, nhưng nó không tăng được số. Đây là lisp tôi đang sử dụng http://www.cadviet.com/upfiles/3/67165_copyarray.lsp

Rất cám ơn bác về lisp của bác!


<<

Filename: 229850_ca.lsp
Tác giả: quanvuong
Bài viết gốc: 50119
Tên lệnh: od oc
Đánh số thứ tự tăng dần
Bạn dùng thử chương trình sau. Có 2 lệnh:

1) Lệnh OD: Ordinate number with any format. Đánh số thứ tự với bất kỳ định dạng nào: số, chữ, chữ và số. Ví dụ:

Command:...

>>
Bạn dùng thử chương trình sau. Có 2 lệnh:

1) Lệnh OD: Ordinate number with any format. Đánh số thứ tự với bất kỳ định dạng nào: số, chữ, chữ và số. Ví dụ:

Command: od

Begin at <1>: HTT-01-03. Nếu không nhập số, bấm Enter sẽ mặc định từ 1

Increment <1>: 3. Nếu không nhập số, bấm Enter sẽ lấy mặc định là 1

Base point <exit>: chỉ điểm -> HTT-01-03

Base point <exit>: chỉ điểm -> HTT-01-06

Base point <exit>: chỉ điểm -> HTT-01-09

.........

Đến khi... chán thì:

Base point <exit>: Enter -> Thoát

 

2) Lệnh OC: Ordinate number, Copy from template. Đánh số thứ tự bằng cách copy mẫu có sẵn. Hoạt động giống như trên, nhưng thay vì "Begin at" thì chọn một mẫu có sẵn và 1 điểm tham chiếu làm chuẩn (tương tự như trình của bạn Lê Huy Hà nhưng có thêm tính năng tùy chọn Increment theo ý bạn).

Các bạn dùng nếu thấy có gì bất ổn thì phản hồi để mình sửa.

 

;;;------------------------------------------------------------------------------------
(defun getTw() ;;;Get textstyle
(cdr (assoc 41 (tblsearch "style" (getvar "textstyle"))))
)
;;;------------------------------------------------------------------------------------
(defun getTh( / Th) ;;;Get textheight or textsize
(if (= (setq Th (cdr (assoc 40 (tblsearch "style" (getvar "textstyle"))))) 0) (getvar "textsize") Th)
)
;;;------------------------------------------------------------------------------------
(defun emkT (S p) ;;;Entmake text S at p
(entmake (list (cons 0 "TEXT") (cons 10 p) (cons 40 (getTh))
    (cons 41 (getTw)) (cons 1 S) (cons 7 (getvar "textstyle"))))
)
;;;------------------------------------------------------------------------------------
(defun incN (n dn / n2 i n1) ;;;Increase number n
(setq
   n2 (itoa (+ dn (atoi n)))
   i (- (strlen n) (strlen n2))
)
(if (> i 0) (setq n1 (substr n 1 i)) (setq n1 ""))
(strcat n1 n2)
)
;;;------------------------------------------------------------------------------------
(defun incC (c / i c1 c2) ;;;Increase character c
(setq
   i (strlen c)
   c1 (substr c 1 (- i 1))
   c2 (chr (1+ (ascii (substr c i 1))))
)
(if (or (= c2 "{") (= c2 "["))
   (progn (command "erase" (entlast) "") (alert "Over character!") (exit))
   (strcat c1 c2)
)
)
;;;==============================================
(defun C:OD( / cn dn c n p) ;;;Make OrDinal number with any format
(setq
   cn (getstring "\nBegin at <1>: " T)
   dn (getint "\nIncrement <1>: ")
)
(if (not dn) (setq dn 1))
(if (= cn "") (setq cn "1"))
(setq c (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" cn))
(setq n (vl-string-subst "" c cn))
(if (/= n "") (setq mode 1) (setq mode 0))
(while (setq p (getpoint "\nBase point <exit>: "))
   (emkT cn p)
   (if (= n "") 
       (setq cn (incC cn))
       (setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))        
   )
)
(princ)
)
;;;==============================================
(defun C:OC( / e dn p1 cn c n p2 dat) ;;;Make Ordinal number. Copy from template
(setq
   e (car (entsel "\nSelect template text:"))
   dn (getint "\nIncrement <1>: ")
   p1 (getpoint "\nBase point:")
   cn (cdr (assoc 1 (entget e)))
)
(if (not dn) (setq dn 1))
(if (= cn "") (setq cn "1"))
(setq
   c (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" cn)
   n (vl-string-subst "" c cn)
)
(while (setq p2 (getpoint p1 "\nNew point <exit>: "))
   (command "copy" e "" p1 p2)
   (if (= n "") 
       (setq cn (incC cn))
       (setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))        
   )
   (setq
       dat (entget (entlast))
       dat (subst (cons 1 cn) (assoc 1 dat) dat)
   )
   (entmod dat)    
)
(princ)
)
;;;==============================================

 

Qúa tuyệt với. Mình thường xuyên phải đánh số thứ tự trong cad. Cảm ơn bạn rát nhiều nhé


<<

Filename: 50119_od_oc.lsp
Tác giả: intelligent
Bài viết gốc: 269057
Tên lệnh: tm
Lisp đánh số trang trong AutoCAD

 

Đoạn mã dưới đây tôi đã ghép thêm tổng số trang vào cuối của hàm strcat (chỗ tô màu đỏ).

>>

 

Đoạn mã dưới đây tôi đã ghép thêm tổng số trang vào cuối của hàm strcat (chỗ tô màu đỏ).

(DEFUN intro()(textscr)(prompt "\n Write by NGUYEN DUONG HUY - CCIC HA NOI ")(prompt "\n Ha Noi 24 -12-2005"))(intro)(defun c:tm (/ pt1 dst dir hn nn ctk te m)(setvar "cmdecho" 0 )(command ".-style" "huy" ".VnArialH" "" "" "" "" "")(command "-layer" "n" "KHUNG " "colour" "W" "KHUNG " "")(command "-layer" "s" "KHUNG" "" "")(setq pt1 (getpoint "\n Diem bat dau so thu nhat :")dst (getdist "\n Khoang cach giua cac so :")dir (getorient "\n Goc quay cua day so lieu : ")hn (getint "\n So to :"))(prompt "\n Gia tri dau tien <1>:")(setq nn (getreal))(if (null nn)(setq nn 10))(prompt "\nNhap chenh lech<1>:")(setq ctk (getreal))(if (null ctk)(setq ctk 1))(prompt "\n chieu cao chu :<1.5>")(setq m (getreal))(if (null m)(setq m 1.5))(command "text" "c" pt1 m 0 (strcat "to so " (rtos nn 2 0) <strong class='bbc'>"/" (itoa hn)</strong>))(repeat hn(setq pt1 (polar pt1 dir dst))(command "text" "c" pt1 m 0 (strcat "to so " (rtos (setq nn (+ nn ctk)) 2 0) <strong class='bbc'>"/" (itoa hn)</strong>))))

Cảm ơn anh Nguyen Hoanh đã chia sẻ để anh em khăp mọi miền tổ quốc,nâng cao trình độ chuyên muôn, nghiệp vụ!


<<

Filename: 269057_tm.lsp
Tác giả: envirtech2002
Bài viết gốc: 245155
Tên lệnh: ibi
Cần tìm Lisp chèn block tại các điểm giao nhau(intersection)

 

Bạn thử cái này có đúng ý bạn không

(defun LM:IntersectionsinSet ( ss / a b i j l )
 ...
>>

 

Bạn thử cái này có đúng ý bạn không

(defun LM:IntersectionsinSet ( ss / a b i j l )
  (setq i (sslength ss))
  (while (not (minusp (setq j (1- i) i (1- i))))
	(setq a (vlax-ename->vla-object (ssname ss i)))
	(while (not (minusp (setq j (1- j))))
  	(setq b (vlax-ename->vla-object (ssname ss j))
        	l (cons (LM:GroupByNum (vlax-invoke a 'IntersectWith b acExtendNone) 3) l)
  	)
	)
  )
  (apply 'append l)
)
(defun LM:GroupByNum ( l n / r)
  (if l
	(cons
  	(reverse (repeat n (setq r (cons (car l) r) l (cdr l)) r))
  	(LM:GroupByNum l n)
	)
  )
)
(defun dxf (code e) (cdr (assoc code (entget e))))
(defun C:ibi(/ os ss lst en pt item)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(princ "\n Chon cac doi tuong giao nhau")
(setq
  ss (ssget)
  lst (LM:IntersectionsinSet ss)
  en (car (entsel "\nChon Block"))
  pt (dxf 10 en)
)
(foreach item lst
  (command "copy" en "" pt item)
)
(setvar "osmode" os)
)

Cái này hay quá bác ah, tks bác :D


<<

Filename: 245155_ibi.lsp
Tác giả: tien2005
Bài viết gốc: 421369
Tên lệnh: ed
- Tự động bật - tắt chế độ gõ tiếng việt trong CAD

Trên cơ sở version 3.0 của ThuyLinh313 mình viết lại hổ trợ cho autocad2007

;;; Tu dong bat/tat go Tieng Viet trong autocad
;;; Ho tro cho autocad 2007, duoc viet  tren co so lisp cua ThuyLinh313 tai
;;; http://www.cadviet.com/forum/topic/66851-da-xong-tu-dong-bat-tat-che-do-go-tieng-viet-trong-cad/page-3


(vl-load-com)
(setq switch 0)
(if (= switch 0)
  (setq switchkey "%{z}"); Alt + Z
 ...
>>

Trên cơ sở version 3.0 của ThuyLinh313 mình viết lại hổ trợ cho autocad2007

;;; Tu dong bat/tat go Tieng Viet trong autocad
;;; Ho tro cho autocad 2007, duoc viet  tren co so lisp cua ThuyLinh313 tai
;;; http://www.cadviet.com/forum/topic/66851-da-xong-tu-dong-bat-tat-che-do-go-tieng-viet-trong-cad/page-3


(vl-load-com)
(setq switch 0)
(if (= switch 0)
  (setq switchkey "%{z}"); Alt + Z
  (setq switchkey "^+"); Ctrl + Shift - trung voi phim nong saveas "Ctrl + Shift + s"
  )
(setq lscmd "DDEDIT,MTEDIT,TEXTEDIT,EATTEDIT")
;;;(setq lstyp "TEXT,MTEXT,DIMENSION,INSERT,ATTRIB,ATTDEF")
(setq *acdver* (atof (substr (getvar "ACADVER") 1 4)))
(cond
  ((>= *acdver* 21.0)(setq com1 "_textedit")); 21.0-acad2017
  ((<= *acdver* 19.0)(setq com1 "_ddedit")); 19.0- ACAD2013 lower
  (t(ALERT(strcat"Phien ban AutoCad hien tai la "(substr (getvar "ACADVER") 1 4) "\nChua duoc khai bao")))
  )

(if (= hyp-rctCmds nil)
  ; Add the command reactors and the custom callbacks
  (setq hyp-rctCmds (vlr-command-reactor nil '((:vlr-commandCancelled . hyp-cmdAbort)
					       (:vlr-commandEnded . hyp-cmdAbort)
					       (:vlr-commandCancelled . hyp-cmdAbort)
					       (:vlr-commandWillStart . hyp-cmdStart)
					      )
		    )
  )
)
(foreach x (cdar (vlr-reactors :vlr-mouse-reactor))
(if (= (vlr-data x) "Double-Click") (vlr-remove x)))
(vlr-mouse-reactor   "Double-Click" '((:vlr-beginDoubleClick . callback-DoubleClick)))


;========================================MAIN============================================


(defun c:ed (/ textmod	n-textmod ent n-ent obj n-obj l-obj font code)
  (and (or (and	(setq textmod (ssget "I"))
		(sssetfirst textmod)
		(setq obj (ssname textmod 0))
	   )
	   (setq textmod (entsel)
		 obj	  (car textmod)
	   )
       )
       (while obj
	 (setq ent (cdr (assoc 0 (entget obj))))
	 (cond
	   ((wcmatch ent "TEXT,MTEXT,ATTDEF") ;Text,Mtext,ATTDEF
	    (setq font (cdr (assoc 7 (entget obj))))
	    (vl-cmdf com1 textmod "")
	   )
	   ((= ent "DIMENSION")		;Dimension
	    (setq font (vla-get-textstyle (vlax-ename->vla-object obj)))
	    (vl-cmdf com1 textmod "")
	   )
	   ((= ent "HATCH")		;Hatch
	    (initdia)
	    (vl-cmdf "_hatchedit" textmod)
	   )
	   ((= ent "INSERT")		;Block
	    (and
	      (eq (type textmod) 'LIST)
	      (setq n-textmod (nentselp (cadr textmod)))
	      (setq n-obj (car n-textmod))
	      (setq n-ent (entget n-obj))
	      (setq n-obj (vlax-ename->vla-object n-obj))
	      (cond
		((= (cdr (assoc 0 n-ent)) "ATTRIB") ; Attribute
		 (setq font (cdr (assoc 7 n-ent)))
;;;		 (setq code (check-font-code (cdr (assoc 7 n-ent))))
;;;		 (if (eq (vla-get-mtextattribute n-obj) :vlax-false)	;ho tro tu acad2008
;;;		   (progn
;;;		     (setq dk nil
;;;			   dk (sendkeys switchkey)
;;;		     )
;;;		     (cond ((= code "TCVN3") (sendkeys "^+{F2}"))
;;;			   ((= code "UNICODE") (sendkeys "^+{F1}"))
;;;			   ((= code "VNI") (sendkeys "^+{F3}"))
;;;		     )
;;;		   )
;;;		 )

		 (vl-cmdf "_eattedit" textmod)
;;;		 (if dk
;;;		   (sendkeys switchkey)
;;;		 )
		)
		((wcmatch (cdr (assoc 0 n-ent)) "TEXT,MTEXT")
					; Text,Mtext in Block
		 (if (or extract_clone
			 (and (not extract_clone) (load "trexblk.lsp"))
		     )
		   (progn
		     (extract_clone n-textmod)
		     (vla-put-visible n-obj :vlax-false)
		     (entupd obj)
		     (setq l-obj (entlast)
			   font	 (cdr (assoc 7 n-ent))
		     )
		     (vl-cmdf com1 l-obj "")
		     (vla-put-textstring
		       n-obj
		       (cdr (assoc 1 (entget l-obj)))
		     )
		     (vla-put-visible n-obj :vlax-true)
		     (entdel l-obj)
		     (entupd obj)
		   )
		   (princ "Ban chua cai dat goi Express tool cho CAD\n")
		 )
		)
	      )
	    )
	   )
	 )				;cond
	 (setq textmod	(entsel)
	       obj	(car textmod)
	 )

       )
  )
  (princ)
)


;=============================================SUB================================================================


(defun hyp-cmdAbort (param1 param2 )
  (if (and font (wcmatch (strcase (car param2)) lscmd))
    (progn
      (sendkeys switchkey)
      (setq font nil)
      (setvar "HIGHLIGHT" 1)
      )
  )
)

(defun hyp-cmdStart (param1 param2 / code)
  (if (and
;;;	(setq ent (cadr (ssgetfirst)))
;;;	(= 1 (sslength ent))
;;;	(setq ent (ssname ent 0))
;;;	(wcmatch (strcase (cdr (assoc 0 (entget ent)))) lstyp)
	(wcmatch (strcase (car param2)) lscmd)
	font
	(setq code (check-font-code font))
	(cond ((= code "TCVN3") (sendkeys "^+{F2}"))
	      ((= code "UNICODE") (sendkeys "^+{F1}"))
	      ((= code "VNI") (sendkeys "^+{F3}"))
	)
      )
    (sendkeys switchkey)
  )
)
;;; Ham kiem tra bang ma cua textstyle (su dung true type font)
;;; style: String - ten cua textstlye kiem tra
(defun Check-Font-Code
       (style / ts Bold Italic charSet PitchandFamily)

  (setq ts (vlax-ename->vla-object (tblobjname "style" style)))
  (vla-GetFont
    ts 'font 'Bold 'Italic 'charSet 'PitchandFamily)
  (if (= font "")
    (setq font (vla-get-fontfile ts))
  )
  (cond
    
    ((wcmatch (setq font (strcase font)) ".VN*") "TCVN3")
    ((wcmatch font "VNI*") "VNI")
    ((wcmatch font
       "ARIAL*,TAHOMA*,TIMES*,COURIER NEW,CAMBRIA,CONSOLAS,TCVN 7284,MICROSOFT*"
     )
     "UNICODE"
    )
  )
)

;;; Ham senkeys
(defun SendKeys	(keys / wscript)
  (vlax-invoke-method
    (setq wscript (vlax-create-object "WScript.Shell"))
    'sendkeys
    keys
  )
  (vlax-release-object wscript)
)
;;; Ham callback lay textstyle khi Double Click vao text
(defun callback-DoubleClick (reactor point / sset obj ss objtype)
  (setq	sset (vla-get-selectionsets
	       (vla-get-activedocument (vlax-get-acad-object))
	     )
  )
  (if (vl-catch-all-error-p
	(setq ss (vl-catch-all-apply 'vla-item (list sset "Tien2005")))
      )
    (setq ss (vla-add sset "Tien2005"))
    (vla-clear ss)
  )
  (vla-selectatpoint
    ss
    (vlax-3d-point (trans (car point) 0 1))
  )
  (if (> (vlax-get ss 'Count) 0)
    (progn
      (setq obj	    (vla-item ss 0)
	    objtype (vlax-get obj 'ObjectName)
      )
      (if (wcmatch objtype "AcDbText,AcDbMText,AcDbAttributeDefinition")
	(progn
	  (setq font (vla-get-stylename obj))
	  (sssetfirst nil (ssadd (vlax-vla-object->ename obj)))
	)
	(if (not (eq objtype "AcDbBlockReference"))
	  (sssetfirst nil (ssadd (vlax-vla-object->ename obj)))
	)
      )
    )
  )
  (vla-delete ss)
)








;(setq obj (vlax-ename->vla-object (car(entsel"\nchon text"))))

 


<<

Filename: 421369_ed.lsp
Tác giả: txquychk51
Bài viết gốc: 411054
Tên lệnh: test
Nhờ Chỉnh Sửa Text Ra Giữa Line

 

Cai nay` dễ mà ^_^ @Danh Cong

 

@txquychk

Viết nhanh cái lisp này, dùng tạm nhé ^_^

(defun...
>>

 

Cai nay` dễ mà ^_^ @Danh Cong

 

@txquychk

Viết nhanh cái lisp này, dùng tạm nhé ^_^

(defun c:test (/ osm ss p10 p11 pt p1 p2 ss_txt txt pt1)
  (setq osm (getvar 'osmode))
  (setvar 'osmode 0)
  (if (setq ss (ssget (list (cons 0 "LINE") (cons 8 "13.Thin"))))
    (progn
      (command "_zoom" "obj" ss "")
      (mapcar '(lambda (obj)
                 (setq p10 (cdr (assoc 10 (entget obj))))
                 (setq p11 (cdr (assoc 11 (entget obj))))
                 (setq pt (polar p10 (angle p10 p11) (/ (distance p10 p11) 2)))
                 (setq p1 (polar p10 (/ pi 2) 4.))
                 (setq p2 (polar p11 (/ pi 2) 4.))                 
                 (setq ss_txt (ssget "_C" p1 p11 '((0 . "TEXT"))))
                 (if (not (null ss_txt))
                   (progn
                     (setq txt (ssname ss_txt 0))
                     (setq pt1 (list (car pt) (cadr (cdr (assoc 10 (entget txt)))) 0.0))
                     (vlax-put (vlax-ename->vla-object txt) 'Alignment 1)
                     (vlax-put (vlax-ename->vla-object txt) 'TextAlignmentPoint pt1)
                     );progn then
                   );if
                 )
              (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
              )
      (command "_zoom" "P")
      )
    (princ "\nBan da khong chon LINE.")
    )
  (setvar 'osmode osm)
  (princ)
  )

cảm ơn a đã quan tâm, e phải mất cả buổi để chỉnh nó, giờ có lisp thì chỉ mất mấy phút. nhưng e gặp phải vấn đề là text bị chồng lên nhau ạ (sai vị trí)

https://drive.google.com/open?id=0B5iJE54fhfEIenhlN2FEZHFMMDQ

đây là file kết quả ạ. ở cột cuối cùng, anh vào kiểm tra hộ e với ạ


<<

Filename: 411054_test.lsp
Tác giả: hochoaivandot
Bài viết gốc: 175808
Tên lệnh: par
Dynamic Polar Array

Có cái Dynamic Array theo đường thẳng rồi, tiện thể e đi cóp nhặt thêm về cái Dynamic copy rotate theo đường tròn nữa, post lên mọi người...

>>

Có cái Dynamic Array theo đường thẳng rồi, tiện thể e đi cóp nhặt thêm về cái Dynamic copy rotate theo đường tròn nữa, post lên mọi người xài chơi.

Cho phép tăng dần đối với Text (như bản Dynamic Larray)

Mời mọi người dùng thư giãn và thanks nhé ^^ hệch hệch

 

Preview :

Polaarray.gif

Open Source :

;Polar Array @Ketxu 22-9
;CADViet.com
;Many thank to qjchen again
(vl-load-com)
(defun c:par( / ang angnow gr oang p0 px px1 ss ss1 cc oldAng ans)
(grtext -1 "Dynamic PArray @Ketxu")
(setq m:err *error*	*error* err)
(command "undo" "be")
(setq oldAng (getvar "angbase"))
(if (and
 (setq ss (ST:SS->List-Vla (ssget))
p0 (getpoint "\nT\U+00E2m quay : :")
px (getpoint p0 "\n\U+0110\U+01B0\U+1EDDng c\U+01A1 s\U+1EDF ::")
 )
)
(progn
 (grdraw  p0 px 1)
 (setvar "angbase" (angle p0 px))
 (setq   cc (_circle p0 (distance p0 px))      
ang (getangle p0 "\nG\U+00F3c Array :")
s (/ (getvar "viewsize") (cadr (getvar "SCREENSIZE")))
 )
 (cond ((ST:Check-Exist '("AcDbText" "AcDbMText") (mapcar 'vla-get-objectname ss))  
(setq ans (strcase(getstring "Copy t\U+0103ng Text ? < K > :")))
 	(cond ((not (or (= ans "K")(= ans "")))
   	(or #num (setq #num 1))
   	(setq #num (cond ((getint (strcat "\nGia s\U+1ED1 < " (rtos #num 2 0) " > :")))(#num)) inc T)
   	)
 	)
)
 )
(prompt "\nPick \U+0111i\U+1EC3m cu\U+1ED1i c\U+00F9ng :")
(while (= (car (setq gr (grread nil 5 0))) 5)
 (if ss1 (mapcar 'vla-delete ss1))
 (redraw)
 (setq angnow (angle p0 (cadr gr))  
  g (trans (cadr gr) 1 3)
 )  
 (grvecs (LM:GrText (rtos (/ (* angnow 180) pi) 2 0) 3)
 (
  (lambda ( r x y )
  (list
(list r  0. 0. x )
(list 0. r  0. y )
(list 0. 0. r  0.)
(list 0. 0. 0. 1.)
  )
  )
  s
  (+ (car  g) (* 15 s))
  (- (cadr g) (* 31 s))
 )
 )
 (if (and (< ang 0)(> angnow 0)) (setq angnow (- angnow (* 2 pi))))
 (if (and (> ang 0)(< angnow 0)) (setq angnow (+ (* 2 pi) angnow)))
 (setq ss1 (_copyCC ss (fix (/ angnow ang)) p0 ang inc #num))
 (grdraw:arc p0 (/ (getvar "viewsize") 4.0) (angle p0 px) angnow)
)
(entdel cc)
;(setvar "angbase" oldAng)
)
)
(command "undo" "en")
(princ)
)

;;; =======================================================================;
;;; by qjchen, copy ss according to the direction and vector   			;
;;; =======================================================================;
(defun _copyCC (sslst n cen ang inc num / i obj1 ss xobj lst number)
 (foreach xobj sslst
(setq  i 1)
(cond ((and (wcmatch (vla-get-objectname xobj) "AcDbText,AcDbMText") inc num)
(cond ((= 'REAL (type (setq number (last (setq lst (ST:String-GetNumber (vla-get-textstring xobj)))))))
(setq  isReal T))
(T (setq  isReal nil))
)
  (setq isText T)
  ) ;Text Object
  (T setq isText nil)
)
(repeat n
 	(setq obj1 (vla-copy xobj))
 	(Vla-rotate obj1 (vlax-3d-point cen) (* ang i))
 (if  (and isText (wcmatch (vla-get-objectname xobj) "AcDbText,AcDbMText") inc num)
  (vla-put-textstring obj1 (strcat (car lst) (rtos (setq number (+ num number)) 2  (if isReal 1 0))(cadr lst))))  
 	(setq i (1+ i) ss (cons obj1 ss))
)
 )
 ss
)
;;; =======================================================================;
;;; @Ketxu Make Circle Temp                                            	;
;;; =======================================================================;
(defun _circle (p0 r / ent)
(redraw (setq ent(entmakex (list (cons 0 "CIRCLE")(cons 10 (trans p0 1 0))(cons 40 r)))) 3) ent)

(defun RtD (rad) ; converts radian to degree
(/ (* rad 180) pi)
);defun
;;; =======================================================================;
;;; Check List Item Exist in Other List @Ketxu     						;
;;; =======================================================================;
(defun ST:Check-Exist(lst1 lst2)(and (vl-remove nil (mapcar '(lambda(x)(vl-position x lst2)) lst1))))
;;; =======================================================================;
;;; Selection to list  VLA @Ketxu                                      	;
;;; =======================================================================;
(defun ST:SS->List-Vla (ss / n e l)
 (setq n (sslength ss))
 (while (setq e (ssname ss (setq n (1- n))))
(setq l (cons (vlax-ename->vla-object e) l))
 )
)
(defun ST:Ss-Delete (ss / i)
 (mapcar 'vla-delete (ST:SS->List-Vla ss))
)
;;; =======================================================================;
;;; grdraw circle arc                   						;
;;; =======================================================================;
(defun grdraw:arc(cen r ang angadd / angdiv n)
(grdraw cen (polar cen ang r) 3 1)
(grdraw cen (polar cen (+ ang angadd) r) 3 1)
(setq n 100 angdiv (/ angadd n))
(repeat n
  (grdraw (polar cen ang r)(polar cen (setq ang (+ ang angdiv)) r) 1 1)
)
)
(defun ST:String-GetNumber (str / i j dau cuoi tmp tmp1 tmp2 num)
(setq lst (vl-string->list str) i -1 j (strlen str))
(list
(setq tmp1 (vl-list->string (reverse (while (not (or (<= 48 (setq tmp (nth (setq i (1+ i)) lst)) 57) (>= i j))) (setq dau (cons tmp dau))))))
(setq tmp2(vl-list->string (while (not (or (<= 48 (setq tmp (nth (setq j (1- j)) lst)) 57) (<= j i))) (setq cuoi (cons tmp cuoi)))))
(if (vl-string-search "." (setq num (vl-string-left-trim tmp1 (vl-string-right-trim  tmp2 str)))) (atof num) (atoi num))
)
)

;;; =======================================================================;
;;; Error del selection @Ketxu                     						;
;;; =======================================================================;
(defun err (msg)  
(if ss1 (mapcar 'vla-delete ss1))
(if cc (entdel cc))
(if oldAng (setvar "angbase" oldAng))
(setq *error* m:err  m:err nil)
)
(defun LM:GrText ( str col / c i l v y ) ;@Lee Mac

 (setq v
  '(
 	(" ")
 	("\t")
 	("!"   45  45  65 135)
 	("\"" 104 134 107 137)
 	("#"   43  63  46  66  84  94  87  97 115 135 118 138  72  78 103 109)
 	("$"   25  35  52  52  43  47  58  78  83  87  92 112 123 127 118 118 135 135)
 	("%"   52  52  63  63  74  74  85  85  96  96 107 107 118 118 129 129  47  48  67  68  56  56  59  59 113 114 133 134 122 122 125 125)
 	("&"   43  46  49  49  52  72  57  58  67  68  76  76  79  79  83  83  85  85  94  94 103 123 134 136 127 127)
 	("'"  105 135)
 	("("   17  17  26  36  45 105 116 126 137 137)
 	(")"   14  14  25  35  46 106 115 125 134 134)
 	("*"   73  74  76  77  84  86  92  98 104 106 113 114 116 117)
 	("+"   55 115  82  84  86  88)
 	(","   34  35  45  46  55  57)
 	("-"   83  88)
 	("."   45  46  55  56)
 	("/"   52  52  63  63  74  74  85  85  96  96 107 107 118 118 129 129)
 	("0"   44  47 134 137  53 123  58 128)
 	("1"   44  48 124 125  56 136)
 	("2"   43  48  53  53  64  64  75  75  86  86  97  97 108 128 134 137 123 123)
 	("3"   53  53  44  47  58  88  95  97 108 128 134 137 123 123)
 	("4"   46  48  57 137  78  78  73  76  83  83  94  94 105 115 126 126)
 	("5"   53  53  44  47  58  88  94  97  93 133 134 138)
 	("6"   44  47  58  88  95  97  84  84  53 113 124 124 135 137)
 	("7"   44  54  65  75  86  96 107 117 128 138 133 137 123 123)
 	("8"   44  47  94  97 134 137  53  83  58  88 103 123 108 128)
 	("9"   44  46  57  57  68 128  97  97  84  86 134 137  93 123)
 	(":"   45  46  55  56  95  96 105 106)
 	(";"   34  35  45  46  55  57  95  96 105 106)
 	("<"   47  47  56  56  65  65  74  74  83  83  94  94 105 105 116 116 127 127)
 	("="   73  78  93  98)
 	(">"   43  43  54  54  65  65  76  76  87  87  96  96 105 105 114 114 123 123)
 	("?"   45  45  65  75  86  86  97  97 108 128 134 137 123 123)
 	("@"   34  38  43  43  52 112 123 123 134 137 128 128  79 119  68  68  65  66 105 106  77 107  74  94)
 	("A"   41  43  47  49  52  62  58  68  73  77  83  93  87  97 104 114 106 116 125 135 133 134)
 	("B"   42  47  53 123  58  88 108 128  94  97 132 137)
 	("C"   44  47  53  53  58  58  62 112 123 123 134 136 127 127 108 138)
 	("D"   42  46  57  57 127 127 132 136  68 118  53 123)
 	("E"   42  48  58  58  94  95  86 106 132 137 128 138  53 123)
 	("F"   42  45  94  95  86 106 132 137 128 138  53 123)
 	("G"   44  47  53  53  58  78  86  89  62 112 123 123 134 136 127 127 108 138)
 	("H"   41  43  47  49 131 133 137 139  93  97  52 122  58 128)
 	("I"   43  47 133 137  55 125)
 	("J"   52  62  43  46  57 127 135 139)
 	("K"   42  44  48  49 132 134 136 138  53 123  84  85  95  95 106 116 127 127  76  76  67  67  58  58)
 	("L"   42  47  48  58  53 123 132 135)
 	("M"   41  43  47  49  52 122  58 128 131 132 138 139 103 113 107 117  84  94  86  96  65  75)
 	("N"   41  44 131 132 136 139  52 122  48 128 113 113  94 104  85  85  66  76  57  57)
 	("O"   44  46  53  53  57  57 123 123 127 127 134 136  62 112  68 118)
 	("P"   42  45  84  87 132 137  53 123  98 128)
 	("Q"  134 136 123 123 127 127 112  62 118  68  53  53  57  57  44  46  35  36  23  24  27  28)
 	("R"   42  44  48  49 132 137 123  53 128  98  84  87  76  76  67  67  58  58)
 	("S"   42  62  53  53  44  47  58  78  86  87  93  95 102 122 133 136 127 127 118 138)
 	("T"   43  47  55 125 132 138 131 121 139 129)
 	("U"   44  46  52  53  57  58  62 122  68 128 131 133 137 139)
 	("V"   45  55  64  74  66  76  83 103  87 107 112 122 118 128 131 133 137 139)
 	("W"   43  63  47  67  72  92  74  94  76  96  78  98 101 121 105 115 109 129 131 132 138 139)
 	("X"   41  43  47  49 131 133 137 139  52  52  58  58  63  63  67  67  74  74  76  76  85  95 104 104 106 106 113 113 117 117 122 122 128 128)
 	("Y"   43  47  55  85  94  94  96  96 103 113 107 117 122 122 128 128 131 133 137 139)
 	("Z"  122 122  58  58 132 138  42  48 128 128  52  52  63  63  74  74  85  95 106 106 117 117)
 	(""   14  16 134 136  26 126)
 	("^"  102 102 113 113 124 124 135 135 126 126 117 117 108 108)
 	("_"   21  29)
 	("`"  125 125 134 134)
 	("a"   43  46  48  48  52  72  57  97  83  86 103 106)
 	("b"   42  43  45  46  54  54  57  58  68  98  97  97 105 106  94  94 132 132  53 133)
 	("c"   44  46  53  53  57  58  52  92  93  93 104 106  97  98 108 108)
 	("d"   44  45  47  48  52  92  53  53  56  56  93  93 104 105  96  96 136 136  57 137)
 	("e"   44  46  53  53  57  58  52  92  93  93 104 106  97  98  88  88  73  78)
 	("f"   43  46  54 124  93  93  95  96 135 137 128 128)
 	("g"   13  16  22  32  27  97 107 108  66  66  96  96  54  55 104 105  63  63  93  93  62  92)
 	("h"   42  44  46  48  57  97  53 133 132 132  94  94 105 106)
 	("i"   43  47  55 105 103 104 135 135)
 	("j"   22  22  13  15  26 106 104 105 136 136)
 	("k"   42  44  46  48  53 133 132 132  57  57  66  66  74  75  85  85  96 106 107 108)
 	("l"   43  47  55 135 133 134)
 	("m"   41  43  45  46  48  49  52 102  55 105  58 108 101 101  93  93 104 104  96  96 107 107)
 	("n"   42  44  46  48  53 103  57  97 102 102  94  94 105 106)
 	("o"   44  46 104 106  53  53  57  57  93  93  97  97  52  92  58  98)
 	("p"   12  15  23 103 102 102  54  54  94  94  45  46 105 106  57  58  97  98  68  88)
 	("q"   15  18  27 107 108 108  56  56  96  96  44  45 104 105  52  53  92  93  62  82)
 	("r"   42  46  54 104 102 103  95  95 106 108  99  99)
 	("s"   52  52  43  47  58  68  73  77  82  92 103 107  98  98)
 	("t"   45  47  58  58  54 124 102 103 105 107)
 	("u"  102 102 106 106  53 103  56  56  44  45  47 107  48  48)
 	("v"   45  45  54  64  56  66  73  83  77  87  92  92  98  98 101 103 107 109)
 	("w"   43  53  47  57  62  92  64  84  66  86  68  98 101 103  95 105 107 109)
 	("x"   42  44  46  48 102 104 106 108  53  53  57  57  93  93  97  97  64  64  66  66  84  84  86  86  75  75)
 	("y"   12  13  24  24  35  45  54  64  56  66  73  83  77  87  92  92  98  98 101 103 107 109)
 	("z"   92  92  58  58 102 108  42  48  97  97  86  86  75  75  64  64  53  53)
 	("{"   16  17  25  65  73  74  85 125 136 137)
 	("|"   15 135)
 	("}"   14  15  26  66  77  78  86 126 134 135)
 	("~"  112 122 133 134 125 125 116 117 128 138)
)
 )
 (eval
(list 'defun 'LM:GrText '( str col / c i l v y )
 	(list 'setq 'v
   	(list 'quote
     	(mapcar
       	(function
         	(lambda ( b )
           	(cons (car B) (mapcar '(lambda ( a ) (if a (list (rem a 10) (/ a 10)))) (cdr B)))
         	)
       	)
       	v
     	)
   	)
 	)
'(setq i 0 y 0)

'(repeat (strlen str)
   	(cond
     	( (eq (setq c (substr str 1 1)) " ")
       	(setq i (+ i 9) str (substr str 2))
     	)
     	( (eq c "\t")
       	(setq i (+ i 36) str (substr str 2))
     	)
     	( (eq c "\n")
       	(setq i 0 y (- y 16) str (substr str 2))
     	)
     	( (setq l
         	(cons
           	(mapcar
             	(function
               	(lambda ( a )
                 	(if a (list (+ (car a) i) (+ (cadr a) y)))
               	)
             	)
             	(cdr (assoc c v))
           	)
           	l
         	)
         	str (substr str 2) i (+ i 9)
       	)
     	)
   	)
 	)
'(cons col (apply 'append l))
)
 )
 (LM:GrText str col)
)

 

Chào ketxu!

Lisp của ketxu rất hay, mình đã học được rất nhiều.

Mình hỏi Ketxu 1 vấn đề có liên quan đến GRREAD.

Đối với các hàm getxxx thì mình dùng initget để có các lựa chọn input khác. Vậy thằng Grread này có chức năng tương tự không ketxu?

Chẳng hạn như trong Lisp của ketxu, người dùng kéo rê chuột để chọn số lượng array; Có thể nào thêm lựa chọn khác để nhập, tỉ nhỉ bấm A để nhập góc tổng, bấm N để nhập trựctiếp số lượng ARRAY. Nếu không phải 2 lựa chọn trên thì kéo rê.

Mình nói rõ thêm là phương án kéo rê chuột ưu tiên không cần nhập Keyword, có 2 cách nhập kia mới nhập keyword.

Mình search vấn không có cách!


<<

Filename: 175808_par.lsp
Tác giả: hoquangvinh
Bài viết gốc: 410329
Tên lệnh: sumdim1
Cộng Tất Cả Các Demension Trong Một Layer

 

Đã thêm trường hợp Dim sửa số và đã test.

Còn dim mà thêm các hậu tố tiền tố linh cu tinh thì trong trường hợp  này...

>>

 

Đã thêm trường hợp Dim sửa số và đã test.

Còn dim mà thêm các hậu tố tiền tố linh cu tinh thì trong trường hợp  này chắc không dùng. ^_^ Nếu cần dùng thì post chi tiết bản vẽ để mọi người check cho nhé.

(defun c:sumdim1  (/ ss layer)
  (vl-load-com)
  (if (and (setq ss (car (entsel "\nChon 1 dim dien hinh layer: ")))
           (eq (cdr (assoc 0 (entget ss))) "DIMENSION")
           ) ;and
    (progn
      (setq ss (ssget "_X"
                      (list (cons 0 "DIMENSION")
                            (setq layer (assoc 8 (entget ss)))
                            )
                      )
            ) ;setq
      (alert
        (strcat "Total Dim layer <"
                (cdr layer)
                ">: "
                (vl-princ-to-string
                  (apply '+
                         (mapcar '(lambda (vla)
                                    (if (= "" (vlax-get vla 'TextOverride))
                                      (vlax-get vla 'Measurement)
                                      (distof (vlax-get vla 'TextOverride))
                                      )
                                    )
                                 (mapcar 'vlax-ename->vla-object
                                         (vl-remove-if
                                           'listp
                                           (mapcar 'cadr (ssnamex ss))
                                           )
                                         )
                                 )
                         )
                  )
                )
        )
      ) ;progn then
    (princ "\nBan da khong chon dim.!")
    )
  (princ)
  )
(princ)

Mình check thấy lisp chạy tốt rồi nhưng nếu thêm lựa chọn một chút nữa sẽ hay hơn

-1.  Tên lệnh

-2. Chọn dim mẫu

-3. Quét chọn các dim cần tính

-4. Thực hiện lệnh ra kết quả

Vậy là thêm lựa chọn thứ 3 nữa thì lisp sẽ thuận lợi khi sử dụng hơn

Ps: bạn @Bee là lisper mới nối nhé, rất hot đây


<<

Filename: 410329_sumdim1.lsp
Tác giả: quocmanh04tt
Bài viết gốc: 354140
Tên lệnh: layon
Cần xin Lisp ẩn và hiện tất cả các layer!!!

Bạn thử xem sao:

(defun c:layon ()

(vlax-for each (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
(vla-put-layeron each :vlax-true))
(princ))
(defun c:layoff (/ ss i)
(if (setq ss (ssget))
(repeat (setq i (sslength ss))
(vla-put-layeron (vlax-ename->vla-object
(tblobjname "LAYER" (vla-get-layer (vlax-ename->vla-object (ssname ss (setq i (1- i)))))))
:vlax-false)))
(princ))


Filename: 354140_layon.lsp
Tác giả: trungkscd
Bài viết gốc: 172133
Tên lệnh: tbkd
lisp vẽ đường bóng ( đường thể hiện dốc trên mặt bằng )

Mình đưa ra 1 ví dụ để bạn thấy việc viết lisp không đơn giản, và nếu người yêu cầu không biết mình cần gì, sẽ không bao giờ có...

>>

Mình đưa ra 1 ví dụ để bạn thấy việc viết lisp không đơn giản, và nếu người yêu cầu không biết mình cần gì, sẽ không bao giờ có đáp án, hoặc chí ít cũng không được như ý

(defun c:tbkd(/ eLine curve1 curve2 i j len1 len2 tmp)
(vl-load-com)
(or #dist (setq #dist 10)) ; 10 = Khoang cach mac dinh
(setq #dist (cond ((getdist (strcat "\nKhoang cach bat dau <" (vl-princ-to-string #dist) " > :")))(#dist)))
(or #inc (setq #inc 1.2)) ;
(setq #inc (cond ((getdist (strcat "\nGia so <" (vl-princ-to-string #inc) " > :")))(#inc)))
(defun eLine (p1 p2  / p2 col)(entmake  (list (cons 0 "LINE")(cons 10 p1)  (cons 11 p2)(cons 62 8)  (cons 8 "0"))))
;;Doan duoi nay khong can de y
(If
(and
(setq curve1  (car(entsel "\nPath curve 1 :")))
(setq curve2  (car(entsel "\nPath curve 2 :")))
(wcmatch (cdadr (entget curve1)) "*LINE,ARC")
(wcmatch (cdadr (entget curve2)) "*LINE,ARC")
(eLine (vlax-curve-getStartPoint curve1) (vlax-curve-getStartPoint curve2))
(setq tmp 0 i 0 len1 (vlax-curve-getDistAtParam curve1 (vlax-curve-getEndParam curve1)) len2 (vlax-curve-getDistAtParam curve2 (vlax-curve-getEndParam curve2)))
)
(while (<= (setq tmp (+ (* #dist (expt #inc (setq i (1+ i))))tmp)) len1)
 (eLine (vlax-curve-getPointAtDist curve1 tmp) (vlax-curve-getPointAtDist curve2 tmp))
)
)
)

 

 

.......................////

e thay lisp nay hay. Nhung no chi ve khi co 2 culve song song nhau , con 1 duong thang va 1 duong cheo ko ve vuong goc duoc

anh KETXU co the hieu chinh them chut nua la ok


<<

Filename: 172133_tbkd.lsp

Trang 236/303

236