Viết lisp theo yêu cầu [phần 2]

[phamthanhbinh 3.146]

Chào các Bác và Bác Bình, mình mới mót được cái lisp trên diễn đàn để phục vụ cho công việc chuyên môn, trên 2D thì thực hiện được, nhưng không thực hiện được trên 3d với lý do sau:

-Thực hiện được trên solid chỉ đối với trục x còn các trục còn lại y,z không thực hiện được, mặc khác nó chuyển solid sang block

Mong các Bác chỉ giáo giúp. Thank you very much

(setq kq Nil)

(setq n (length LiBlk))

(setq i 0)

(while (

(if (= bname (nth i LiBlk))

(progn

(setq i n)

(setq kq T)

)

)

(setq i (1+ i))

)

kq

)

(DEFUN CREALIBLK (/ NL)

(setq LiBlk (List))

(setq NL (tblnext "BLOCK" T))

(while NL

(setq LiBlk (append LiBlk (list (cdr (assoc 2 NL)))))

(setq NL (tblnext "BLOCK"))

)

(setq LiBlk (Acad_strlsort LiBlk))

)

(DEFUN C:XSCALE()

(CREALIBLK)

(EXCUTE)

)

(DEFUN C:XSC()

(CREALIBLK)

(EXCUTE)

)

(princ "\nfree lisp from www.cadviet.com")

(princ)

Chào bác tuannguyen314169,

Hề hề hề,

Bác có khỏe không mà sao cái lisp bác post lại bị ngắt đi một khúc đầu vậy, chả thấy cái (defun excute () ......) nó nằm đâu cả thì dò sao ra lỗi được hử bác????

Cái lisp này hình như của bác Duy viết thì phải, nó để scale theo một trục và hai trục thì phải, mình đọc lâu rồi nên cũng không nhớ rõ lắm.

Trong CAD thì các solid đều được hiểu là block nên khi bác xài hàm (tblnext "block") thì nó sẽ lôi cả các thằng solid này vào trong danh sách các block để nó trảm bác ạ.

Có nhẽ cái lisp này được viết không phải cho các đối tượng 3D và cần phải tìm hiểu kỹ hơn mới có thể chỉnh sửa nó được bác ạ. Và nếu bác Duy góp sức thì có thể sẽ gỡ nó nhanh hơn.

Bác hãy gửi lại đầy đủ cái lisp này bác nhé. Bây giờ kiếm nó cũng hơi lâu vì tuy biết là có trên diện đàn nhưng cái khoản tìm kiếm này mình hơi kém bác ạ.

Hề hề hề,....

[duy782006 1.544]

Chào bác tuannguyen314169,

Hề hề hề,

Bác có khỏe không mà sao cái lisp bác post lại bị ngắt đi một khúc đầu vậy, chả thấy cái (defun excute () ......) nó nằm đâu cả thì dò sao ra lỗi được hử bác????

Cái lisp này hình như của bác Duy viết thì phải, nó để scale theo một trục và hai trục thì phải, mình đọc lâu rồi nên cũng không nhớ rõ lắm.

Trong CAD thì các solid đều được hiểu là block nên khi bác xài hàm (tblnext "block") thì nó sẽ lôi cả các thằng solid này vào trong danh sách các block để nó trảm bác ạ.

Có nhẽ cái lisp này được viết không phải cho các đối tượng 3D và cần phải tìm hiểu kỹ hơn mới có thể chỉnh sửa nó được bác ạ. Và nếu bác Duy góp sức thì có thể sẽ gỡ nó nhanh hơn.

Bác hãy gửi lại đầy đủ cái lisp này bác nhé. Bây giờ kiếm nó cũng hơi lâu vì tuy biết là có trên diện đàn nhưng cái khoản tìm kiếm này mình hơi kém bác ạ.

Hề hề hề,....

Không phải đâu là không phải đâu. Của em là scalexy còn cái này ra đời sớm hơn hình như của bác ssg hay kiên ường gì đấy.

[Sony2007 86]

Em mới viết con này, không biết đúng ý bác ko:

