Chuyển đến nội dung
Diễn đàn CADViet
Nguyen Van Hiep19

Nhờ Viết Lisp Tạo Text

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

Chào các tiền bối

Em có ý tưởng như thế này mong các tiền bối cụ thể hoá giúp em 1 lisp kết hợp từ 2 lisp bên dưới giúp em với ạ

B1: Chọn đối tượng thép đai (PLine)

B2: Nhập kí hiệu thanh thép(ví dụ Nhập 2)

B3: Nhập đường kính (Ví dụ nhập 10)

B4: Nhập Khoảng cách rãi đai ( Ví dụ nhập 150)

B5: Chọn đối tượng Dimension (Lấy ra giá trị Length của Dimension ví dụ L=3000) tính ra số thanh 3000/150=20

B6: Nhập chiều cao text mặt định 100

B7: Tạo ra 1 text như sau : [2]-20d10a150-L=3000

B8: Click vào điểm đặt text

 

RTS_RAI_THEP_SAN.rar

z1.lsp

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
(defun C:00	(/ DAITHEP NDUNG OBJTHEPDAI PNTDAT)
	(vl-load-com)
	(defun *error* (msg)
		(if	Olmode
			(setvar 'osmode Olmode)
		)
		(if	(not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
			(princ (strcat "\nError: " msg))
		)
		(princ)
	)
	(setvar 'CMDECHO 0)
	(setq Olmode (getvar "OSMODE"))
	(setvar "OSMODE" 0)
	(setq	ObjThepdai
				 (car
					 (LM:SelectIf
						 "\nCh\U+1ECDn th\U+00E9p \U+0111ai "
						 (lambda (x)
							 (or (eq "LWPOLYLINE" (cdr (assoc 0 (entget (car x)))))
									 (eq "POLYLINE" (cdr (assoc 0 (entget (car x)))))
									 (eq "LINE" (cdr (assoc 0 (entget (car x)))))
							 )
						 )
						 entsel
						 nil
					 )
				 )
	)
	(setq Daithep (length1 ObjThepdai))
	(setq	Kyhieuthep
				 (LM:GetXWithDefault_New
					 getstring "\nNh\U+1EADp k\U+00FD hi\U+1EC7u thanh th\U+00E9p "	'*Kyhieuthep*	"2"	nil	nil)
	)
	(setq	Duongkinh
				 (LM:GetXWithDefault_New
					 getdist "\nNh\U+1EADp \U+0111\U+01B0\U+1EDDng k\U+00EDnh "	'*Duongkinh* 10.0	nil	nil)
	)
	(setq	Kcrd
				 (LM:GetXWithDefault_New
					 getdist "\nNh\U+1EADp kho\U+1EA3ng c\U+00E1ch r\U+00E3nh \U+0111ai "	'*Kcrd*	150.0	nil	nil)
	)
	(setq	Caochu
				 (LM:GetXWithDefault_New
					 getdist "\nNh\U+1EADp kho\U+1EA3ng c\U+00E1ch r\U+00E3nh \U+0111ai "	'*Caochu*	100.0	nil	nil)
	)
	(setq	Ndung	(strcat	"["
											Kyhieuthep
											"]-"
											(rtos (/ Daithep Kcrd) 2 0)
											"d"
											(rtos Duongkinh 2 0)
											"a"
											(rtos Kcrd 2 0)
											"-L="
											(rtos Daithep 2 0)
							)
	)
	(setq PntDat (getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m ghi Text:\n"))
	(MakeText PntDat Ndung Caochu 0 "MC" nil nil nil)
	(setvar "OSMODE" Olmode)
	(princ)
)
(defun Length1 (e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
(defun MakeText	(point string Height Ang justify Layer Style Color / Lst)
																														; Ang: Radial
	(setq	Lst			(list	'(0 . "TEXT")
											(cons 10 point)
											(cons 40 Height)
											(cons	8
														(if	Layer
															Layer
															(getvar "CLAYER")
														)
											)
											(cons 1 string)
											(if	Ang
												(cons 50 Ang)
											)
											(cons	7
														(if	Style
															Style
															(getvar "Textstyle")
														)
											)
											(cons	62
														(if	Color
															Color
															256
														)
											)
								)
				justify	(strcase justify)
	)
	(cond
		((= justify "C")
		 (setq Lst (append Lst (list (cons 72 1) (cons 11 point))))
		)
		((= justify "L")
		 (setq
			 Lst
				(append Lst (list (cons 72 0) (cons 73 0) (cons 10 point)))
		 )
		)
		((= justify "R")
		 (setq Lst (append Lst (list (cons 72 2) (cons 11 point))))
		)
		((= justify "M")
		 (setq Lst (append Lst (list (cons 72 4) (cons 11 point))))
		)
		((= justify "TL")
		 (setq
			 Lst
				(append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))
		 )
		)
		((= justify "TC")
		 (setq
			 Lst
				(append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))
		 )
		)
		((= justify "TR")
		 (setq
			 Lst
				(append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))
		 )
		)
		((= justify "ML")
		 (setq
			 Lst
				(append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))
		 )
		)
		((= justify "MC")
		 (setq
			 Lst
				(append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))
		 )
		)
		((= justify "MR")
		 (setq
			 Lst
				(append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))
		 )
		)
		((= justify "BL")
		 (setq
			 Lst
				(append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))
		 )
		)
		((= justify "BC")
		 (setq
			 Lst
				(append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))
		 )
		)
		((= justify "BR")
		 (setq
			 Lst
				(append Lst (list (cons 72 2) (cons 11 point) (cons 73 1)))
		 )
		)
	)
	(entmakex Lst)
)
(defun LM:SelectIf (msg pred func keyw / sel)
	(setq pred (eval pred))
	(while
		(progn
			(setvar 'ERRNO 0)
			(if	keyw
				(apply 'initget keyw)
			)
			(setq sel (func msg))
			(cond
				((= 7 (getvar 'ERRNO))
				 (princ
					 "\nB\U+1EA1n ch\U+1ECDn sai r\U+1ED3i! H\U+00E3y ch\U+1ECDn l\U+1EA1i."
				 )
				)
				((eq 'STR (type sel))
				 nil
				)
				((vl-consp sel)
				 (if (and pred (not (pred sel)))
					 (princ "")
				 )
				)
			)
		)
	)
	sel
)

;; GetX with Default  -  Lee Mac
;; fun - [sym] Quoted user input function
;; pmt - [str] Prompt string
;; sym - [sym] Quoted function to hold default value (not 'sym)
;; def - [any] Initial default value
;; ini - [lst] [Optional] List of initget arguments
;; arg - [lst] [Optional] List of arguments for user input function
;; Returns: [any] User input or default value

;;;;;;  (LM:GetXWithDefault_New getkword "\nEnter an Option [Alpha/Beta/Gamma] " '*opt* "Alpha" '("Alpha Beta Gamma") nil)
;;;;;;  (LM:GetXWithDefault_New getstring "\nEnter a String " '*str* "Lee Mac" nil '(T))
(defun LM:GetXWithDefault_New	(_function _prompt _symbol _default _initget _args / _toString)
	(vl-load-com)
	;; © Lee Mac 2010

	(setq	_toString
				 (lambda (x)
					 (cond
						 ((eq getangle _function) (angtos x))
						 ((eq 'REAL (type x)) (rtos x))
						 ((eq 'INT (type x)) (itoa x))
						 ((vl-princ-to-string x))
					 )
				 )
	)

	(if	_initget
		(apply 'initget _initget)
	)

	(set _symbol
			 (
				(lambda	(input)
					(if	(or (not input) (eq "" input))
						(eval _symbol)
						input
					)
				)
				 (apply	'_function
								(append	_args
												(list
													(strcat	_prompt
																	"<"
																	(_toString
																		(set _symbol
																				 (cond
																					 ((eval _symbol))
																					 (_default)
																				 )
																		)
																	)
																	"> : "
													)
												)
								)
				 )
			 )
	)
)
 

Giúp bạn chút. Còn sửa như thế nào thì nhờ mng sửa. Mình tranh thủ tý thôi

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Vào lúc 19/10/2021 tại 11:47, Nguyen Van Hiep19 đã nói:

Chào các tiền bối

Em có ý tưởng như thế này mong các tiền bối cụ thể hoá giúp em 1 lisp kết hợp từ 2 lisp bên dưới giúp em với ạ

B1: Chọn đối tượng thép đai (PLine)

B2: Nhập kí hiệu thanh thép(ví dụ Nhập 2)

B3: Nhập đường kính (Ví dụ nhập 10)

B4: Nhập Khoảng cách rãi đai ( Ví dụ nhập 150)

B5: Chọn đối tượng Dimension (Lấy ra giá trị Length của Dimension ví dụ L=3000) tính ra số thanh 3000/150=20

B6: Nhập chiều cao text mặt định 100

B7: Tạo ra 1 text như sau : [2]-20d10a150-L=3000

B8: Click vào điểm đặt text

 

RTS_RAI_THEP_SAN.rar

z1.lsp

Lisp z1 của bạn (copy) đã gần với yêu cầu của bạn rồi, thêm tí là xong thôi. Chiều cao chữ thì dùng lệnh textsize để chỉnh trước khi dùng z1.

z1.lsp

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

×