Jump to content
InfoFile
Tác giả: Bee
Bài viết gốc: 408883
Tên lệnh: test
Nhờ Viết Lisp Cộng Các Số Trong Text (Hoặc Mtext) Và Output Sang Một Mtext Khác

Thank bác.

Tuy nhiên vẫn chưa đúng ý e lắm :)

+ Chỗ output bác có thể sửa giúp e thành định dạng mtext như yêu cầu ko? hiện tại bác đang để định dạng là text.

+ Một cái nữa là layer của output bác có thể lấy như layer của đối tượng đầu tiên ko? (layer của mtext...

>>

Thank bác.

Tuy nhiên vẫn chưa đúng ý e lắm :)

+ Chỗ output bác có thể sửa giúp e thành định dạng mtext như yêu cầu ko? hiện tại bác đang để định dạng là text.

+ Một cái nữa là layer của output bác có thể lấy như layer của đối tượng đầu tiên ko? (layer của mtext "2").

MTEXT đây ^_^

(defun c:test  ()
  (if (not (setq ss (ssget '((0 . "*TEXT")))))
    (princ "\nBan da khong chon TEXT.")
    (progn
      (setq n 0)
      (setq sum 0)
      (repeat (sslength ss)
        (setq value (cdr (assoc 1 (entget (ssname ss n)))))
        (setq value (ATOF value))
        (setq sum (+ sum value))
        (setq n (1+ n))
        ) ;progn
      (setq pt (getpoint "\nChon diem chen text: "))
      (entmake
        (list
          (cons 0 "MTEXT")
          (cons 100 "AcDbEntity")
          (cons 100 "AcDbMText") 
          (cons 10 (trans pt 1 0))
          (cons 40 (cdr (assoc 40 (entget (ssname ss 0)))))
          (cons 8 (cdr (assoc 8 (entget (ssname ss 0)))))
          (cons 7 (cdr (assoc 7 (entget (ssname ss 0)))))
          (cons 1 (rtos sum))
          (cons 50 0)
          )
        )
      )
    )
  (princ)
  )

<<

Filename: 408883_test.lsp
Tác giả: ketxu
Bài viết gốc: 408887
Tên lệnh: al
Nhờ Viết Lisp Cộng Các Số Trong Text (Hoặc Mtext) Và Output Sang Một Mtext Khác
Quick code xem bạn dùng cái nào thì dùng ^^
Vanilla lisp
(defun c:al(/ s kq i)
(while (not (setq s (ssget (list (cons 0 "*TEXT"))))))
(setq kq 0 i -1)
(entmake 
	(list (cons 0 "MTEXT")
	(cons 100 "AcDbEntity")
	(cons 100 "AcDbMText")
	(assoc 8 (entget (ssname s 0)))
	(cons 1
		(rtos
		(repeat (sslength s)
			(setq kq (+ kq (cond ((distof (cdr (assoc 1 (entget (ssname s (setq i (1+ i))))))))(0))))	
		))
	)
	(cons 10 (getpoint...
>>
Quick code xem bạn dùng cái nào thì dùng ^^
Vanilla lisp
(defun c:al(/ s kq i)
(while (not (setq s (ssget (list (cons 0 "*TEXT"))))))
(setq kq 0 i -1)
(entmake 
	(list (cons 0 "MTEXT")
	(cons 100 "AcDbEntity")
	(cons 100 "AcDbMText")
	(assoc 8 (entget (ssname s 0)))
	(cons 1
		(rtos
		(repeat (sslength s)
			(setq kq (+ kq (cond ((distof (cdr (assoc 1 (entget (ssname s (setq i (1+ i))))))))(0))))	
		))
	)
	(cons 10 (getpoint "\nInsert point :"))
	)
)
(princ))
- Visual lisp :
 
(defun c:vl(/ d s l lr)(vl-load-com)		
	(while (not (ssget (list (cons 0 "*TEXT")))))
	(vlax-for x 
		(setq s (vla-get-activeselectionset (setq d  (vla-get-activedocument (vlax-get-acad-object)))))
		(setq l (cons (cond ((distof (vla-get-textstring x)))(0)) l))
		(or lr (setq lr (vla-get-layer x)))
	)
	(vla-put-layer
		(vla-addmtext 
			(vla-get-block (vla-get-activelayout d))
			(vlax-3d-point (getpoint "\nInsert point :"))
			(getvar 'textsize)
			(rtos (apply '+ l))
		)
		lr
	)
	(and s (not(vla-delete s))(vlax-release-object s))
	(princ)
)
- Hoặc kết hợp với acet
(defun c:acet(/ s)
(entmake 
	(list (cons 0 "MTEXT")
	(cons 100 "AcDbEntity")
	(cons 100 "AcDbMText")	
	(cons 1 (rtos
		(apply '+ (mapcar '(lambda(x)(cond ((distof (acet-dxf 1 (entget x))))(0))) (acet-ss-to-list (setq s (ssget (list (cons 0 "*TEXT"))))))))
	)
	(assoc 8 (entget (ssname s 0)))
	(cons 10 (getpoint "\nInsert point :"))
	)
)
(princ))
Lưu ý với bạn là các code trên (kể cả của bác Bee đều k tính đến trường hợp đối tượng chọn là các Mtext có kèm mã như mã xuống dòng, layẻ, màu sắc, chiều cao ....
<<

Filename: 408887_al.lsp
Tác giả: quocmanh04tt
Bài viết gốc: 408921
Tên lệnh: tt
Nhờ Tư Vấn Lisp Chuyển Polyline Sang Arc

Tham gia 1 cái (có vẻ góc cong ổn hơn)
*** Nếu muốn để pline thì xóa dòng Explode pline->Arc
(defun c:tt (/ vertices-pl lsp lst pl)
(defun vertices-pl (e)
(if (setq e (member (assoc 10 e) e))
(cons (cdr (assoc 10 e)) (vertices-pl (cdr e)))))
(if (setq pl (car (entsel "\Pick PL")))
(progn (setq lsp (mapcar '(lambda (p) (trans p 0 1)) (vertices-pl (entget pl)))
lst (cdddr lsp))
(command "_.pline" "_none" (car lsp) "a" "s" "_none" (cadr lsp) "_none"...
>>
Tham gia 1 cái (có vẻ góc cong ổn hơn)
*** Nếu muốn để pline thì xóa dòng Explode pline->Arc
(defun c:tt (/ vertices-pl lsp lst pl)
(defun vertices-pl (e)
(if (setq e (member (assoc 10 e) e))
(cons (cdr (assoc 10 e)) (vertices-pl (cdr e)))))
(if (setq pl (car (entsel "\Pick PL")))
(progn (setq lsp (mapcar '(lambda (p) (trans p 0 1)) (vertices-pl (entget pl)))
lst (cdddr lsp))
(command "_.pline" "_none" (car lsp) "a" "s" "_none" (cadr lsp) "_none" (caddr lsp))
(while lst (command "_none" (car lst)) (setq lst (cdr lst)))
(command "")
(command "_.explode" (ssget "L")) ;Explode Pline->Arc
))
(princ))
<<

Filename: 408921_tt.lsp
Tác giả: Bee
Bài viết gốc: 408917
Tên lệnh: test
Nhờ Tư Vấn Lisp Chuyển Polyline Sang Arc

Bác Bee tìm được lisp hay ghê.

 

Em thử nghiên cứu cái lisp của bác xem.

 

Cảm ơn Bác Bee nhiều nhé.

 

Mà bác Bee ơi. Muốn làm theo cách mà bác @DuongTrungHuy thì có làm được không bác Bee nhỉ:

 

1.-...

>>

Bác Bee tìm được lisp hay ghê.

 

Em thử nghiên cứu cái lisp của bác xem.

 

Cảm ơn Bác Bee nhiều nhé.

 

Mà bác Bee ơi. Muốn làm theo cách mà bác @DuongTrungHuy thì có làm được không bác Bee nhỉ:

 

1.- Đầu tiên ta vẽ cung tròn qua 3 điểm đầu 1,2,3

2.- Tiếp đến ta vẽ cung tròn tiếp xúc với cung cũ tại 3 và đi qua điểm 4.

3.- Lại vẽ tiếp cung đi tiếp xúc với cung tròn last tại 4 và đi qia điểm 5.

4.- Cứ thế cho đến hết v.v....

 

Em cảm ơn các bác đã quan tâm đến vấn đề của em  :D

Vẫn làm đc ^_^ nhưng sẽ không chính xác 1 số góc cong. Thử cái này xem nhé.

(defun c:test (/ ss pLlst vLst n p1 p2 p3)
  (command "ucs" "name" "save" "temp")
  (command "ucs" "w")
  (if (not (setq ss (ssget '((0 . "LWPOLYLINE")))))
    (print "Ban da khong chon pline.")
    (progn
      (setq pLlst (vl-remove-if
		    'listp
		    (mapcar 'cadr (ssnamex ss))
		  )
      )
      
      (foreach pl pLlst
	(setq vLst   (mapcar 'cdr
			     (vl-remove-if-not
			       '(lambda (x) (= 10 (car x)))
			       (entget pl)
			     )
		     )
	)				;setq
	(setq n 0)
	(while (< 1 (length vLst))
	  (setq	p1 (nth n vLst)
		p2 (nth (+ n 1) vLst)
		p3 (nth (+ n 2) vLst)
	  )				;setq
	  (command "_arc" "_none" p1 "_none" p2 "_none" p3)
	  (setq vLst (cddr vLst))
	)				;while
      )					;foreach
    )					;progn
  )					;if
  (command "ucs" "name" "restore" "temp")
  (command "ucs" "name" "delete" "temp")
  (princ)
)					;defun

<<

Filename: 408917_test.lsp
Tác giả: quocmanh04tt
Bài viết gốc: 408942
Tên lệnh: tt
Nhờ Tư Vấn Lisp Chuyển Polyline Sang Arc

Thêm 1 bước làm mịn Pline (còn vấn đề kia thì tính toán phức tạp):
(defun c:tt (/ vertices-pl lsp lst pl lastEnt ss)
(defun vertices-pl (e)
(if (setq e (member (assoc 10 e) e))
(cons (cdr (assoc 10 e)) (vertices-pl (cdr e)))))
(if (and (setq pl (car (entsel "\nPick PLine"))) (eq (cdr (assoc 0 (entget pl))) "LWPOLYLINE"))
(progn (setq lsp (mapcar '(lambda (p) (trans p 0 1)) (vertices-pl (entget pl)))
lst (cdddr lsp))
(setvar 'CMDECHO 0)
(entdel pl)...
>>
Thêm 1 bước làm mịn Pline (còn vấn đề kia thì tính toán phức tạp):
(defun c:tt (/ vertices-pl lsp lst pl lastEnt ss)
(defun vertices-pl (e)
(if (setq e (member (assoc 10 e) e))
(cons (cdr (assoc 10 e)) (vertices-pl (cdr e)))))
(if (and (setq pl (car (entsel "\nPick PLine"))) (eq (cdr (assoc 0 (entget pl))) "LWPOLYLINE"))
(progn (setq lsp (mapcar '(lambda (p) (trans p 0 1)) (vertices-pl (entget pl)))
lst (cdddr lsp))
(setvar 'CMDECHO 0)
(entdel pl) ;Xoa Pline goc
(command "_.pline" "_none" (car lsp) "a" "s" "_none" (cadr lsp) "_none" (caddr lsp))
(while lst (command "_none" (car lst)) (setq lst (cdr lst)))
(command "")
(initget "Y N")
(if (eq (getkword "\nLam min Pline ? <N>:") "Y")
(progn (command "_.pedit" (ssget "L") "f" "")
(setq pl (ssget "L"))
(setq lastEnt (entlast)
ss (ssadd))
(command "_.explode" pl)
(while (setq lastEnt (entnext lastEnt)) (ssadd lastEnt ss))
(command "_.pedit" "m" ss "" "j" "" "")))))
(princ))
@Bác DuongTrungHuy: Là quy đổi điểm từ hệ tọa độ này sang hệ tọa độ kia, hàm (trans p 0 1) nằm trong mapcar như vậy thì bác biết p là gì rồi. UCS world: 0, UCS User (current ucs): 1
<<

Filename: 408942_tt.lsp
Tác giả: Bee
Bài viết gốc: 408981
Tên lệnh: t2
Sửa Lisp Thêm Dung Sai Cho Kích Thước Có Sẵn

Chào anh em trên diễn đàn.
Mình có đoạn lisp này cho phép thêm dung sai cho kích thước có sẵn.

 

(defun c:T2 () 
(command "dimtol" "on")
(command "dimtp" "0.02")
(command "dimtm" "0.02")
(command "dim" "update" pause "" "exit")
(command "dimtol" "off")
(princ)
)

 

Tuy nhiên lisp này có...

>>

Chào anh em trên diễn đàn.
Mình có đoạn lisp này cho phép thêm dung sai cho kích thước có sẵn.

 

(defun c:T2 () 
(command "dimtol" "on")
(command "dimtp" "0.02")
(command "dimtm" "0.02")
(command "dim" "update" pause "" "exit")
(command "dimtol" "off")
(princ)
)

 

Tuy nhiên lisp này có một số vấn đề như sau:
1) Lisp chỉ cho chọn một kích thước một lần, mình muốn nhờ sửa lại cho chọn đc nhiều kích thước cùng một lúc.
2) Lisp khi thực hiện sẽ chuyển dim style của kích thước về dim style hiện hành, mình muốn vẫn giữ nguyên đc dim style cũ của kích thước.
Nhờ anh em xem sửa giúp
Thanks

Lisp chua test nhe. Chắc không vấn đề ^_^

(defun c:T2 ()
  (if (setq ss (ssget '((0 . "DIMENSION"))))
    (progn
      (setq n 0)
      (repeat (sslength ss)
	(if (/= (getvar 'dimstyle) (cdr (assoc 3 (entget (ssname ss n)))))
	  (command "dimstyle" "r" (cdr (assoc 3 (entget (ssname ss n)))))
	  )
	(command "dimtol" "on")
	(command "dimtp" "0.02")
	(command "dimtm" "0.02")
	(command "dim" "update" (ssname ss n) "" "exit")
	(command "dimtol" "off")
	(setq n (1+ n))
	)
      )
    (princ "\nBan da khong chon DIM.")
    )
  (princ)
  )

<<

Filename: 408981_t2.lsp
Tác giả: ketxu
Bài viết gốc: 408887
Tên lệnh: vl
Nhờ Viết Lisp Cộng Các Số Trong Text (Hoặc Mtext) Và Output Sang Một Mtext Khác
Quick code xem bạn dùng cái nào thì dùng ^^
Vanilla lisp
(defun c:al(/ s kq i)
(while (not (setq s (ssget (list (cons 0 "*TEXT"))))))
(setq kq 0 i -1)
(entmake 
	(list (cons 0 "MTEXT")
	(cons 100 "AcDbEntity")
	(cons 100 "AcDbMText")
	(assoc 8 (entget (ssname s 0)))
	(cons 1
		(rtos
		(repeat (sslength s)
			(setq kq (+ kq (cond ((distof (cdr (assoc 1 (entget (ssname s (setq i (1+ i))))))))(0))))	
		))
	)
	(cons 10 (getpoint...
>>
Quick code xem bạn dùng cái nào thì dùng ^^
Vanilla lisp
(defun c:al(/ s kq i)
(while (not (setq s (ssget (list (cons 0 "*TEXT"))))))
(setq kq 0 i -1)
(entmake 
	(list (cons 0 "MTEXT")
	(cons 100 "AcDbEntity")
	(cons 100 "AcDbMText")
	(assoc 8 (entget (ssname s 0)))
	(cons 1
		(rtos
		(repeat (sslength s)
			(setq kq (+ kq (cond ((distof (cdr (assoc 1 (entget (ssname s (setq i (1+ i))))))))(0))))	
		))
	)
	(cons 10 (getpoint "\nInsert point :"))
	)
)
(princ))
- Visual lisp :
 
(defun c:vl(/ d s l lr)(vl-load-com)		
	(while (not (ssget (list (cons 0 "*TEXT")))))
	(vlax-for x 
		(setq s (vla-get-activeselectionset (setq d  (vla-get-activedocument (vlax-get-acad-object)))))
		(setq l (cons (cond ((distof (vla-get-textstring x)))(0)) l))
		(or lr (setq lr (vla-get-layer x)))
	)
	(vla-put-layer
		(vla-addmtext 
			(vla-get-block (vla-get-activelayout d))
			(vlax-3d-point (getpoint "\nInsert point :"))
			(getvar 'textsize)
			(rtos (apply '+ l))
		)
		lr
	)
	(and s (not(vla-delete s))(vlax-release-object s))
	(princ)
)
- Hoặc kết hợp với acet
(defun c:acet(/ s)
(entmake 
	(list (cons 0 "MTEXT")
	(cons 100 "AcDbEntity")
	(cons 100 "AcDbMText")	
	(cons 1 (rtos
		(apply '+ (mapcar '(lambda(x)(cond ((distof (acet-dxf 1 (entget x))))(0))) (acet-ss-to-list (setq s (ssget (list (cons 0 "*TEXT"))))))))
	)
	(assoc 8 (entget (ssname s 0)))
	(cons 10 (getpoint "\nInsert point :"))
	)
)
(princ))
Lưu ý với bạn là các code trên (kể cả của bác Bee đều k tính đến trường hợp đối tượng chọn là các Mtext có kèm mã như mã xuống dòng, layẻ, màu sắc, chiều cao ....
<<

Filename: 408887_vl.lsp
Tác giả: ketxu
Bài viết gốc: 408887
Tên lệnh: acet
Nhờ Viết Lisp Cộng Các Số Trong Text (Hoặc Mtext) Và Output Sang Một Mtext Khác
Quick code xem bạn dùng cái nào thì dùng ^^
Vanilla lisp
(defun c:al(/ s kq i)
(while (not (setq s (ssget (list (cons 0 "*TEXT"))))))
(setq kq 0 i -1)
(entmake 
	(list (cons 0 "MTEXT")
	(cons 100 "AcDbEntity")
	(cons 100 "AcDbMText")
	(assoc 8 (entget (ssname s 0)))
	(cons 1
		(rtos
		(repeat (sslength s)
			(setq kq (+ kq (cond ((distof (cdr (assoc 1 (entget (ssname s (setq i (1+ i))))))))(0))))	
		))
	)
	(cons 10 (getpoint...
>>
Quick code xem bạn dùng cái nào thì dùng ^^
Vanilla lisp
(defun c:al(/ s kq i)
(while (not (setq s (ssget (list (cons 0 "*TEXT"))))))
(setq kq 0 i -1)
(entmake 
	(list (cons 0 "MTEXT")
	(cons 100 "AcDbEntity")
	(cons 100 "AcDbMText")
	(assoc 8 (entget (ssname s 0)))
	(cons 1
		(rtos
		(repeat (sslength s)
			(setq kq (+ kq (cond ((distof (cdr (assoc 1 (entget (ssname s (setq i (1+ i))))))))(0))))	
		))
	)
	(cons 10 (getpoint "\nInsert point :"))
	)
)
(princ))
- Visual lisp :
 
(defun c:vl(/ d s l lr)(vl-load-com)		
	(while (not (ssget (list (cons 0 "*TEXT")))))
	(vlax-for x 
		(setq s (vla-get-activeselectionset (setq d  (vla-get-activedocument (vlax-get-acad-object)))))
		(setq l (cons (cond ((distof (vla-get-textstring x)))(0)) l))
		(or lr (setq lr (vla-get-layer x)))
	)
	(vla-put-layer
		(vla-addmtext 
			(vla-get-block (vla-get-activelayout d))
			(vlax-3d-point (getpoint "\nInsert point :"))
			(getvar 'textsize)
			(rtos (apply '+ l))
		)
		lr
	)
	(and s (not(vla-delete s))(vlax-release-object s))
	(princ)
)
- Hoặc kết hợp với acet
(defun c:acet(/ s)
(entmake 
	(list (cons 0 "MTEXT")
	(cons 100 "AcDbEntity")
	(cons 100 "AcDbMText")	
	(cons 1 (rtos
		(apply '+ (mapcar '(lambda(x)(cond ((distof (acet-dxf 1 (entget x))))(0))) (acet-ss-to-list (setq s (ssget (list (cons 0 "*TEXT"))))))))
	)
	(assoc 8 (entget (ssname s 0)))
	(cons 10 (getpoint "\nInsert point :"))
	)
)
(princ))
Lưu ý với bạn là các code trên (kể cả của bác Bee đều k tính đến trường hợp đối tượng chọn là các Mtext có kèm mã như mã xuống dòng, layẻ, màu sắc, chiều cao ....
<<

Filename: 408887_acet.lsp
Tác giả: Bee
Bài viết gốc: 409025
Tên lệnh: t2
Sửa Lisp Thêm Dung Sai Cho Kích Thước Có Sẵn

Thanks Bee rất nhiều, chuẩn như Lê Duẩn luôn, ko lỗi lầm gì cả. Cho mình hỏi mở rộng chút, nếu mình muốn đánh lệnh t2 mà nó hiện ra các dòng ghi các loại dung sai khác nhau, mình chỉ cần pick chọn vào dung sai cần dùng trc khi chọn các kích thước cần thay đổi dung sai thì có thay đổi đc ko ??? 

...

>>

Thanks Bee rất nhiều, chuẩn như Lê Duẩn luôn, ko lỗi lầm gì cả. Cho mình hỏi mở rộng chút, nếu mình muốn đánh lệnh t2 mà nó hiện ra các dòng ghi các loại dung sai khác nhau, mình chỉ cần pick chọn vào dung sai cần dùng trc khi chọn các kích thước cần thay đổi dung sai thì có thay đổi đc ko ??? 

:D  :D  :D

Đây là lisp nhập thêm 2 gia trị dimtp và dimtm nhé. ^_^

(defun c:T2 (/ ss dimtp dimtm n)
  (if (setq ss (ssget '((0 . "DIMENSION"))))
    (progn
      (setq dimtp (getreal "\nChon gia tri dimtp <0.02>: "))
      (if (not dimtp)
	(setq dimtp 0.02)
	)
      (setq dimtm (getreal "\nChon gia tri dimtm <0.02>: "))
      (if (not dimtm)
	(setq dimtm 0.02)
	)
      (setq n 0)
      (repeat (sslength ss)
	(if (/= (getvar 'dimstyle) (cdr (assoc 3 (entget (ssname ss n)))))
	  (command "dimstyle" "r" (cdr (assoc 3 (entget (ssname ss n)))))
	  )
	(command "dimtol" "on")
	(command "dimtp" dimtp)
	(command "dimtm" dimtm)
	(command "dim" "update" (ssname ss n) "" "exit")
	(command "dimtol" "off")
	(setq n (1+ n))
	)
      )
    (princ "\nBan da khong chon DIM.")
    )
  (princ)
  )
 

<<

Filename: 409025_t2.lsp
Tác giả: Tue_NV
Bài viết gốc: 409200
Tên lệnh: ttt
Tự Động Ghi Chú Đoạn Thẳng Theo Thứ Tự Tăng Dần

Bạn thử xem; 

(defun attfill (Lobjfind Lrep)
(mapcar '(lambda(x y)
(vlax-put x 'textstring y)
)
Lobjfind
 Lrep 
)
)
(defun Tue-geom-divpt (p1 p2 k)
(polar p1 (angle p1 p2) (* (distance p1 p2) k))
)
(defun c:ttt(/ i  tto ename lst-length ss ename lst-re kq ls-kq ttu)
 (setq i -1)
(if (and (setq ss (ssget '((0 . "*LINE")))) (setq tto (getstring t "\nNhap tien to :")) (setq ttu (getint "\nThu tu :")))
  (while (setq ename...
>>

Bạn thử xem; 

(defun attfill (Lobjfind Lrep)
(mapcar '(lambda(x y)
(vlax-put x 'textstring y)
)
Lobjfind
 Lrep 
)
)
(defun Tue-geom-divpt (p1 p2 k)
(polar p1 (angle p1 p2) (* (distance p1 p2) k))
)
(defun c:ttt(/ i  tto ename lst-length ss ename lst-re kq ls-kq ttu)
 (setq i -1)
(if (and (setq ss (ssget '((0 . "*LINE")))) (setq tto (getstring t "\nNhap tien to :")) (setq ttu (getint "\nThu tu :")))
  (while (setq ename (ssname ss (setq i (1+ i))))
    (setq lst-length (append lst-length (list (list (vlax-ename->vla-object ename)
   (vlax-curve-getDistAtPoint ename (vlax-curve-getEndPoint ename))
   (Tue-geom-divpt (vlax-curve-getstartPoint ename) (vlax-curve-getEndPoint ename) 0.5)))))
  )
)
  (setq lst-length (vl-sort  lst-length '(lambda (x1 x2) (< (cadr x1) (cadr x2)))))
  (setq lst-re (mapcar 'cadr lst-length ))
  (setq kq (car lst-re) lst-kq '(0))
  (foreach x lst-re
    (if (= x kq) (setq lst-kq (append lst-kq (list (last lst-kq))))
       (setq kq x lst-kq (append lst-kq (list (1+ (last lst-kq)))) )
    )
  )
  (setq lst-kq (cdr lst-kq)) 
    
  (setq i 0)
  (foreach x lst-length
(attfill (vlax-invoke (vla-InsertBlock (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-acad-object)))
(vlax-3d-point (caddr x)) "BlockKH" 1 1 1 0) 'getattributes)
(list "GOC" (cadr x) (strcat tto (if (< (setq kq (+ ttu (nth i lst-kq))) 10) (strcat "0" (itoa kq)) (itoa kq))))
)
        (setq i (1+ i))
   )
)

<<

Filename: 409200_ttt.lsp
Tác giả: Tue_NV
Bài viết gốc: 409215
Tên lệnh: ttt
Tự Động Ghi Chú Đoạn Thẳng Theo Thứ Tự Tăng Dần

wao, đoạn code ngắn mà làm được khối lượng công việc quá nhiều bác ạ. Thanks bác Tue_NV nhé!

 

Bác cho em hỏi thêm chút, bác có thể chỉnh giúp cho số thứ tự của Block sẽ hiện theo thứ tự người dùng chọn đường Line được không? Vì cái bác đang viết là số thứ tự sẽ được tăng dần...

>>

wao, đoạn code ngắn mà làm được khối lượng công việc quá nhiều bác ạ. Thanks bác Tue_NV nhé!

 

Bác cho em hỏi thêm chút, bác có thể chỉnh giúp cho số thứ tự của Block sẽ hiện theo thứ tự người dùng chọn đường Line được không? Vì cái bác đang viết là số thứ tự sẽ được tăng dần theo chiều dài của Line thì phải.

 

Trân trọng!

Ý bạn như vầy:

(defun attfill (Lobjfind Lrep) (mapcar '(lambda(x y) (vlax-put x 'textstring y)) Lobjfind Lrep ))
(defun Tue-geom-divpt (p1 p2 k) (polar p1 (angle p1 p2) (* (distance p1 p2) k)))
(defun c:ttt(/ i  tto ename lst-length ss ename lst-re kq ls-kq ttu)
(setq tto (getstring t "\nNhap tien to :")) (setq ttu (getint "\nThu tu :") ttu0 ttu)
  (while (setq ename (car (entsel "Chon Line :")))
       (setq L-length (vlax-curve-getDistAtPoint ename (vlax-curve-getEndPoint ename)))
    (if (null (member L-length lst-length))
        (setq kq (strcat tto (if (< ttu 10) (strcat "0" (itoa ttu)) (itoa ttu)))
          lst-length (append lst-length (list L-length)) ttu (1+ ttu))
        (setq vitri (VL-POSITION L-length lst-length)
          kq (strcat tto (if (< (+ ttu0 vitri) 10) (strcat "0" (itoa (+ ttu0 vitri))) (itoa (+ ttu0 vitri))))
        )
    )  
        (attfill (vlax-invoke (vla-InsertBlock (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-acad-object)))
         (vlax-3d-point (Tue-geom-divpt (vlax-curve-getstartPoint ename) (vlax-curve-getEndPoint ename) 0.5))
        "BlockKH" 1 1 1 0) 'getattributes)
         (list "GOC" (rtos L-length 2 0) kq)
    )
  )
(princ)
)

<<

Filename: 409215_ttt.lsp
Tác giả: Bee
Bài viết gốc: 409308
Tên lệnh: test
Xin Lisp Tự Động Các Text Có Tọa Độ Nằm Trong Vùng Khép Kín

mình có file gồm nhiều vùng khép kín, trong mỗi vùng có số lượng text (là số) khác nhau. các bạn giúp mình lisp cộng các số đó lại với.

Thử lisp này nhé. Vòng lặp chọn điểm đặt text từng vùng 1 nhé. 

(defun c:test  (/ *error* os pt old_last...
>>

mình có file gồm nhiều vùng khép kín, trong mỗi vùng có số lượng text (là số) khác nhau. các bạn giúp mình lisp cộng các số đó lại với.

Thử lisp này nhé. Vòng lặp chọn điểm đặt text từng vùng 1 nhé. 

(defun c:test  (/ *error* os pt old_last new_last sum n value)
  (defun *error*  (msg)
    (and os
         (setvar 'osmode os)
         )
    (if (and msg
             (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,"))
             )
      (princ (strcat "\nError: " msg))
      )
    )
  (setq os (getvar 'osmode))
  (while (setq pt (getpoint "\nChon diem dat text trong vung kin: "))
    (setvar 'osmode 0)
    (setq old_last (entlast))
    (command "-boundary" pt "")
    (setq new_last (entlast))
    (if (equal old_last new_last)
      (princ "\nVung ban chon khong kin.")
      (progn
        (setq ss (ssget "_WP" (mapcar
                                (function
                                  (lambda (x) (cdr x))
                                    )
                                (vl-remove-if-not
                                  (function
                                    (lambda (x) (= (car x) 10))) (entget new_last))
                                )
                        '((0 . "TEXT")))
              );setq
        (setq sum 0.)
        (setq n 0)
        (repeat (sslength ss)
          (setq value (atof (cdr (assoc 1 (entget (ssname ss n))))))
          (setq sum (+ sum value))
          (setq n (1+ n))
          );repeat
        (entdel new_last)
        (entmake
          (list (cons 0 "TEXT")
                (cons 10 pt)
                (cons 40 (getvar 'textsize))
                (cons 1 (rtos sum 2 0)) 
                )
          );entmake
        
        ) ;progn else
      ) ;if
    ) ;while
  (setvar 'osmode os)
  (princ)
  ) ;defun

^_^


<<

Filename: 409308_test.lsp
Tác giả: Tue_NV
Bài viết gốc: 409418
Tên lệnh: go
Help Vấn Đề Group

có thêm 1 cách nữa :

(defun c:go()
(defun SendKeys (keys / wscript)
 
(vlax-invoke-method (setq wscript (vlax-create-object "WScript.Shell")) 'sendkeys keys)
 
(vlax-release-object wscript)
 
)
(sendkeys "^+a")
 (princ)
)

Filename: 409418_go.lsp
Tác giả: Tue_NV
Bài viết gốc: 409500
Tên lệnh: ttt
Tự Động Ghi Chú Đoạn Thẳng Theo Thứ Tự Tăng Dần

Bác Tue_NV chỉnh giúp em phần này với:

 

- Khi chọn line mà kích trượt ko vào line mà ra bên ngoài là nó kết thúc lệnh luôn, bác chỉnh giúp em là kết thúc lệnh khi mình ấn ESC với. Để nếu có chọn trượt thì vẫn có thể chọn tiếp.

 

Trân...

>>

Bác Tue_NV chỉnh giúp em phần này với:

 

- Khi chọn line mà kích trượt ko vào line mà ra bên ngoài là nó kết thúc lệnh luôn, bác chỉnh giúp em là kết thúc lệnh khi mình ấn ESC với. Để nếu có chọn trượt thì vẫn có thể chọn tiếp.

 

Trân trọng!

 

Bạn thử coi có được không?

(defun attfill (Lobjfind Lrep) (mapcar '(lambda(x y) (vlax-put x 'textstring y)) Lobjfind Lrep ))
(defun Tue-geom-divpt (p1 p2 k) (polar p1 (angle p1 p2) (* (distance p1 p2) k)))
(defun c:ttt(/ i  tto ename lst-length ss ename lst-re kq ls-kq ttu)
(setq tto (getstring t "\nNhap tien to :")) (setq ttu (getint "\nThu tu :") ttu0 ttu)
  (while (setq ename (car (entsel "Chon Line :")))
   (if ename (progn
       (setq L-length (vlax-curve-getDistAtPoint ename (vlax-curve-getEndPoint ename)))
    (if (null (member L-length lst-length))
        (setq kq (strcat tto (if (< ttu 10) (strcat "0" (itoa ttu)) (itoa ttu)))
          lst-length (append lst-length (list L-length)) ttu (1+ ttu))
        (setq vitri (VL-POSITION L-length lst-length)
          kq (strcat tto (if (< (+ ttu0 vitri) 10) (strcat "0" (itoa (+ ttu0 vitri))) (itoa (+ ttu0 vitri))))
        )
    )  
        (attfill (vlax-invoke (vla-InsertBlock (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-acad-object)))
         (vlax-3d-point (Tue-geom-divpt (vlax-curve-getstartPoint ename) (vlax-curve-getEndPoint ename) 0.5))
        "BlockKH" 1 1 1 0) 'getattributes)
         (list "GOC" (rtos L-length 2 0) kq)
    )
   ))
  )
(princ)
)

<<

Filename: 409500_ttt.lsp
Tác giả: quocmanh04tt
Bài viết gốc: 408835
Tên lệnh: tt
Thiết Kế Khuôn Tự Động (Tạo Rãnh Dầu)
Code theo gợi ý của ketxu:
Kết quả chỉ 1 đối tượng Region
(defun c:tt (/ Circle MakeRegion ang cen cir dia dis n pt1 pt2 reg lst-reg lst-reg1 d)
(defun Circle (cen rad) (entmakex (list (cons 0 "CIRCLE") (cons 10 cen) (cons 40 rad))))
(defun MakeRegion (en)
(if (vlax-curve-isclosed en)
(car (vlax-invoke (vlax-get-property (vla-get-activedocument (vlax-get-acad-object))
(if...
>>
Code theo gợi ý của ketxu:
Kết quả chỉ 1 đối tượng Region
(defun c:tt (/ Circle MakeRegion ang cen cir dia dis n pt1 pt2 reg lst-reg lst-reg1 d)
(defun Circle (cen rad) (entmakex (list (cons 0 "CIRCLE") (cons 10 cen) (cons 40 rad))))
(defun MakeRegion (en)
(if (vlax-curve-isclosed en)
(car (vlax-invoke (vlax-get-property (vla-get-activedocument (vlax-get-acad-object))
(if (= 1 (getvar 'CVPORT))
'Paperspace
'Modelspace))
'AddRegion
(list (vlax-ename->vla-object en))))))
(or (> (getvar 'USERR1) 0) (setvar 'USERR1 6))
(if (and (setq dia (cond ((getreal (strcat "Diameter <" (rtos (getvar 'USERR1)) ">: ")))
((getvar 'USERR1))))
(setvar 'USERR1 dia)
(setq pt1 (getpoint "\nFirst point: "))
(setq pt2 (getpoint "\nSecond point: " pt1)))
(progn (setq pt1 (trans pt1 1 0)
pt2 (trans pt2 1 0)
ang (angle pt1 pt2)
dis (distance pt1 pt2))
(if (> dis (1+ dia))
(progn (setq n -1
d 0)
;;(setq d (/ (- dis (* (1+ dia) (1- (fix (/ dis (1+ dia)))))) 2))
(repeat (fix (/ dis (1+ dia)))
(setq cen (polar pt1 ang (+ d (* (setq n (1+ n)) (1+ dia)))))
(setq reg1 (MakeRegion (setq cir (Circle cen (/ dia 2)))))
(setq lst-reg1 (cons reg1 lst-reg1))
(and cir (entdel cir))
(setq reg (MakeRegion (setq cir (Circle cen (/ (+ dia 2) 2)))))
(and cir (entdel cir))
(setq lst-reg (cons reg lst-reg)))
(setq reg (car lst-reg))
(foreach x (cdr lst-reg) (vla-Boolean reg acUnion x) (setq reg (vlax-ename->vla-object (entlast))))))
(foreach x lst-reg1 (vla-Boolean reg acSubtraction x) (setq reg (vlax-ename->vla-object (entlast))))))
(princ))
<<

Filename: 408835_tt.lsp
Tác giả: Bee
Bài viết gốc: 408855
Tên lệnh: test
Thiết Kế Khuôn Tự Động (Tạo Rãnh Dầu)

@Bee : Ket dùng 2008 và 2017. Lỗi UCS là code biểu diễn của bác Mạnh, vì chắc chưa trans vector, k phải ở code bác. Các bác toàn đóng vào nên ket cũng k học được nhiều :D

 

- Bài này với đường biên các bác dùng vla-boolean union với Region bên ngoài (nếu n >1) sẽ thuận tiện hơn...

>>

@Bee : Ket dùng 2008 và 2017. Lỗi UCS là code biểu diễn của bác Mạnh, vì chắc chưa trans vector, k phải ở code bác. Các bác toàn đóng vào nên ket cũng k học được nhiều :D

 

- Bài này với đường biên các bác dùng vla-boolean union với Region bên ngoài (nếu n >1) sẽ thuận tiện hơn ạ

Có tí code nghịch vui. Bác nào rảnh hoàn thiện nốt cho ra kết quả ^_^

(DEFUN c:test  (/ *error* cen d gr loop p1 foo foo_1 line circle1 circle2 lst_1 lst_2)
  (DEFUN *error*  (msg)
    (MAPCAR '(LAMBDA (o) (VLA-DELETE (VLAX-ENAME->VLA-OBJECT o))) lst_1)
    (MAPCAR '(LAMBDA (o) (VLA-DELETE (VLAX-ENAME->VLA-OBJECT o))) lst_2)
    (AND line
         (ENTDEL line)
         (SETQ line nil)
         ) ;and
    (OR (= msg "function cancelled")
        (PRINC (STRCAT "\nerror: " msg))
        )
    (PRINC)
    )
  (SETQ cen  (GETPOINT "\nChon diem 1: ")
        loop T
        )
  (SETQ d (GETREAL "\nChon duong kinh: "))
  (IF (NOT d)
    (SETQ d 6)
    )
  (WHILE (AND (SETQ gr (GRREAD T 12 0)) loop)
    (COND
      ((= (CAR gr) 5)
       (MAPCAR '(LAMBDA (o) (VLA-DELETE (VLAX-ENAME->VLA-OBJECT o))) lst_1)
       (MAPCAR '(LAMBDA (o) (VLA-DELETE (VLAX-ENAME->VLA-OBJECT o))) lst_2)
       (SETQ lst_1 nil
             lst_2 nil)
       (AND line
            (ENTDEL line)
            (SETQ line nil)
            ) ;and
       (SETQ p1 (CADR gr))
       (SETQ foo (/ (DISTANCE p1 cen) d))
       (SETQ foo_1 (ATOI (RTOS foo 2 2)))
       (IF (> foo_1 1)
         (PROGN
           (SETQ lst_1 nil
                 lst_2 nil)

           (SETQ line (ENTMAKEX
                        (LIST
                          '(0 . "LINE")
                          '(100 . "AcDbEntity")
                          '(100 . "AcDbLine")
                          '(62 . 6)
                          (CONS 11 p1)
                          (CONS 10 cen)
                          )
                        ) ;entmakex_line
                 )

           (SETQ circle1 (ENTMAKEX
                           (LIST
                             '(0 . "CIRCLE")
                             '(100 . "AcDbEntity")
                             '(100 . "AcDbCircle")
                             '(62 . 6)
                             (CONS 40 (/ d 2))
                             (CONS 10 cen)
                             )
                           ) ;entmakex_circle1
                 circle2 (ENTMAKEX
                           (LIST
                             '(0 . "CIRCLE")
                             '(100 . "AcDbEntity")
                             '(100 . "AcDbCircle")
                             '(62 . 6)
                             (CONS 40 (+ (/ d 2) 1))
                             (CONS 10 cen)
                             )
                           ) ;entmakex_circle2
                 ) ;setq
           (SETQ lst_1 (CONS circle1 lst_1))
           (SETQ lst_2 (CONS circle2 lst_2))

           (SETQ p1a (POLAR cen (ANGLE cen p1) (+ d 1)))
           (REPEAT (- foo_1 3)
             (SETQ circle1 (ENTMAKEX
                             (LIST
                               '(0 . "CIRCLE")
                               '(100 . "AcDbEntity")
                               '(100 . "AcDbCircle")
                               '(62 . 6)
                               (CONS 40 (/ d 2))
                               (CONS 10 p1a)
                               )
                             ) ;entmakex_circle1
                   circle2 (ENTMAKEX
                             (LIST
                               '(0 . "CIRCLE")
                               '(100 . "AcDbEntity")
                               '(100 . "AcDbCircle")
                               '(62 . 6)
                               (CONS 40 (+ (/ d 2) 1))
                               (CONS 10 p1a)
                               )
                             ) ;entmakex_circle2
                   ) ;setq
             (SETQ p1a (POLAR p1a (ANGLE cen p1) (+ d 1)))

             (SETQ lst_1 (CONS circle1 lst_1))
             (SETQ lst_2 (CONS circle2 lst_2))
             ) ;repeat
           )
         ) ;if
       )
      ((= (CAR gr) 3) (SETQ loop nil))
      (T
       (MAPCAR '(LAMBDA (o) (VLA-DELETE (VLAX-ENAME->VLA-OBJECT o))) lst_1)
       (MAPCAR '(LAMBDA (o) (VLA-DELETE (VLAX-ENAME->VLA-OBJECT o))) lst_2)
       (SETQ lst_1 nil
             lst_2 nil)
       (AND line
            (ENTDEL line)
            (SETQ line nil)
            ) ;and
       (SETQ loop nil))
      )
    )
  (PRINC)
  )

<<

Filename: 408855_test.lsp
Tác giả: tien2005
Bài viết gốc: 406843
Tên lệnh: vpl
(Nhờ Viết Lisp) Vẽ Polyline Qua Các Điểm Khi Biết Tọa Độ Tương Đối Với Điểm Gốc
(Defun c:vpl (/ p0 x0 y0 p1 x y p2)
  (setq	p0 (getpoint "\n Chon diem tim tuyen")
	x0 (car p0)
	y0 (cadr p0)
	p1 (list (list (+ x0 (getreal "\n Nhap ly do diem dau: "))
		       (+ y0 (getreal "\n Nhap chenh cao diem dau: "))
		 )
	   )
  )
  (while (and (setq x (getreal "\n Nhap ly do diem tiep theo: "))
	      (setq y (getreal "\n Nhap chenh cao diem tiep theo : "))
	 )
    (setq p1 (cons (list (+ x0 x) (+ y0 y)) p1))
;;;        (command "pline" p1 p2...
>>
(Defun c:vpl (/ p0 x0 y0 p1 x y p2)
  (setq	p0 (getpoint "\n Chon diem tim tuyen")
	x0 (car p0)
	y0 (cadr p0)
	p1 (list (list (+ x0 (getreal "\n Nhap ly do diem dau: "))
		       (+ y0 (getreal "\n Nhap chenh cao diem dau: "))
		 )
	   )
  )
  (while (and (setq x (getreal "\n Nhap ly do diem tiep theo: "))
	      (setq y (getreal "\n Nhap chenh cao diem tiep theo : "))
	 )
    (setq p1 (cons (list (+ x0 x) (+ y0 y)) p1))
;;;        (command "pline" p1 p2 "")
;;;        (setq p1 p2)
  )
  
  (if (< 1 (Length p1))
    (COMMAND "_.PLINE"
	     (repeat (Length p1)
	       (COMMAND
		 (CAR p1)
	       )
	       (SETQ p1 (CDR p1))
	     )

    )
  )
  (princ)
)

Bạn thử cái này


<<

Filename: 406843_vpl.lsp
Tác giả: ketxu
Bài viết gốc: 409730
Tên lệnh: qdd
Xin Lisp Tự Động Đo Chiều Dài Nhiều Line (Ko Tính Tổng)

Quick code cho bạn :

(defun c:qdd(/ s sp 3d i dxf rAng rSup e obj) (vl-load-com)
;Quick dim Lines @ketxu 10/2016
(cond
	((setq s (ssget '((0 . "LINE")))) 
	(setq 	sp	(vlax-get (setq ac (vla-get-activedocument (vlax-get-acad-object)))
					(if (> (vla-get-activespace  ac) 0) 'ModelSpace 'PaperSpace)) 
			3d vlax-3d-point
			i -1
			dxf (lambda(i e)(cdr (assoc i (entget e))))
			rAng (lambda(a)(if (and (> a (/ pi 2.)) (<= a (* pi 1.5)))(+ a...
>>

Quick code cho bạn :

(defun c:qdd(/ s sp 3d i dxf rAng rSup e obj) (vl-load-com)
;Quick dim Lines @ketxu 10/2016
(cond
	((setq s (ssget '((0 . "LINE")))) 
	(setq 	sp	(vlax-get (setq ac (vla-get-activedocument (vlax-get-acad-object)))
					(if (> (vla-get-activespace  ac) 0) 'ModelSpace 'PaperSpace)) 
			3d vlax-3d-point
			i -1
			dxf (lambda(i e)(cdr (assoc i (entget e))))
			rAng (lambda(a)(if (and (> a (/ pi 2.)) (<= a (* pi 1.5)))(+ a pi) a))
			rSup (lambda(p)(vlax-put-property obj p 1))
			
	)
	(while (setq e (ssname s (setq i (1+ i))))
			(setq obj 
				(vla-adddimaligned sp 
					(3d (setq p1 (dxf 10 e))) 
                    (3d (setq p2 (dxf 11 e)))     
					(3d (polar p1 (+ (angle p1 p2) (/ pi 2.)) 0))
                )			
			)
			(vla-put-Textrotation obj (rAng (angle p1 p2)))
			(vla-put-TextOverride obj "<>\\P   ")
			(mapcar 'rSup '(DimLine1Suppress DimLine2Suppress ExtLine1Suppress ExtLine2Suppress))
	)	
)
))

<<

Filename: 409730_qdd.lsp
Tác giả: gia_bach
Bài viết gốc: 409668
Tên lệnh: dc
Nhờ Gợi Ý Lisp Bắt Điểm Trên 1 Đối Tượng.

Tôi tưởng bạn chỉ cần "gợi ý" : 

(defun c:DC(/  Ent dis dis1 dis2 pt pt1 pt2)
  (if (and (setq Ent (car (entsel "\nChon doi tuong can do :")))
	   (wcmatch (cdr (assoc 0 (entget ent))) "*LINE,ARC,CIRCE")	   
	   (setq pt1 (getpoint "\nDiem dau :" ))
	   (setq pt2 (getpoint pt1 "\nDiem cuoi :" )))
    (progn
      (setq pt11 (vlax-curve-getClosestPointTo ent pt1)
	    dis1 (vlax-curve-getDistAtPoint Ent pt11)
	    pt12...
>>

Tôi tưởng bạn chỉ cần "gợi ý" : 

(defun c:DC(/  Ent dis dis1 dis2 pt pt1 pt2)
  (if (and (setq Ent (car (entsel "\nChon doi tuong can do :")))
	   (wcmatch (cdr (assoc 0 (entget ent))) "*LINE,ARC,CIRCE")	   
	   (setq pt1 (getpoint "\nDiem dau :" ))
	   (setq pt2 (getpoint pt1 "\nDiem cuoi :" )))
    (progn
      (setq pt11 (vlax-curve-getClosestPointTo ent pt1)
	    dis1 (vlax-curve-getDistAtPoint Ent pt11)
	    pt12 (vlax-curve-getClosestPointTo ent pt2)
	    dis2 (vlax-curve-getDistAtPoint Ent pt12))
      (setq dis (abs(- dis2 dis1)))
      (princ (strcat "\nKhoang cah :" (rtos dis)))  ) )
  (princ))

<<

Filename: 409668_dc.lsp
Tác giả: Kieu Tan
Bài viết gốc: 409642
Tên lệnh: mb
Viết Chữ Tiếng Việt Trong Lisp (Unicode)

https://drive.google.com/file/d/0B-3fZ45DSr_XMDc4TW1iQVVFQnM/view?usp=sharing

 

 

tạo 1 cái nick log vào rồi download. :(

 

>>

https://drive.google.com/file/d/0B-3fZ45DSr_XMDc4TW1iQVVFQnM/view?usp=sharing

 

 

tạo 1 cái nick log vào rồi download. :(

 

https://drive.google.com/file/d/0B-3fZ45DSr_XMDc4TW1iQVVFQnM/view?usp=sharing

 

 

tạo 1 cái nick log vào rồi download. :(

1. Down về rồi và past vào font của cad

2. Và thay:

(3 . "VNI-HELVE.TTF");font file

 

bằng

(3 . "VNI-ARIAL.TTF")

Nhưng vẫn không được.

mình dùng bản mã: unicode, kiểu gõ: vni


(DEFUN C:mb (/ tile p)
  (IF (= (TBLOBJNAME "STYLE" "ARIAL") NIL)
;(command ".STYLE" "ARIAL" "VNI-ARIAL" "" "" "" "" "" "")
    (entmake '((0 . "STYLE")
	       (100 . "AcDbSymbolTableRecord")
	       (100 . "AcDbTextStyleTableRecord")
	       (2 . "ARIAL")	;style name 
	       (3 . "VNI-ARIAL.TTF")	;font file 
	       (70 . 0)
	       (40 . 0.0)
	       (41 . 1.0)
	       (50 . 0.0)
	       (71 . 0)
	      )
    )
  )
  (SETQ
    tile (getint "\nTi le: ")
    p	 (getpoint "\nChon diem chen text: ")
  )
;;;  (COMMAND "TEXT" "S" "ARIAL" "J" "MC" P (* TILE 2) "0" "%%UM?T B?NNG TÔN MÁI"
  (entmake (list
	     (cons 0 "TEXT")
	     (cons 1 "MAËT BAÈNG TOÂN MAÙI")
	     (cons 10 p)
	     (cons 40 (* tile 2))
	     (cons 7 "ARIAL")
	   )
  )

)


<<

Filename: 409642_mb.lsp

Trang 213/301

213