;===========================
(defun c:Rotext(/ thop_list index ctname_i diemdat giatrigoc giatrigoc_new gocquay thop)
(princ)

 

Có gì pót lại nhé!!!! (@PS: cad của bác phải cài Express Tool)

 

Cám ơn bác nhiều, đã đúng ý em rồi. Chúc bác ngày mới làm việc tốt.

[Sony2007 86]

Ý em là khi Torient thì "các chú *Text" cùng nhìn về một "em" đấy mà.......theo kiểu nhắm thẳng quân thù mà bắn !!!

 

Còn cái dụ vì sao phải quay Text kiểu kia thì cái này em viết do có cái dụ ông bạn cùng chổ làm quay hay mirr cái bình đồ sang một góc khác (ví như khi thiết kế từ điểm A-B mà sau này chủ đầu tư yêu cầu đổi điểm đầu điểm cuối nên ổng quay cái bình đồ lại, thế là các Text lộn tùng phéo cả lên mà bình đồ chổ làm thì yêu cầu các Text cao độ phải vuông với đường tim trắc ngang nên nếu dùng Torient thì không được mà phải quay nó một góc nào đấy quanh tâm nên mới đẻ ra cái LSP này...., mình nói quanh co khó hiểu nhưng đại loại thế...khì khì :( cụng với bác "kẹt xù" một li nà, khì khì khì

 

Ý của bác dkkx3a là đúng ý em rồi đấy, và việc này là nhằm mục đích e làm bình đồ như bạn của bác đó. Chứ còn đưa các text về cùng 1 góc quay thì e k nói làm gì. Cám ơn bác nhiều,

[huong259 351]

Không phải đâu là không phải đâu. Của em là scalexy còn cái này ra đời sớm hơn hình như của bác ssg hay kiên ường gì đấy.

Hình như tác giả lisp scale 1 chiều là:

http://www.cadviet.com/forum/index.php?showtopic=1340

[bachngoctung 11]

Chao Ngoctung. hnay vào toppic này thấy bài của bác Bình mới biết yêu cầu của bạn. Cách làm của bạn truớc đây mình đã giúp 1 bạn ngay trong toppic này. bạn chịu khó tìm kiếm nó trong khoảng 20 trang đầu sẽ thấy.

Tuy nhiên cách làm này mình thấy quá thủ công. Với những trắc ngang nội suy từ đuờng đồng mức như thế này sẽ tạo ra số điểm mia rất dày, nhất là với đuờng miền núi. lam theo cách trên với 1 km đường thôi chắc cũng mất gần 1 ngày. mình gợi ý bạn cách giải quyết triệt để hơn.

Trên trắc ngang bạn có các đường dóng. Như vậy từ các đường dóng này ta có thể lấy được khoảng cách giữa các điểm mia, cao độ tự nhiên của của chúng (thông qua việc chọn 1 đường dóng nào đó làm gốc).

như vậy ta có thẻ giải quyết công việc cụ thể như sau:

- làm thưa trắc ngang bằng cách xóa tất cả các đường dóng không cần thiết (cái này làm thủ công, không mất nhiều thời gian)

- sau khi trắc ngang đã được làm thưa, điền lai toàn bộ khoảng cách giữa các cọc còn lại và cao độ tự nhiên của chúng (cái này làm bằng lisp)

như vậy ta cần viết 1 lisp có chức năng điền cao độ và khoảng cách lẻ thay thế cho bảng cũ dựa trên số liệu cao độ và khoảng cách thu được từ các đường dóng còn lại trên trắc ngang.

Mình thấy bạn có khả năng viết code nên mình gợi ý bạn làm như vậy. Bạn thử làm xem, Nếu không thành công mình sẽ post code của mình cho bạn

đây là file trình tự cách làm và kết quả của mình

-Cám Thaistreetz đã quan tâm nhưng mình chưa biết viết lisp bạn à , bạn giúp mình được ko vì vấn đề này ko những giúp mình mà còn giúp được rất nhiều anh em làm giao thông khi gặp phải thiết kế các tuyến đường miến núi tiết kiệm được thời gian hiệu chỉnh bản vẽ . Bạn Thaistreetz giúp mình code nhé :( .

[790312 5]

Chào bạn 843824,

Bạn dùng thử cái này xem đúng ý chưa nhé. Nếu chưa thì hãy post lên để mình xem lại.

Trước khi dùng lisp, bạn phải tạo các text như bạn đã mô tả. Lisp sẽ tự động sắp xếp lại các text của bạn theo thứ tự tăng hay giảm dần của tọa độ x của điểm đặt text. Bạn sẽ phải lựa chon chiều đặt các text theo tọa độ x này khi lisp hỏi bằng các nhập vào bàn phím các ký tự P hay T bạn nhé.

Lisp đây:

(defun c:cgxt ( )
(setq sst (ssget (list (cons 0 "TEXT")))
       n (sslength sst)
       i 0
       enlst (list)
       plst (list)
)
(while (< i n)
(setq en (ssname sst i)
       enlst (append enlst (list en))
)
(setq i (1+ i))
)
(setq enlst (vl-sort enlst '(lambda (e1 e2)
                                  (< (cadr (assoc 10 (entget e1))) (cadr (assoc 10 (entget e2)))  )
                                  )
                )
)
(setq i 0
       a (getreal "/n Nhap gia tri bat dau: ")
       b (getreal "/n Nhap gia tri cong sai: ")
)
(setq ans (strcase (getstring t "/n Chon chieu tang cua Text ( P hay T ): ")))
(if (= ans "T")
  (setq enlst (reverse enlst))
)
(foreach en enlst
        (setq els (entget en)
                els (subst (cons 1 (rtos (+ a (* i b )) 2 1)) (assoc 1 els) els)
                i (1+ i)
        )
        (entmod els)
        (entupd en)
)

)

Mong rằng bạn sẽ hài lòng.

Lisp này khi mình chọn chiều tăng của text là phải thì nó đánh từ trên xuống dưới,bạn có thể sửa lại khi chọn chiều tăng là phải thì nó cũng đánh từ dưới lên trên giống như chiều tăng trái được không .Chân thành cảm ơn trước.

[Thaistreetz 539]

-Cám Thaistreetz đã quan tâm nhưng mình chưa biết viết lisp bạn à , bạn giúp mình được ko vì vấn đề này ko những giúp mình mà còn giúp được rất nhiều anh em làm giao thông khi gặp phải thiết kế các tuyến đường miến núi tiết kiệm được thời gian hiệu chỉnh bản vẽ . Bạn Thaistreetz giúp mình code nhé :( .

EDTN : Edit trắc ngang. Code này mình viết khá lâu rồi nên rác, một vài truờng hợp có thể sảy ra lỗi khi chay nếu truớc khi chạy tuyến trong nova bạn không chạy lệnh NS - "Cài đặt các thông số ban đầu"

(Không hiểu sao Hài Hoà không thiết lập lệnh này tự chạy khi thiết lập bản vẽ, trong nhiều truờng hợp, việc chạy lệnh này truớc khi chạy tuyến là bắt buộc, nếu không thì toàn bộ quá trình thiết kế sau đó sẽ tạo ra rất nhiều lỗi và buộc fải xoá toàn bộ tuyến rồi chạy lại)

Khi chạy lệnh, tại dòng nhắc : "Quét chọn trắc ngang cần sửa", bạn kéo chuột từ trái qua fải như hình vẽ để chọn đủ đối tuợng.

(defun c:EDTN	(/ SSTN SSD SST SSL	T0 L0	 L1 index PDi
		 PD0	PTi PT0 PLi	 PL0	RES	 Hi H0 DL0	CL0	 YL0
		 DLi	KCi	 XLi	PTX
		)
(thai-get-sysvar)
(setq cmdname "Edit khoang cach le trac ngang")
(prompt (strcat "\nQuet chon trac ngang can sua\n"))
(setq SSTN (ssget (list (cons 8 "LINEDONGTN,ENTTNTUNHIEN"))))
(setq	index	0
			SSD		(ssadd)
			SST		(ssadd)
			SSL		(ssadd)
			T0		(ssadd)
			L0		(ssadd)
			L1		(ssadd)
)											;setq
										        ;----loc doi tuong
(repeat	(sslength SSTN)
	(if	(= (DFX-SS 8 SSTN index) "LINEDONGTN")
		(setq SSD (ssadd (ssname SSTN index) SSD))
		(progn
			(if	(= (DFX-SS 0 SSTN index) "TEXT")
				(if	(distof (DFX-SS 1 SSTN index))
					(setq SST (ssadd (ssname SSTN index) SST))
				)											;if
				(if	(< (thai-length-curve (ssname SSTN index)) 3)
					(setq SSL (ssadd (ssname SSTN index) SSL))
				)
			)							;if
		)								;progn
	)									;if
	(setq index (1+ index))
)										;repeat
										;-----------------
(setvar "Dimzin" 0)
(setq index 0)
(repeat	(sslength SSD)
	(setq PDi (DFX-SS 10 SSD index))
	(if	(= index 0)
		(setq PD0 PDi)
		(if	(> (car PDi) (car PD0))
			(setq PD0 PDi)
		)
	)									;if
	(setq index (1+ index))
)										;repeat
(setq index 0)
(repeat	(sslength SST)
	(setq PTi (DFX-SS 11 SST index))
	(if	(= index 0)
		(setq	T0	(ssadd (ssname SST index) T0)
					H0	(atof (DFX-SS 1 SST index))
					PT0	PTi
		)
		(if	(> (car PTi) (car PT0))
			(setq	T0	nil
						T0	(ssadd)
						T0	(ssadd (ssname SST index) T0)
						H0	(atof (DFX-SS 1 SST index))
						PT0	PTi
			)
		)									;if
	)										;if
	(setq index (1+ index))
)											;repeat


(setq index 0)
(repeat	(sslength SSL)
	(setq PLi (DFX-SS 10 SSL index))
	(if	(>= (car PLi) (car PD0))
		(setq	L0 (ssadd (ssname SSL index) L0)
		)
	)										;if
	(setq index (1+ index))
)											;repeat
(setq index 0)
(setvar "osmode" 0)
(repeat	(sslength SSD)
	(setq PDi (DFX-SS 10 SSD index))
	(setq Hi (+ H0 (- (cadr PDi) (cadr PD0))))
	(command "copy" L0 "" (list (car PD0) 0) (list (car PDi) 0))
	(setq L1 (ssadd (entlast) L1))
	(command "copy" T0 "" (list (car PT0) 0) (list (car PDi) 0))
	(thai-entmod-entlast 1 (rtos Hi 2 2))
	(setq index (1+ index))
)											;repeat
(setq index 0)
(repeat (sslength L1)
	(if (= index 0)
	(setq	DL0	(DFX-SS 10 L1 index)
			CL0	(DFX-SS 11 L1 index)
			YL0	(+ (cadr CL0) (* 0.5 (thai-length-curve (ssname L1 index))))
	)
	(progn
		(setq	DL0	(DFX-SS 10 L1 (- index 1))
				DLi	(DFX-SS 10 L1 index)
				KCi	(distance DLi DL0)
				XLi	(+ (car DLi) (* 0.5 KCi))
				PTX	(list XLi YL0)
			)
			(if	(> KCi 0.05)
				(progn
					(command "copy" T0 "" PT0 PTX)
					(thai-entmod-entlast 72 1)
					(thai-entmod-entlast 1 (rtos KCi 2 2))
					(setq RES (entget (entlast)))
					(if	(> (- KCi 0.4)
						 (distance (car (textbox RES)) (cadr (textbox RES)))
						)
						(entmod (subst (cons 50 0) (assoc 50 RES) RES))
					)
				)
			)
		)									;progn
	)										;if
	(setq index (1+ index))
)											;repeat
(command "erase" SST SSL "")
(thai-restore)
(princ)
)												;end
(defun thai-entmod-entlast (code value / RES)
(setq RES (entget (entlast)))
(entmod (subst (cons code value) (assoc code RES) RES))
)
(defun thai-get-sysvar ()
(setq CMDLAST (getvar "cmdecho"))
(setvar "cmdecho" 0)
(vl-load-com)
(command "Undo" "BEGIN")
(command "UCS" "W")
(setq	OSMLAST	(getvar "osmode")
			DMZLAST	(getvar "dimzin")
			OTHLAST	(getvar "orthomode")
			TSTLAST	(getvar "textstyle")
			COLLAST	(getvar "cecolor")
			LAYLAST	(getvar "clayer")
			DPMLAST	(getvar "DYNPROMPT")
			DYNLAST	(getvar "DYNMODE")
			ERR			*error*
			*error*	thai-error
)
)
(defun thai-restore	()
(setvar "osmode" OSMLAST)
(setvar "dimzin" DMZLAST)
(setvar "orthomode" OTHLAST)
(setvar "textstyle" TSTLAST)
(setvar "cecolor" COLLAST)
(setvar "clayer" LAYLAST)
(setvar "DYNPROMPT" DPMLAST)
(setvar "DYNMODE" DYNLAST)
(command "UCS" "P")
(if	SSe
	(command "erase" SSe "")
)
(command "undo" "end")
(if	cmdname
	(progn
		(princ (strcat "\nEnd of [" cmdname "]"))
		(setq cmdname nil)
	)
)
(setq *error* ERR)
(setvar "cmdecho" CMDLAST)
)											;defun
(defun thai-error	(msg)
(if	OSMLAST
	(setvar "osmode" OSMLAST)
)
(if	DMZLAST
	(setvar "dimzin" DMZLAST)
)
(if	OTHLAST
	(setvar "orthomode" OTHLAST)
)
(if	TSTLAST
	(setvar "textstyle" TSTLAST)
)
(if	COLLAST
	(setvar "cecolor" COLLAST)
)
(if	COLLAST
	(setvar "clayer" LAYLAST)
)
(if	DPMLAST
	(setvar "DYNPROMPT" DPMLAST)
)
(if	DYNLAST
	(setvar "DYNMODE" DYNLAST)
)
(if	SShd
	(command "erase" SShd "")
)
(if	SSe
	(command "erase" SSe "")
)
(command "UCS" "P")
(command "undo" "end")
(if	cmdname
	(progn
		(princ (strcat "\n" msg
			 "\nEnd of [" cmdname "], Reset System Variables\n"
			)
		)
		(setq cmdname nil)
	)
	(princ (strcat "\n" msg ", Reset System Variables\n"))
)
(setq *error* ERR)
(setvar "cmdecho" CMDLAST)
)														;defun
(defun DFX-SS	(code obj index)
(cdr (assoc code (entget (ssname obj index))))
)														;defun
(defun thai-length-curve (EN)
(vlax-curve-getDistAtParam EN (vlax-curve-getEndParam EN))
)

[tamkt 2]

Chào anh Phamthanhbinh!

 

Phải nói anh tuyệt thật, em cám ơn anh nha, anh ở Sài Gòn hay ở đâu vậy?

 

Lisp đúng ý em rùi, em cám ơn anh nhiều lắm.

[dkkx3a 59]

Nhờ các anh các bác giúp em cái LSP này, em sớt không thấy: em tạo nhiều layout, mỗi layout có một bản vẽ (để em dùng Publish in ấn), nhưng mỗi khi em mang sang máy khác thì phải đổi lại thiết lập máy in rất chi là mất công, do có quá nhiều bản vẽ, nên nay xin nhờ các anh (bác) trên diễn đàn viêt giúp em cái LSP dùng để thiết lập lại thông số các layout hàng loạt trong một bản vẽ sang kiểu khác (ham muốn thêm là cả trong Folder)......em xin cảm ơn. Nếu mất nhiều thời gian thì các anh hướng dẫn em làm với: các bước và hàm cần sử dụng để em tự biên (bí thì nhờ...) em cũng đang học LSP nên cũng muốn táy máy tí.

Mong sớm hồi âm. thanks...cuối tuần rùi dzô đê :(

[ketxu 2.984]

E tưởng lúc publish nó có cả lựa chọn gắn thêm thiết lập layout,paper size các kiểu cơ? Do chưa dùng nên cũng không rõ lắm,bác nghiên cứu thử xem sao ^^

[dkkx3a 59]

E tưởng lúc publish nó có cả lựa chọn gắn thêm thiết lập layout,paper size các kiểu cơ? Do chưa dùng nên cũng không rõ lắm,bác nghiên cứu thử xem sao ^^

Cảm ơn bác đã nhắc nhở, em làm được rồi, không cần dùng LSP mà làm thủ công, nhưng chắc có LSP cũng không nhanh hơn được, em làm theo hướng dẫn của bác tuongtrang ngày xưa http://www.cadviet.com/forum/index.php?sho...ost&p=72167

...........cảm ơn.

[phamthanhbinh 3.146]

Chào anh Phamthanhbinh!

 

Phải nói anh tuyệt thật, em cám ơn anh nha, anh ở Sài Gòn hay ở đâu vậy?

 

Lisp đúng ý em rùi, em cám ơn anh nhiều lắm.

Hề hề hề,

Chào bạn tamkt. mình ở cái đất mà khỉ chẳng ho, cò chẳng thấy bạn ạ. Nó vốn là khu vực cận R ngày xưa. Bình dương đất Thủ ít ra cũng có thời vang bóng đó bác. Nhưng mà mình chỉ là dân ngụ cư thôi, ăn đậu ở nhờ, khi vui thì bậu mà khi buồn lại bay ấy mà..... Hề hề hề....

Ta đây con cháu vua Hùng, tuy điên thì chả phải nhưng khùng thì cũng hơi hơi bác à......

Hề hề hề....

[Tue_NV 3.912]

Hề hề..Bác Binh ơi,code có kiểm tra vnsimple.shx tồn tại hay không thì sao ạ ^^.Gán thế rồi mà nó k có thì sao ạ ^^

Hề hề hề,

cái font này có nhẽ khó mà thiếu được, nếu không có thì phải thay nó bằng font khác thui. Còn gán vậy nó mà không có thì lisp chả chạy nữa, nằm nghỉ mệt. Mình phải lôi ra mà sửa vậy.

Tại vì lisp này mình cũng mót trên diễn đàn về xài nên cũng chửa biết kiểm tra nó ra sao, cứ chép nguyên vậy dùng đã. Khi cần thì lôi ra chỉnh sửa cho hợp ý mình thui chứ không dám bày vẽ gì thêm.

Hề hề hề......

Tỷ như bạn muốn thay font gì thì thay vào cái chỗ vnsimple.shx đó. Chả nhẽ trên máy lại chả có cái font nào hay sao??? còn cái việc tạo font thì ối cha mẹ ơi mình chửa biết làm. Có ai biết chỉ giùm. Hề hề hề.

Túm lại là có gì xơi nấy chả kén cá chọn canh được bác ạ.....

Hề hề hề.....

Ý của bạn ketxu muốn kiểm tra vnsimple.shx tồn tại hay không chớ hổng phải nói về cách tạo Font. Ket xu còn thực hiện mấy công việc đằng sau việc kiểm tra Font này. Nếu mà hông có việc kiểm tra này thì mấy công việc đằng sau thế là hỏng hết. Có khi chạy tầm bậy nữa

Bác Bình và ketxu thử sử dụng code này nhá :

(defun c:kt(/ font)
 (setq font "tue.shx")
 (command "-style" "KCVN-COM" font)
 (if (= (getvar "cmdactive") 1)
  (progn (command 0 1 0 "" "" "")
	  (alert (strcat "May cua ban co Font" font))
)
	(alert (strcat "\n Khong co Font " font))
 )
)

@ketxu : Thử thay dòng này

(setq font "tue.shx")

bằng dòng (setq font "vnsimple.shx")

thử xem

Còn gán vậy nó mà không có thì lisp chả chạy nữa, nằm nghỉ mệt.

@Bác Bình :

Lisp nó dai sức lắm bác ạ. Nó vẫn chạy tiếp tục và chạy tầm bậy. Đôi lúc chạy sai, có khi nó thiết lập không đúng ý của mình nữa

Nên ta mới đi kiểm tra, làm tường rào, chặn Lisp lại, không cho nó chạy nữa, hề hề...

[ketxu 2.984]

Ý em là tạo hàm con để nó sử dụng ngay trong code ý ạ ^^

[Tue_NV 3.912]

Ý em là tạo hàm con để nó sử dụng ngay trong code ý ạ ^^

Trong code mà Tue_NV viết ở trên

bạn thay dòng :

(defun c:kt(/ font)

thành dòng

(defun kt(font) : là ra hàm con liền à

Hoặc là sử dụng code này :

(defun kt(font / OK)
;copyright by Tue_NV
;(setq font "tue.shx")
(setvar "cmdecho" 0)
(command "undo" "m")
  (command "-style" "" font)
  (if (= (getvar "cmdactive") 1)
    (if (= (strcase (substr font (- (strlen font) 3) 4)) ".SHX")
        	(progn (command "" "" "" "" "" "") (setq OK T))
            (if (= (strcase (substr font (- (strlen font) 3) 4)) ".TTF")
        	(progn (command "" "" "" "" "") (setq OK T))
    )
     )
(setq OK nil)
  )
(command "undo" "b")
OK
)

(kt "vnsimple.shx") -> Return : T nếu máy bạn có cài "vnsimple.shx". Return nil nếu ếu máy bạn không cài "vnsimple.shx".

Bạn thử các font còn lại trên máy bạn và không có trên máy bạn xem kết quả nhé.

Thú vị đấy chứ.

[phamthanhbinh 3.146]

Ý em là tạo hàm con để nó sử dụng ngay trong code ý ạ ^^

Để biến cái lisp trên thành hàm con được sử dụng luôn trong hàm chính tạo đmstyle, bạn phải thay (defun c:kt (....) .............) thành (defun kt (...).......)

đồng thời bạn phải gán giá trị cho các trường hợp có và không có cái font cần kiểm bằng cách thay các hàm (alert .....) bằng các hàm (setq q .....)

Sau đó trong hàm chính bạn có thể gọi các biến này ra mà xử.

Tất nhiên như vậy thì các biến sẽ dùng trong hàm chính phải là biến toàn cục bạn nhé và khi gọi hàm kt này bạn phải gọi đủ các biến toàn cục này...

Chúc bạn vui.

@ Bác Tue_NV: hề hề hề.... Cám ơn bác đã hướng dẫn tận tình. Mình còn nhiều cái chưa hiểu hết khi dùng lisp lắm bác à. Mong được bác hỗ trợ dài dài.....

[ketxu 2.984]

Thank bác ThanhBinh nhiều code đã chạy ngon rồi.

Mọi người có thể download code này về dùng xem nếu lỗi thì báo lại cho mình.

;; free lisp from cadviet.com

(defun c:vetuong ()
(command "trim" "" "e" "e" "p" "n" "")
(command "undo" "be")
(setvar "cmdecho" 0)
(setq old_layer (getvar "clayer"))
(setq snap (getvar "osmode"))
(setq hl (getvar "highlight"))
(setq tbl (tblsearch "layer" "tuong"))
(if (= tbl nil) (command "-layer" "n" "tuong" "c" "4" "tuong" ""))
(setq tbl (tblsearch "layer" "_tim"))
(if (= tbl nil) (command "-layer" "n" "_tim" "c" "8" "_tim" "l" "center" "_tim" ""))
(setq tbl (tblsearch "layer" "template"))
(if (= tbl nil) (command "-layer" "n" "template" "c" "0" "template" ""))
(setvar "clayer" "template")
(setvar "osmode" 0)
(setq ss (ssget '((0 . "line"))))
(command "change" ss "" "p" "la" "_tim" "")
(setq day (getint "\nnhap chieu day tuong:"))
(setq day1 (/ (* day 7) 15))
(setq i 0)
(setq lp nil)
(setq ssml nil)
(setq ssml (ssadd))
(while ((setq name (ssname ss i)
ent (entget name)
p1 (cdr (assoc 10 ent))
p2 (cdr (assoc 11 ent))
lp (append (list (append (list p1) (list p2))) lp)
)
(command "mline" "j" "z" "s" day p1 p2 "")
(command "explode" "l")
(setq ssline (ssget "p"))
(setq line1 (ssname ssline 0))
(setq line2 (ssname ssline 1))
(setq ssml (ssadd line1 (ssadd line2 ssml)))
(setq i (1+ i))
)
(command "-layer" "off" "_tim" "")
(setq j 0)
(setvar "highlight" 0)
(while ((setq ssml (ssget "x" '((0 . "line") (8 . "template"))))
(setq nhom (nth j lp)
pt1 (car nhom)
pt2 (last nhom)
angf (+ (angle pt1 pt2) (/ pi 2))
t1 (polar pt1 angf day1)
t2 (polar pt1 (+ angf pi) day1)
t3 (polar pt2 (+ angf pi) day1)
t4 (polar pt2 angf day1)
)
(command "trim" ssml "" "f" t1 t2 t3 t4 t1 "" "")
(setq j (1+ j))
)
(setq q 0)
(while ((setq l1 (ssname ssml q)
pf1 (cdr (assoc 10 (entget l1)))
pf2 (cdr (assoc 11 (entget l1)))
)
(setq k 0)
(while ((setq l2 (ssname ssml k)
pf3 (cdr (assoc 10 (entget l2)))
pf4 (cdr (assoc 11 (entget l2)))
d1 (distance pf1 pf3)
d2 (distance pf1 pf4)
d3 (distance pf2 pf3)
d4 (distance pf2 pf4)
)
(if (or (and ( d1 0)) (and ( d2 0)) 
        (and ( d3 0)) (and ( d4 0)))
(command "fillet" l1 l2)
)
(setq k (1+ k))
)
(setq q (1+ q))
)
(command "change" ssml "" "p" "la" "tuong" "")
(setvar "clayer" old_layer)
(command "-layer" "on" "_tim" "")
(setvar "osmode" snap)
(setvar "highlight" hl)
(setvar "cmdecho" 1)
(command "undo" "e")
(command "trim" "" "e" "n" "")
)

Hôm trước test code đã chuẩn rồi,mà hnay e test kiểu j cũng hok được.Nó chẳng fill tẹo nào bên ngoài,mà có những đường temp cũng k chuyển về hết.K hiểu là máy lỗi haylại xung đột j chăng.Bác test lại hộ e với nhé.Mà,lần đầu chạy lsp lúc nào cũng hiện ra command new layer,phải esc đi chạy lại thì mới hết :(

[phamthanhbinh 3.146]

Hôm trước test code đã chuẩn rồi,mà hnay e test kiểu j cũng hok được.Nó chẳng fill tẹo nào bên ngoài,mà có những đường temp cũng k chuyển về hết.K hiểu là máy lỗi haylại xung đột j chăng.Bác test lại hộ e với nhé.Mà,lần đầu chạy lsp lúc nào cũng hiện ra command new layer,phải esc đi chạy lại thì mới hết :(

Hề hề hề,

Mình test thấy vẫn còn có chỗ nó bị lộn tiệm, trim thì sót, fillet thì nhầm. Tuy nhiên chưa biết cách chữa bác ạ, Mong bác cứ từ từ mà dùng bác ạ....

[phamngoctukts 714]

Hề hề hề,

Mình test thấy vẫn còn có chỗ nó bị lộn tiệm, trim thì sót, fillet thì nhầm. Tuy nhiên chưa biết cách chữa bác ạ, Mong bác cứ từ từ mà dùng bác ạ....

Chết thật hôm up lộn code rồi xin lỗi các bạn. Các bác test lại xem.

;; free lisp from cadviet.com
(defun c:vetuong ()
(command "trim" "" "e" "e" "p" "n" "")
(command "undo" "be")
(setvar "cmdecho" 0)
(setq old_layer (getvar "clayer"))
(setq snap (getvar "osmode"))
(setq hl (getvar "highlight"))
(setq tbl (tblsearch "layer" "tuong"))
(if (= tbl nil) (command "-layer" "n" "tuong" "c" "4" "tuong" ""))
(setq tbl (tblsearch "layer" "_tim"))
(if (= tbl nil) (command "-layer" "n" "_tim" "c" "8" "_tim" "l" "center" "_tim" ""))
(setq tbl (tblsearch "layer" "template"))
(if (= tbl nil) (command "-layer" "n" "template" ""))
(setvar "clayer" "template")
(setvar "osmode" 0)
(setq ss (ssget '((0 . "line"))))
(setq day (cond (day) (220)))
(setq oldday day)
(setq day (getint (strcat "\nnhap chieu day tuong <"(rtos oldday 2 1)"> : ")))
(if (null day)
(setq day oldday)
)
(setq day1 (/ (* day 7) 15))
(command "change" ss "" "p" "la" "_tim" "")
(setq i 0)
(setq lp nil)
(setq ssml nil)
(setq ssml (ssadd))
(while (< i (sslength ss))
(setq name (ssname ss i)
ent (entget name)
p1 (cdr (assoc 10 ent))
p2 (cdr (assoc 11 ent))
lp (append (list (append (list p1) (list p2))) lp)
)
(command "mline" "j" "z" "s" day p1 p2 "")
(command "explode" "l")
(setq ssline (ssget "p"))
(setq line1 (ssname ssline 0))
(setq line2 (ssname ssline 1))
(setq ssml (ssadd line1 (ssadd line2 ssml)))
(setq i (1+ i))
)
(command "-layer" "off" "_tim" "")
(setq j 0)
(setvar "highlight" 0)
(while (< j (length lp))
(setq nhom (nth j lp)
pt1 (car nhom)
pt2 (last nhom)
angf (+ (angle pt1 pt2) (/ pi 2))
t1 (polar pt1 angf day1)
t2 (polar pt1 (+ angf pi) day1)
t3 (polar pt2 (+ angf pi) day1)
t4 (polar pt2 angf day1)
)
(command "trim" ssml "" "f" t1 t2 t3 t4 t1 "" "")
(setq j (1+ j))
)
(setq q 0)
(setq ssml (ssget "x" '((0 . "line") (8 . "template"))))
(while (< q (sslength ssml))
(setq l1 (ssname ssml q)
pf1 (cdr (assoc 10 (entget l1)))
pf2 (cdr (assoc 11 (entget l1)))
)
(setq k 0)
(while (< k (sslength ssml))
(setq l2 (ssname ssml k)
pf3 (cdr (assoc 10 (entget l2)))
pf4 (cdr (assoc 11 (entget l2)))
d1 (distance pf1 pf3)
d2 (distance pf1 pf4)
d3 (distance pf2 pf3)
d4 (distance pf2 pf4)
)
(if (or (and (< (fix d1) (* day1 2)) (> d1 0)) (and (< (fix d2) (* day1 2)) (> d2 0)) (and (< (fix d3) (* day1 2)) (> d3 0)) 

(and (< (fix d4) (* day1 2)) (> d4 0)))
(command "fillet" l1 l2)
)
(setq k (1+ k))
)
(setq q (1+ q))
)
(command "change" ssml "" "p" "la" "tuong" "")
(dimtuong)
(setvar "clayer" old_layer)
(command "-layer" "on" "_tim" "")
(setvar "osmode" snap)
(setvar "highlight" hl)
(setvar "cmdecho" 1)
(command "undo" "e")
(command "trim" "" "e" "n" "")
)
;******************************************
(defun c:vt ()
(command "trim" "" "e" "e" "p" "n" "")
(command "undo" "be")
(setvar "cmdecho" 0)
(setq old_layer (getvar "clayer"))
(setq snap (getvar "osmode"))
(setvar "clayer" "tuong")
(setq dt (cond (dt) (220)))
(setq olddt dt)
(setq dt (getint (strcat "\nrong tuong <"(rtos olddt 2 1)"> : ")))
(if (null dt)
(setq dt olddt)
)
(setq pt1 (getpoint "\ndiem thu nhat:")
pt2 (getpoint "\ndiem thu hai:" pt1)
)
(setvar "osmode" 0)
(command "-layer" "off" "_tim" "")
(command "mline" "j" "z" "s" dt pt1 pt2 "")
(setq mll (entlast))
(command "trim" mll "" "f" pt1 pt2 "" "")
(command "explode" mll)
(setvar "osmode" snap)
(setvar "clayer" old_layer)
(command "-layer" "on" "_tim" "")
(setvar "cmdecho" 1)
(command "trim" "" "e" "n" "")
)
;*****************************************
(defun c:vc ()
(setvar "cmdecho" 0)
(setq old_layer (getvar "clayer"))
(setq snap (getvar "osmode"))
(setvar "clayer" "tuong")
(setq cua (cond (cua) (900)))
(setq oldcua cua)
(setq cua (getint (strcat "\nrong cua <"(rtos oldcua 2 1)"> : ")))
(if (null cua)
(setq cua oldcua)
)
(setq pc1 (getpoint "\ndiem thu nhat:")
pc2 (getpoint "\ndiem thu hai:" pc1)
ang (+ (angle pc1 pc2) (/ (* 90 pi) 180))
pc3 (polar pc1 ang (+ 110 (/ cua 2)))
pc4 (polar pc2 ang (+ 110 (/ cua 2)))
)
(setvar "osmode" 0)
(command "-layer" "off" "_tim" "")
(command "mline" "j" "z" "s" cua pc3 pc4 "")
(setq mll (entlast))
(command "trim" mll "" "f" pc3 pc4 "" "")
(command "explode" mll)
(setvar "osmode" snap)
(setvar "clayer" old_layer)
(command "-layer" "on" "_tim" "")
(setvar "cmdecho" 1)
)
;*****************************************
(defun dimtuong ()
(setq tbl (tblsearch "layer" "_dim"))
(if (= tbl nil) (command "-layer" "n" "_dim" "c" "8" "_dim" ""))
(setvar "clayer" "_dim")
(setq a 0)
(setq lpx nil)
(setq lpy nil)
(while (< a (length lp))
(setq px1 (car (car (nth a lp)))
py1 (cadr (car (nth a lp)))
px2 (car (cadr (nth a lp)))
py2 (cadr (cadr (nth a lp)))
)
(if (/= py1 py2)
(setq lpx (append (list px1) lpx))
)
(if (= py1 py2)
(setq lpy (append (list py1) lpy))
)
(setq a (1+ a))
)
(setq lpx (vl-sort lpx '<))
(setq lpy (vl-sort lpy '<))
(setq dc (- (last lpx) (car lpx)))
(setq pdi (list (car lpx) (- (car lpy) (/ dc 30)) 0))
(setq pdim (polar pdi pi  (/ day 2)))
(setq pdim1 (polar pdi (/ (* pi 3) 2) (/ dc 15)))
(command "_dimlinear" pdi pdim pdim1)
(setq c 0)
(while (< (1+ c) (length lpx))
(setq y (cadr pdim)
x1 (nth c lpx)
x2 (nth (1+ c) lpx)
dd1 (list x1 y 0)
dd2 (list x2 y 0)
)
(command "_dimlinear" dd1 dd2 pdim1)
(setq c (1+ c))
)
(setq pcc (polar dd2 0 (/ day 2)))
(command "_dimlinear" dd2 pcc pdim1)
(command "_dimlinear" pdim pcc (polar pdim1 (/ (* pi 3) 2) (/ dc 40)))
)

Bạn cho mình hỏi code này sai ở chỗ nào mà nó báo lỗi (setq tldim (last (assoc 40 (tblsearch "dimstyle" "1")))). Mình có dim tên là 1 và muốn lấy overall scale của nó. mình dùng mã 140 lấy cao chũ cũng không được.

[phamthanhbinh 3.146]

Chết thật hôm up lộn code rồi xin lỗi các bạn. Các bác test lại xem.

;; free lisp from cadviet.com
(defun c:vetuong ()
(command "trim" "" "e" "e" "p" "n" "")
(command "undo" "be")
(setvar "cmdecho" 0)
(setq old_layer (getvar "clayer"))
(setq snap (getvar "osmode"))
(setq hl (getvar "highlight"))
(setq tbl (tblsearch "layer" "tuong"))
(if (= tbl nil) (command "-layer" "n" "tuong" "c" "4" "tuong" ""))
(setq tbl (tblsearch "layer" "_tim"))
(if (= tbl nil) (command "-layer" "n" "_tim" "c" "8" "_tim" "l" "center" "_tim" ""))
(setq tbl (tblsearch "layer" "template"))
(if (= tbl nil) (command "-layer" "n" "template" ""))
(setvar "clayer" "template")
(setvar "osmode" 0)
(setq ss (ssget '((0 . "line"))))
(setq day (cond (day) (220)))
(setq oldday day)
(setq day (getint (strcat "\nnhap chieu day tuong  : ")))
(if (null day)
(setq day oldday)
)
(setq day1 (/ (* day 7) 15))
(command "change" ss "" "p" "la" "_tim" "")
(setq i 0)
(setq lp nil)
(setq ssml nil)
(setq ssml (ssadd))
(while ((setq name (ssname ss i)
ent (entget name)
p1 (cdr (assoc 10 ent))
p2 (cdr (assoc 11 ent))
lp (append (list (append (list p1) (list p2))) lp)
)
(command "mline" "j" "z" "s" day p1 p2 "")
(command "explode" "l")
(setq ssline (ssget "p"))
(setq line1 (ssname ssline 0))
(setq line2 (ssname ssline 1))
(setq ssml (ssadd line1 (ssadd line2 ssml)))
(setq i (1+ i))
)
(command "-layer" "off" "_tim" "")
(setq j 0)
(setvar "highlight" 0)
(while ((setq nhom (nth j lp)
pt1 (car nhom)
pt2 (last nhom)
angf (+ (angle pt1 pt2) (/ pi 2))
t1 (polar pt1 angf day1)
t2 (polar pt1 (+ angf pi) day1)
t3 (polar pt2 (+ angf pi) day1)
t4 (polar pt2 angf day1)
)
(command "trim" ssml "" "f" t1 t2 t3 t4 t1 "" "")
(setq j (1+ j))
)
(setq q 0)
(setq ssml (ssget "x" '((0 . "line") (8 . "template"))))
(while ((setq l1 (ssname ssml q)
pf1 (cdr (assoc 10 (entget l1)))
pf2 (cdr (assoc 11 (entget l1)))
)
(setq k 0)
(while ((setq l2 (ssname ssml k)
pf3 (cdr (assoc 10 (entget l2)))
pf4 (cdr (assoc 11 (entget l2)))
d1 (distance pf1 pf3)
d2 (distance pf1 pf4)
d3 (distance pf2 pf3)
d4 (distance pf2 pf4)
)
(if (or (and ( d1 0)) (and ( d2 0)) 
        (and ( d3 0)) (and ( d4 0)))
(command "fillet" l1 l2)
)
(setq k (1+ k))
)
(setq q (1+ q))
)
(command "change" ssml "" "p" "la" "tuong" "")
(dimtuong)
(setvar "clayer" old_layer)
(command "-layer" "on" "_tim" "")
(setvar "osmode" snap)
(setvar "highlight" hl)
(setvar "cmdecho" 1)
(command "undo" "e")
(command "trim" "" "e" "n" "")
)
;******************************************
(defun c:vt ()
(command "trim" "" "e" "e" "p" "n" "")
(command "undo" "be")
(setvar "cmdecho" 0)
(setq old_layer (getvar "clayer"))
(setq snap (getvar "osmode"))
(setvar "clayer" "tuong")
(setq dt (cond (dt) (220)))
(setq olddt dt)
(setq dt (getint (strcat "\nrong tuong  : ")))
(if (null dt)
(setq dt olddt)
)
(setq pt1 (getpoint "\ndiem thu nhat:")
pt2 (getpoint "\ndiem thu hai:" pt1)
)
(setvar "osmode" 0)
(command "-layer" "off" "_tim" "")
(command "mline" "j" "z" "s" dt pt1 pt2 "")
(setq mll (entlast))
(command "trim" mll "" "f" pt1 pt2 "" "")
(command "explode" mll)
(setvar "osmode" snap)
(setvar "clayer" old_layer)
(command "-layer" "on" "_tim" "")
(setvar "cmdecho" 1)
(command "trim" "" "e" "n" "")
)
;*****************************************
(defun c:vc ()
(setvar "cmdecho" 0)
(setq old_layer (getvar "clayer"))
(setq snap (getvar "osmode"))
(setvar "clayer" "tuong")
(setq cua (cond (cua) (900)))
(setq oldcua cua)
(setq cua (getint (strcat "\nrong cua  : ")))
(if (null cua)
(setq cua oldcua)
)
(setq pc1 (getpoint "\ndiem thu nhat:")
pc2 (getpoint "\ndiem thu hai:" pc1)
ang (+ (angle pc1 pc2) (/ (* 90 pi) 180))
pc3 (polar pc1 ang (+ 110 (/ cua 2)))
pc4 (polar pc2 ang (+ 110 (/ cua 2)))
)
(setvar "osmode" 0)
(command "-layer" "off" "_tim" "")
(command "mline" "j" "z" "s" cua pc3 pc4 "")
(setq mll (entlast))
(command "trim" mll "" "f" pc3 pc4 "" "")
(command "explode" mll)
(setvar "osmode" snap)
(setvar "clayer" old_layer)
(command "-layer" "on" "_tim" "")
(setvar "cmdecho" 1)
)
;*****************************************
(defun dimtuong ()
(setq tbl (tblsearch "layer" "_dim"))
(if (= tbl nil) (command "-layer" "n" "_dim" "c" "8" "_dim" ""))
(setvar "clayer" "_dim")
(setq a 0)
(setq lpx nil)
(setq lpy nil)
(while ((setq px1 (car (car (nth a lp)))
py1 (cadr (car (nth a lp)))
px2 (car (cadr (nth a lp)))
py2 (cadr (cadr (nth a lp)))
)
(if (/= py1 py2)
(setq lpx (append (list px1) lpx))
)
(if (= py1 py2)
(setq lpy (append (list py1) lpy))
)
(setq a (1+ a))
)
(setq lpx (vl-sort lpx '(setq lpy (vl-sort lpy '(setq dc (- (last lpx) (car lpx)))
(setq pdi (list (car lpx) (- (car lpy) (/ dc 30)) 0))
(setq pdim (polar pdi pi  (/ day 2)))
(setq pdim1 (polar pdi (/ (* pi 3) 2) (/ dc 15)))
(command "_dimlinear" pdi pdim pdim1)
(setq c 0)
(while ((setq y (cadr pdim)
x1 (nth c lpx)
x2 (nth (1+ c) lpx)
dd1 (list x1 y 0)
dd2 (list x2 y 0)
)
(command "_dimlinear" dd1 dd2 pdim1)
(setq c (1+ c))
)
(setq pcc (polar dd2 0 (/ day 2)))
(command "_dimlinear" dd2 pcc pdim1)
(command "_dimlinear" pdim pcc (polar pdim1 (/ (* pi 3) 2) (/ dc 40)))
)

Bạn cho mình hỏi code này sai ở chỗ nào mà nó báo lỗi (setq tldim (last (assoc 40 (tblsearch "dimstyle" "1")))). Mình có dim tên là 1 và muốn lấy overall scale của nó. mình dùng mã 140 lấy cao chũ cũng không được.

Hề hề hề,

Chào bác Phamngoctukts,

Hàm (last list) trả về phần tử cuối cùng của một danh sách, nhưng cái danh sách ấy không phải là một asociation list bác ạ.

Khi bác gọi (assoc 40 (tblsearch "dímtyle" "1")) Thì nó trả về một association list là (40 . 1.5) chẳng hạn. Vì thế hàm last nó sẽ trả lời là: ; error : bad lisst 1.5 . Cũng tương tự khi bác lấy chiếu cao text ở mã 140.

Theo mình bác co thể thay hàm last bằng hàm (cdr (assoc 40 (tblsearch ........))) bác ạ. Với các asociation list thì thường sử dụng hàm cdr để lấy giá trị của phần tử tuong tác thứ hai bác ạ. Trong association list thì chỉ có hai phần tử và được tương tác với nhau qua dấu chấm và còn gọi là dot pair list bác à.

Hề hề hề, chúc bác vui.

[phamthanhbinh 3.146]

Lisp này khi mình chọn chiều tăng của text là phải thì nó đánh từ trên xuống dưới,bạn có thể sửa lại khi chọn chiều tăng là phải thì nó cũng đánh từ dưới lên trên giống như chiều tăng trái được không .Chân thành cảm ơn trước.

Chào 790312,

Lisp này sở dĩ phải chọn chiếu là do yêu cầu của người dùng. Nếu bạn không muốn việc chọn chiều này thì chỉ đơn giản là bạn hãy bỏ đoạn code chọn chiều đi mà thôi.

Bạn cũng là một thành viên khá có thâm niên rồi, Hy vọng bạn sẽ tự sửa được. Nếu có khó khăn hãy post lên bạn nhé.

[ketxu 2.984]

Chết thật hôm up lộn code rồi xin lỗi các bạn. Các bác test lại xem.

;; free lisp from cadviet.com
(defun c:vetuong ()
(command "trim" "" "e" "e" "p" "n" "")
(command "undo" "be")
(setvar "cmdecho" 0)
(setq old_layer (getvar "clayer"))
(setq snap (getvar "osmode"))
(setq hl (getvar "highlight"))
(setq tbl (tblsearch "layer" "tuong"))
(if (= tbl nil) (command "-layer" "n" "tuong" "c" "4" "tuong" ""))
(setq tbl (tblsearch "layer" "_tim"))
(if (= tbl nil) (command "-layer" "n" "_tim" "c" "8" "_tim" "l" "center" "_tim" ""))
(setq tbl (tblsearch "layer" "template"))
(if (= tbl nil) (command "-layer" "n" "template" ""))
(setvar "clayer" "template")
(setvar "osmode" 0)
(setq ss (ssget '((0 . "line"))))
(setq day (cond (day) (220)))
(setq oldday day)
(setq day (getint (strcat "\nnhap chieu day tuong  : ")))
(if (null day)
(setq day oldday)
)
(setq day1 (/ (* day 7) 15))
(command "change" ss "" "p" "la" "_tim" "")
(setq i 0)
(setq lp nil)
(setq ssml nil)
(setq ssml (ssadd))
(while ((setq name (ssname ss i)
ent (entget name)
p1 (cdr (assoc 10 ent))
p2 (cdr (assoc 11 ent))
lp (append (list (append (list p1) (list p2))) lp)
)
(command "mline" "j" "z" "s" day p1 p2 "")
(command "explode" "l")
(setq ssline (ssget "p"))
(setq line1 (ssname ssline 0))
(setq line2 (ssname ssline 1))
(setq ssml (ssadd line1 (ssadd line2 ssml)))
(setq i (1+ i))
)
(command "-layer" "off" "_tim" "")
(setq j 0)
(setvar "highlight" 0)
(while ((setq nhom (nth j lp)
pt1 (car nhom)
pt2 (last nhom)
angf (+ (angle pt1 pt2) (/ pi 2))
t1 (polar pt1 angf day1)
t2 (polar pt1 (+ angf pi) day1)
t3 (polar pt2 (+ angf pi) day1)
t4 (polar pt2 angf day1)
)
(command "trim" ssml "" "f" t1 t2 t3 t4 t1 "" "")
(setq j (1+ j))
)
(setq q 0)
(setq ssml (ssget "x" '((0 . "line") (8 . "template"))))
(while ((setq l1 (ssname ssml q)
pf1 (cdr (assoc 10 (entget l1)))
pf2 (cdr (assoc 11 (entget l1)))
)
(setq k 0)
(while ((setq l2 (ssname ssml k)
pf3 (cdr (assoc 10 (entget l2)))
pf4 (cdr (assoc 11 (entget l2)))
d1 (distance pf1 pf3)
d2 (distance pf1 pf4)
d3 (distance pf2 pf3)
d4 (distance pf2 pf4)
)
(if (or (and ( d1 0)) (and ( d2 0)) 
        (and ( d3 0)) (and ( d4 0)))
(command "fillet" l1 l2)
)
(setq k (1+ k))
)
(setq q (1+ q))
)
(command "change" ssml "" "p" "la" "tuong" "")
(dimtuong)
(setvar "clayer" old_layer)
(command "-layer" "on" "_tim" "")
(setvar "osmode" snap)
(setvar "highlight" hl)
(setvar "cmdecho" 1)
(command "undo" "e")
(command "trim" "" "e" "n" "")
)
;******************************************
(defun c:vt ()
(command "trim" "" "e" "e" "p" "n" "")
(command "undo" "be")
(setvar "cmdecho" 0)
(setq old_layer (getvar "clayer"))
(setq snap (getvar "osmode"))
(setvar "clayer" "tuong")
(setq dt (cond (dt) (220)))
(setq olddt dt)
(setq dt (getint (strcat "\nrong tuong  : ")))
(if (null dt)
(setq dt olddt)
)
(setq pt1 (getpoint "\ndiem thu nhat:")
pt2 (getpoint "\ndiem thu hai:" pt1)
)
(setvar "osmode" 0)
(command "-layer" "off" "_tim" "")
(command "mline" "j" "z" "s" dt pt1 pt2 "")
(setq mll (entlast))
(command "trim" mll "" "f" pt1 pt2 "" "")
(command "explode" mll)
(setvar "osmode" snap)
(setvar "clayer" old_layer)
(command "-layer" "on" "_tim" "")
(setvar "cmdecho" 1)
(command "trim" "" "e" "n" "")
)
;*****************************************
(defun c:vc ()
(setvar "cmdecho" 0)
(setq old_layer (getvar "clayer"))
(setq snap (getvar "osmode"))
(setvar "clayer" "tuong")
(setq cua (cond (cua) (900)))
(setq oldcua cua)
(setq cua (getint (strcat "\nrong cua  : ")))
(if (null cua)
(setq cua oldcua)
)
(setq pc1 (getpoint "\ndiem thu nhat:")
pc2 (getpoint "\ndiem thu hai:" pc1)
ang (+ (angle pc1 pc2) (/ (* 90 pi) 180))
pc3 (polar pc1 ang (+ 110 (/ cua 2)))
pc4 (polar pc2 ang (+ 110 (/ cua 2)))
)
(setvar "osmode" 0)
(command "-layer" "off" "_tim" "")
(command "mline" "j" "z" "s" cua pc3 pc4 "")
(setq mll (entlast))
(command "trim" mll "" "f" pc3 pc4 "" "")
(command "explode" mll)
(setvar "osmode" snap)
(setvar "clayer" old_layer)
(command "-layer" "on" "_tim" "")
(setvar "cmdecho" 1)
)
;*****************************************
(defun dimtuong ()
(setq tbl (tblsearch "layer" "_dim"))
(if (= tbl nil) (command "-layer" "n" "_dim" "c" "8" "_dim" ""))
(setvar "clayer" "_dim")
(setq a 0)
(setq lpx nil)
(setq lpy nil)
(while ((setq px1 (car (car (nth a lp)))
py1 (cadr (car (nth a lp)))
px2 (car (cadr (nth a lp)))
py2 (cadr (cadr (nth a lp)))
)
(if (/= py1 py2)
(setq lpx (append (list px1) lpx))
)
(if (= py1 py2)
(setq lpy (append (list py1) lpy))
)
(setq a (1+ a))
)
(setq lpx (vl-sort lpx '(setq lpy (vl-sort lpy '(setq dc (- (last lpx) (car lpx)))
(setq pdi (list (car lpx) (- (car lpy) (/ dc 30)) 0))
(setq pdim (polar pdi pi  (/ day 2)))
(setq pdim1 (polar pdi (/ (* pi 3) 2) (/ dc 15)))
(command "_dimlinear" pdi pdim pdim1)
(setq c 0)
(while ((setq y (cadr pdim)
x1 (nth c lpx)
x2 (nth (1+ c) lpx)
dd1 (list x1 y 0)
dd2 (list x2 y 0)
)
(command "_dimlinear" dd1 dd2 pdim1)
(setq c (1+ c))
)
(setq pcc (polar dd2 0 (/ day 2)))
(command "_dimlinear" dd2 pcc pdim1)
(command "_dimlinear" pdim pcc (polar pdim1 (/ (* pi 3) 2) (/ dc 40)))
)

Bạn cho mình hỏi code này sai ở chỗ nào mà nó báo lỗi (setq tldim (last (assoc 40 (tblsearch "dimstyle" "1")))). Mình có dim tên là 1 và muốn lấy overall scale của nó. mình dùng mã 140 lấy cao chũ cũng không được.

E lại test tiếp code của bác đây.Tình hình gặp phải là thế này ^^:

- Bác vẫn để getint,không có hỗ trợ set tỉ lệ bản vẽ vào,nên có lẽ dân kết cấu bọn e chỉ ứng dụng được khi dùng layout

- Cũng vì k tính đến tỉ lệ,nên xảy ra trường hợp là khi bề rộng tường quá nhỏ (khi vẽ với tỉ lệ khác,chẳng hạn 1:100 chẳng hạn,rồi bề rộng tường lấy à 300,thì khi nhập vào bề rộng tường là 3(nhỏ hơn 5)) thì lisp chạy sai.Hoặc là k trim,hoặc là không fillet

- Khi không có cạnh nào của trục song song với Ox thì dim bị vô hiệu

- Hàm thực hiện xong không trả osnap lại :(

- Với lại e chưa biết sự lợi hại của hàm vt và vc,vì lúc nào ecũng thấy nó vẽ ra 2 đường song song ^^

[ketxu 2.984]

Các bác cho e hỏi cách lấy cross selection từ trái qua của 2 tọa độ góc.E định lấy tập hợp tất cả đối tượng trong 1 hình CN ấy mà.Chắc cái này chỉ cần quét 1 phát là được.Còn tương lai là e muốn chọn tất cả các tập hợp đối tượng trong 1 hình pl khép kín,hoặc tròn chẳng hạn.Dùng selection theo wpolygon được không ạ (các đối tượng này đã bị tách rời với bên ngoài bởi lệnh extrim).Với hình góc cạnh thì còn lấy được các điểm mút,chứ hình tròn thì :(..

Nếu được 1lsp mẫu thì tốt quá :">

PS : Tiện cho e hỏi ngoài lề 1 chút,là e nghịch ngợm option thế nào mà giờ chọn đối tượng nó không bị mờ mờ như nét đứt nữa nhỉ :|

[phamngoctukts 714]

PS : Tiện cho e hỏi ngoài lề 1 chút,là e nghịch ngợm option thế nào mà giờ chọn đối tượng nó không bị mờ mờ như nét đứt nữa nhỉ :|

Đó là do dùng code vẽ tường của mình. Vì mình chưa hoàn thiện nên chưa đặt hàm bẫy lỗi vào.

bạn dùng cái này thì nó sẽ như cũ (setvar "highlight" 1). Thế là biết thêm một biến hệ thống mới rồi nhé.

bs: để chọn các đối tượng trong một đa giác có các đỉnh p1 p2 p3 p4 ... pn. dùng (ssget "wp" p1 p2 p3 p4 ... pn) chuc bạn vui.