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

Viết Lisp theo yêu cầu

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

bác Tuệ ơi, nhờ bác phát triển lên thêm giúp em 1 ý được không?

em muốn các text được chọn trở thành các Att riêng rẽ

vì em phải làm việc với >1000 text = excellink, nếu để >1000 text này

vào chung 1Att thì khi xuất sang excel sẽ không đủ số colum (trong excel chỉ có 256 colum)

còn nếu >1000 text này trở thành >1000 Att riêng rẽ thì số row trong excel sẽ đủ đáp ứng

mong bác để ý giúp em

cảm ơn bác nhiều!

muốn các text được chọn trở thành các Att thì dùng lệnh X (EXPLODE) là xong

 

vâng! em dùng cad2007. bạn hoangson614 nói là dùng vẫn bình thường nhưng em thì...làm chán tay mỏi mắt vẫn báo lỗi như thế. pó toàn thân! hjj. bác pro cũng ko bít tại sao thì em... hix đành phải dùng lisp khác tính tổng dtích xong có kết quả trên command rùi ed lại text thui! hic, lâu lém bác ơi! huu

em ko dùng cad2004 nhưng test trên cad2005 cũng ko đc lun bác ah!

Có thể Lisp gdt trùng tên lệnh với 1 file Lisp nào đó trong máy của bạn chăng?

Bạn thử đổi tên lệnh gdt trong file Lisp thành 1 tên khác xem sao

cụ thể ở dòng đầu tiên :

(defun c:gdt(/ oldim p1 frome cur toe ss ss2 tt S ans po cao te ente)

 

Bạn thay chữ gdt thành 1 tên khác thử xem . Tue_NV test OK mà

  • Vote tăng 1

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

Mình thường sử dụng nhiều, nhưng vẽ bằng lệnh Spline thì lâu quá nhưng lại không chuẩn. Mình nhờ Tue_NV viết giúp mình cái lisp với nội dung sau:

Tên lệnh: DC (dấu cắt)

Pick điểm thứ nhất

Pick điểm thứ hai

OK

Mình gửi kèm file mẫu, bạn xem giúp mình. Cảm ơn bạn, chúc bạn khoẻ và hạnh phúc.

File đây bạn: http://www.cadviet.com/upfiles/Dau_cat_1.dwg

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
muốn các text được chọn trở thành các Att thì dùng lệnh X (EXPLODE) là xong

 

em làm phiền bác thêm 1 chút:

ý của em là mỗi text sẽ là 1 block thuộc tính cơ (vì excellink chỉ làm việc với các block)

nên mỗi text khi được chuyển thành 1 Att rùi thì sẽ phải block lại luôn cơ

bác giúp em thêm 1chút nữa nhé!

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
muốn các text được chọn trở thành các Att thì dùng lệnh X (EXPLODE) là xong

Có thể Lisp gdt trùng tên lệnh với 1 file Lisp nào đó trong máy của bạn chăng?

Bạn thử đổi tên lệnh gdt trong file Lisp thành 1 tên khác xem sao

cụ thể ở dòng đầu tiên :

(defun c:gdt(/ oldim p1 frome cur toe ss ss2 tt S ans po cao te ente)

 

Bạn thay chữ gdt thành 1 tên khác thử xem . Tue_NV test OK mà

hjjj, em làm các bác khó chịu thiệt đó nhơ`. hjj. em đã thay tên lệnh, đổi mọi loại, cả thành "123" lun. vậy mà vẫn báo lỗi "; error: too many arguments" . thử cả sang máy của đồng nghiệp bên cạnh dùng cad2005 cũng vậy, lại báo 1 câu lỗi khác. hjj em pó tay thôi bác à!

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
Mình thường sử dụng nhiều, nhưng vẽ bằng lệnh Spline thì lâu quá nhưng lại không chuẩn. Mình nhờ Tue_NV viết giúp mình cái lisp với nội dung sau:

Tên lệnh: DC (dấu cắt)

Pick điểm thứ nhất

Pick điểm thứ hai

OK

Mình gửi kèm file mẫu, bạn xem giúp mình. Cảm ơn bạn, chúc bạn khoẻ và hạnh phúc.

File đây bạn: http://www.cadviet.com/upfiles/Dau_cat_1.dwg

Bạn lưu file daucat.dwg này vào trong ổ C: của bạn thì nó mới chạy nhé :

file đây : http://www.cadviet.com/upfiles/daucat.dwg

Và chạy file Lisp này nữa :

;copyright by Tue_NV
(defun c:ttoa(/ dt n i ss1 ent tval L kytunoi kytu j tname cao po10 po11 styl LA
mau dxf71 dxf72 dxf73 ang wid)
(command "undo" "be")
(setq dt (ssget '((0 . "TEXT"))) n (sslength dt) i 0 ss1 (ssadd))
(while ((if dt
(progn
(setq ent (ssname dt i))
(setq tval (cdr(assoc 1 (entget ent))))

(setq L (strlen tval) j 1)
(setq kytunoi "")
(Repeat L
(setq kytu (substr tval j 1))
(if (= kytu " ")
(setq kytu "_") 
(setq kytu (substr tval j 1))
)
(setq kytunoi (strcat kytunoi kytu))

(setq j (1+ j))
)

(setq tname kytunoi)
(setq cao (cdr(assoc 40 (entget ent))))
(setq po10 (cdr(assoc 10 (entget ent))))
(setq po11 (cdr(assoc 11 (entget ent))))
(setq styl (cdr(assoc 7 (entget ent))))
(setq LA (cdr(assoc 8 (entget ent))))
(if (= (cdr(assoc 62 (entget ent))) nil)
(setq mau (cdr(assoc 62 (tblsearch "layer" LA))))
(setq mau (cdr(assoc 62 (entget ent))))
)
(setq ang (cdr(assoc 50 (entget ent))))
(setq wid (cdr(assoc 41 (entget ent))))
(setq dxf71 (cdr(assoc 71 (entget ent))))
(setq dxf72 (cdr(assoc 72 (entget ent))))
(setq dxf73 (cdr(assoc 73 (entget ent))))

(watt tname tval po10 po11 dxf71 dxf72 dxf73 cao styl mau ang wid)
(setq ss1 (ssadd (entlast) ss1))
(entdel ent)
)
)
(command "copybase" po10 ss1 "")
(Command "pasteblock" po10)
(Command "erase" ss1 "")
(setq i (1+ i))
)
(sssetfirst ss1 ss1)

(command "undo" "end")
(princ)
)
;
;
;
(defun watt (tagname tagval p1 p2 d71 d72 d73 h sty col goc rong / promp)
(setq promp tagname)
(entmake (list (cons 0 "ATTDEF") (cons 7 sty) (cons 62 col) (cons 2 Tagname) (cons 3 promp) 
(cons 1 tagval) (cons 71 d71) (cons 72 d72) (cons 74 d73) (cons 10 p1) (cons 11 p2) (cons 40 h)
(cons 50 goc) (cons 41 rong)
'(70 . 8) 
)
)
)

@bach1212 : Bạn apload file này chạy thử xem sao. Lệnh là gdt

http://www.cadviet.com/upfiles/gdt.lsp

  • Vote tăng 1

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
Công hoan chạy thử file Lisp này xem :

http://www.cadviet.com/upfiles/VBUN6.vlx

Tuê_NV xem lại giúp mình tí, sao cái đường offet bên dưới đường tự nhiên vẫn là layer tự nhiên và đường này chưa nối với đường mái dốc. Tuê_NV xem file cad mình upload lên nhé. Cảm ơn Tuê_Nv đã giúp đỡ! http://www.cadviet.com/upfiles/TRACNGANGCHITIET_1.dwg

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
..........bổ sung thêm phần cho phép chọn được cả COLOR, LINETYLE, bởi vì rất nhiều Drafters sử dụng Color, Linetype để đặt tên cho các Layers trong việc in ấn ra bản vẽ.

...................................

Chào Phiphi-

Gửi bạn lisp chuyển các đối tuợng về Layer mới có tên LINETYLE+COLOR

ex :

- các đối tuợng có LineType= Center và Color=5 sẽ chuyển sang Layer Center5

- các đối tuợng có LineType= Hidden và Color=3 sẽ chuyển sang Layer Hidden3

- các đối tuợng có LineType=ByLayer hay ByBlock giữ nguyên (không thay đổi)

(defun C:Clt (/ tbl ltype_lst tbl_name ss ss_lst ltype ss_ltype)
 (defun dxf(id ent) (cdr (assoc id (entget ent))) )
 (defun ModEnt(id newval ent / ds)
   (setq ds (entget ent)
  ds (subst (cons id newval) (assoc id ds) ds))
   (entmod ds) (princ)
   )
 ; main
 (command "_.undo" "_begin")
 (setvar "cmdecho" 0)
 (setq lay (getvar "clayer" ))
 (setq ltype_lst (list (cdr (assoc 2 (tblnext "LTYPE" T)))))
 (while (setq tbl (tblnext "LTYPE"))
   (setq ltype_lst (cons (cdr (assoc 2 tbl))ltype_lst))  )  
 (princ "\nChon doi tuong : ")
 (if (setq ss (ssget))
   (progn
     (setq ss_lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    ss_lst (vl-remove-if '(lambda(x) (or (not (dxf 6 x))
					 (equal (dxf 6 x) "ByBlock")
					 ) ) ss_lst))
     (foreach ltype ltype_lst	
(if (setq ss_ltype (vl-remove-if-not '(lambda(x) (equal (dxf 6 x) ltype)) ss_lst))
  (foreach e ss_ltype
    (or
      (setq mau (dxf 62 e))
      (setq mau (cdr(assoc 62 (tblsearch "layer" (dxf 8 e)))) ) )
    (setq layname (strcat ltype (itoa mau)))
    (or (tblsearch "layer" layname)(if (= mau 0)
				     (command "_.LAYER" "N" layname "")
				     (command "_.LAYER" "N" layname "c" mau layname "")) )
    (ModEnt 8 layname e)
    (setq ss_lst (vl-remove e ss_lst ))
    )
  )
)
     (setvar "clayer" lay)
     )
   (prompt "\nKhong co doi tuong duoc chon.")
   )
 (command "_.undo" "_end")
 (princ)
 )

  • Vote tăng 1

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
Tuê_NV xem lại giúp mình tí, sao cái đường offet bên dưới đường tự nhiên vẫn là layer tự nhiên và đường này chưa nối với đường mái dốc. Tuê_NV xem file cad mình upload lên nhé. Cảm ơn Tuê_Nv đã giúp đỡ! http://www.cadviet.com/upfiles/TRACNGANGCHITIET_1.dwg

Đây là kết quả mà Tue_NV test file của conghoan :

http://www.cadviet.com/upfiles/TRACNGANGCHITIET_1_1.dwg

  • Vote tăng 1

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

Bạn lưu file daucat.dwg này vào trong ổ C: của bạn thì nó mới chạy nhé :

file đây : http://www.cadviet.com/upfiles/daucat.dwg

Và chạy file Lisp này nữa :

(defun c:stext (/ sst lstent egoc pgoc xgoc yht zgoc linespc ee tt)
 (if (not tyledong)
   (setq tyledong 1.5)
 )
 (princ "\nSap xep text © CADViet.com")
 (setq	sst	 (ssget '((0 . "TEXT,MTEXT")))
lstent	 (ss2ent sst)
tmp	 (getreal (strcat "\nVao ty le dong khoang cach dong <"
			  (rtos tyledong 2 2)
			  ">: "
		  )
	 )
tyledong (cond
	   (tmp tmp)
	   (t tyledong)
	 )
lstent	 (vl-sort lstent
		  '(lambda (e1 e2)
		     (>	(cadr (cdr (assoc 10 (entget e1))))
			(cadr (cdr (assoc 10 (entget e2))))
		     )
		   )
	 )
egoc	 (car lstent)
lstent	 (cdr lstent)
pgoc	 (cdr (assoc 10 (entget egoc)))
xgoc	 (car pgoc)
yht	 (cadr pgoc)
zgoc	 (caddr pgoc)
hgoc	 (cdr (assoc 40 (entget egoc)))
linespc	 (* hgoc (+ 1.0 tyledong))

 )
 (foreach ee lstent
   (setq tt (entget ee)
  tt (subst (list 10
		  xgoc
		  (setq yht (- yht linespc))
		  zgoc
	    )
	    (assoc 10 tt)
	    tt
     )
   )
   (entmod tt)
   (entupd ee)
 )
 (princ)
)
(defun ss2ent (ss / sodt index lstent)
 (setq
   sodt  (cond
    (ss (sslength ss))
    (t 0)
  )
   index 0
 )
 (repeat sodt
   (setq ent	 (ssname ss index)
  index	 (1+ index)
  lstent (cons ent lstent)
   )
 )
 (reverse lstent)  
)
(princ
 "\nSTEXT - Sap xep text - free lisp from www.cadviet.com"
)
(vl-load-com)

Làm phiền bạn tý nha. Cảm ơn bạn nhiều

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
Mình muốn nhờ bạn tý nữa, lisp này mình đã tìm thấy trên Cadviet (Sắp xếp thẳng hàng và đều các text nhưng là canh lề trái), chạy rất tốt nhưng mình muốn bạn chỉnh lại giúp mình (Sắp xếp thẳng hàng và đều các text, nhưng mình muốn là thẳng hàng, đều text nhưng canh giữa)

Làm phiền bạn tý nha. Cảm ơn bạn nhiều

Tue_NV đã từng cải tiến code này cho phép user nhập vàp khoảng cách dòng (chứ không phải là tỉ lệ dòng)

Và Lisp này Tue_NV viết lại 1 chút bổ sung theo ý của HoangSon

Bạn nhớ rằng Lisp lấy dòng Text đầu tiên làm điểm canh chỉnh đấy nhé

(defun c:sxtext()
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq ss (ssget '((0 . "TEXT")))
lst (ss2ent ss)
lst (vl-sort lst
'(lambda (e1 e2)
(>
(caddr (assoc 10 (entget e1)))
(caddr (assoc 10 (entget e2)))
)
)
)
)
(command "justifytext" ss "" "TC")
(setq kc (getdist "\n Nhap khoang cach giua cac Text :"))
(setq ddau (cdr(assoc 11 (entget(car lst))))
i 0)

(foreach e lst
(setq ent (entget e))
(setq dcuoi (cdr(assoc 11 ent)))
(setq ddauu (list (car ddau) (- (cadr ddau) (* i kc)) 0))
(command "move" e "" dcuoi ddauu) 
(setq i (1+ i))
)
(setvar "osmode" oldos)
(Princ)
)

(defun ss2ent (ss / sodt index lstent)
(setq
sodt (if ss (sslength ss) 0)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)

  • Vote tăng 2

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
Tue_NV đã từng cải tiến code này cho phép user nhập vàp khoảng cách dòng (chứ không phải là tỉ lệ dòng)

Và Lisp này Tue_NV viết lại 1 chút bổ sung theo ý của HoangSon

Bạn nhớ rằng Lisp lấy dòng Text đầu tiên làm điểm canh chỉnh đấy nhé

(defun c:sxtext()
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq ss (ssget '((0 . "TEXT")))
lst (ss2ent ss)
lst (vl-sort lst
'(lambda (e1 e2)
(>
(caddr (assoc 10 (entget e1)))
(caddr (assoc 10 (entget e2)))
)
)
)
)
(command "justifytext" ss "" "TC")
(setq kc (getdist "\n Nhap khoang cach giua cac Text :"))
(setq ddau (cdr(assoc 11 (entget(car lst))))
i 0)

(foreach e lst
(setq ent (entget e))
(setq dcuoi (cdr(assoc 11 ent)))
(setq ddauu (list (car ddau) (- (cadr ddau) (* i kc)) 0))
(command "move" e "" dcuoi ddauu) 
(setq i (1+ i))
)
(setvar "osmode" oldos)
(Princ)
)

(defun ss2ent (ss / sodt index lstent)
(setq
sodt (if ss (sslength ss) 0)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)

Lisp chạy tốt rồi, rất đúng ý mình. Cảm ơn bạn nhiều, (nhưng cho mình hỏi nếu thêm đối tượng text là MTEXT có được không? nhiều lúc DTEXT cũng bất tiện), có thể chỉnh giúp mình tý nữa là OK luôn. Cảm ơn bạn vì sự nhiệt tình. Chúc bạn sức khoẻ.

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

Pác NGUYEN HOANH ơi! Tại sao cai lisp này lại không ap được vào cad nhỉ. Nó báo là "; error: string too long on input"

Pác xem có thể sửa giúp em được không nhá.

Thanks pác rất nhiều!

http://www.cadviet.com/upfiles/Ban_ve_mau.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

Em làm bên trắc địa, gặp trường hợp như thế này: trong công tác trích đo địa chính thửa đất dùng để vẽ các khu đất đã "Tách thửa" thì phải căn cứ vào toạ độ trắc địa theo bản đồ VN2000 từ đó suy ra khoảng cách rồi dán những toạ độ tại bản đồ VN2000 vào bản vẽ của mình. Trình tự thực hiện như sau: (Ví dụ minh hoạ)

 

1. Đo hiện trạng khu đất

2. Vẽ lại mặt bằng tổng thể khu đất (căn cứ vào bản đồ VN2000 và số liệu đo dc.

 

010.png

 

3. Tiếp tục vẽ kích thước các thửa sẽ tách vào bản vẽ đó (đánh dấu toạ độ 1, 2, 3, 4 . .. trên thửa đất)

 

110.png

 

4. Copy qua file bản đồ VN2000 vào đúng vị trí của thửa đất đó. và lấy toạ độ của từng điểm vừa vẽ bằng lệnh ID:

 

310.png

 

5. Copy các toạ độ đó qua Excel

 

410.png

 

6. Copy lại bảng tính vào trong file CAD:

 

510.png

 

 

Vậy các anh có thể giúp em viết 1 cái Lisp có thể làm tắt các giai đoạn trên được ko a? không quan trọng phải thông qua excel, có thể lấy trực tiếp text toạ độ từ bản dồ VN2000 qua cũng được.

 

Đây là file bản đồ VN2000 và file Excel kèm công thức tính của em.

 

http://www.mediafire.com/?v2xmt3lmngl

 

Mong các anh giúp đỡ.

 

Xin chân thành cảm ơn.

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
Pác NGUYEN HOANH ơi! Tại sao cai lisp này lại không ap được vào cad nhỉ. Nó báo là "; error: string too long on input"

Pác xem có thể sửa giúp em được không nhá.

Thanks pác rất nhiều!

http://www.cadviet.com/upfiles/Ban_ve_mau.lsp

Dịch nghĩa : error: string too long on input"[/b]

Lỗi : Kí tự nhập vào quá dài trong 1 hàm -> phát sinh lỗi

Cụ thể ở dòng này trong Code bạn bị lỗi

(command "Layer" "n" "Net manh" "c" "170" "Net manh" "lt" "continuous" "Net manh" "lw" "0.15" "Net manh" "" "Layer" "n" "Net khuat" "c" "6" "Net khuat" "lt" "Hidden" "Net khuat" "lw" "0.2" "Net khuat" "" "Layer" "n" "Duong truc" "c" "2" "Duong truc" "lt" "Acad_iso04w100" "Duong truc" "lw" "0.15" "Duong truc" "" "Layer" "n" "Kich thuoc" "c" "110" "Kich thuoc" "lt" "continuous" "Kich thuoc" "lw" "0.2" "Kich thuoc" "" "Layer" "n" "Van ban" "c" "4" "Van ban" "lt" "continuous" "Van ban" "lw" "0.25" "Van ban" "" "Layer" "n" "Mat cat" "c" "3" "Mat cat" "lt" "continuous" "Mat cat" "lw" "0.15" "Mat cat" "" "layer" "n" "Day dien" "c" "230" "Day dien" "lt" "continuous" "Day dien" "lw" "0.2" "Day dien" "" "layer" "n" "Ong nuoc" "c" "60" "Ong nuoc" "lt" "continuous" "Ong nuoc" "lw" "0.2" "Ong nuoc" "" "layer" "n" "Thep CL" "c" "240" "Thep CL" "lt" "continuous" "Thep CL" "lw" "0.6" "Thep CL" "" "layer" "n" "Thep dai" "c" "30" "Thep dai" "lt" "continuous" "Thep dai" "lw" "0.35" "Thep dai" "" "layer" "n" "Net dam" "c" "1" "Net dam" "lt" "continuous" "Net dam" "lw" "0.4" "Net dam" "" "layer" "s" "Net dam" ""

)

-> giải pháp : Tách 1 dòng trên thành các hàm (command) ngắn hơn là OK

 

Lisp chạy tốt rồi, rất đúng ý mình. Cảm ơn bạn nhiều, (nhưng cho mình hỏi nếu thêm đối tượng text là MTEXT có được không? nhiều lúc DTEXT cũng bất tiện), có thể chỉnh giúp mình tý nữa là OK luôn. Cảm ơn bạn vì sự nhiệt tình. Chúc bạn sức khoẻ.

Lisp này sẽ sắp xếp cả Text lẫn MTEXT

(defun c:sxtext()
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq ss (ssget '((0 . "TEXT,MTEXT")))
lst (ss2ent ss)
lst (vl-sort lst
'(lambda (e1 e2)
(>
(caddr (assoc 10 (entget e1)))
(caddr (assoc 10 (entget e2)))
)
)
)
)
(command "justifytext" ss "" "TC")
(setq kc (getdist "\n Nhap khoang cach giua cac Text :") i 0)
(if (= (cdr(assoc 0 (entget(car lst)))) "TEXT")
(setq ddau (cdr(assoc 11 (entget(car lst)))))
(setq ddau (cdr(assoc 10 (entget(car lst)))))
)

(foreach e lst
(setq ent (entget e))
(if (= (cdr(assoc 0 ent)) "TEXT")
(setq dcuoi (cdr(assoc 11 ent)))
(setq dcuoi (cdr(assoc 10 ent)))
)
(setq ddauu (list (car ddau) (- (cadr ddau) (* i kc)) 0))
(command "move" e "" dcuoi ddauu) 
(setq i (1+ i))
)
(setvar "osmode" oldos)
(Princ)
)

(defun ss2ent (ss / sodt index lstent)
(setq
sodt (if ss (sslength ss) 0)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)

:s_dead:

@conghoan : Bạn hãy thử chạy file Lisp này. Nếu không được nữa thì Tue_NV đành .... bó tay. Vì mình đã test file của bạn rất OK

File đây conghoan test thử nhé. http://www.cadviet.com/upfiles/VBUN7.vlx

Conghoan nhớ rằng Lisp sẽ hiện sáng đối tượng và bạn phải chọn điểm đầu và điểm cuối trên đối tượng hiện sáng đó nhé.

  • Vote tăng 2

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
Dịch nghĩa : error: string too long on input"[/b]

Lỗi : Kí tự nhập vào quá dài trong 1 hàm -> phát sinh lỗi

Cụ thể ở dòng này trong Code bạn bị lỗi

 

-> giải pháp : Tách 1 dòng trên thành các hàm (command) ngắn hơn là OK

Tue_NV nhớ đọc ở đâu đó nói rằng trong một hàm có quy định là số kí tự không được vượt quá bao nhiêu kí tự đó, nhưng giờ quên rồi. Có ai nhắc cho mình nhớ được không> Thanks

Lisp này sẽ sắp xếp cả Text lẫn MTEXT

(defun c:sxtext()
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq ss (ssget '((0 . "TEXT,MTEXT")))
lst (ss2ent ss)
lst (vl-sort lst
'(lambda (e1 e2)
(>
(caddr (assoc 10 (entget e1)))
(caddr (assoc 10 (entget e2)))
)
)
)
)
(command "justifytext" ss "" "TC")
(setq kc (getdist "\n Nhap khoang cach giua cac Text :") i 0)
(if (= (cdr(assoc 0 (entget(car lst)))) "TEXT")
(setq ddau (cdr(assoc 11 (entget(car lst)))))
(setq ddau (cdr(assoc 10 (entget(car lst)))))
)

(foreach e lst
(setq ent (entget e))
(if (= (cdr(assoc 0 ent)) "TEXT")
(setq dcuoi (cdr(assoc 11 ent)))
(setq dcuoi (cdr(assoc 10 ent)))
)
(setq ddauu (list (car ddau) (- (cadr ddau) (* i kc)) 0))
(command "move" e "" dcuoi ddauu) 
(setq i (1+ i))
)
(setvar "osmode" oldos)
(Princ)
)

(defun ss2ent (ss / sodt index lstent)
(setq
sodt (if ss (sslength ss) 0)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)

:cheers:

Cảm ơn Tue_NV nhiều lắm, bạn thật là nhiệt tình.

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

cho em hoi với các bác ơi,down sxtext.lsp,rồi chép vào đâu để sử dụng vậy. em đọc trên diễn đàn thấy hay, nhưng em con wá kém coi nên chịu,từ trước tới zờ toàn được ngưòi khác cài zùm cho xài,nên máy cài này em dốt đặc.

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

Chào bạn Kid112 mình đã có nhờ bác q288 sữa lại 1 lisp cũng giống yêu cầu như bạn

Nếu bạn chưa hiểu thì có thể coi từ trang 111

Hy vọng lisp này sẽ giải quyết được vấn đề của bạn đưa ra.

Tên lệnh : ghitd1

Yêu cầu: 1: nhập chiều cao chữ

2: chữ số thập phân ( dùng để định là cm hay mm)

3: bán kính vòng tròn ( dùng để tô đỉnh thửa)

4: có lưu file hay không ( file được save dạng .txt ngay tại thư mục của bản vẽ)

codebox

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;Chuong trinh danh so va lap bang toa do ho so thua dat dia chinh

;;;Bang toa do tao thanh block, duoc dat ten theo so thu tu 1, 2, 3...

;;;Chap nhan cac doi tuong la Region, Polyline, Line va Arc khep kin

;;;Written by ssg and elleHCSC - January 2009 - www.cadviet.com

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;PUBLIC FUNCTIONS

;;;-------------------------------------------------------------------------------

(Defun DTR (x) (/ (* x pi) 180))

;;;change degree to radian, return REAL

;;;-------------------------------------------------------------------------------

(defun lineP (p0 a r / p1)

;;;Line polar: point, degree angle, radius

(setq p1 (polar p0 (dtr a) r))

(command "line" p0 p1 "")

)

;;;-------------------------------------------------------------------------------

(defun linePX (p0 x) (lineP p0 0 x))

;;;Horizontal line: length x, from p0

;;;-------------------------------------------------------------------------------

(defun linePY (p0 y) (lineP p0 90 y))

;;;Vertical line: length y, from p0

;;;-------------------------------------------------------------------------------

(defun getVert (e / i L)

;;;Return list of all vertex from pline e

(setq i 0

L nil

)

(vl-load-com)

(repeat (fix (+ (vlax-curve-getEndParam e) 1))

(setq L (append L (list (vlax-curve-getPointAtParam e i))))

(setq i (1+ i))

)

L

)

 

;;; First point of List rearrangement

(defun relist(pt0 Lst / i rt)

(setq i 0)

(foreach pt Lst

(if (equal pt0 pt 0.001)

(setq rt i))

(setq i (1+ i)))

(append (append (member (nth rt Lst) Lst)

(cdr (reverse (cdr (member (nth rt Lst) (reverse Lst))))))

(list (nth rt Lst)))

)

 

;;;New Layer

(defun newlayer(a b c d)

(if (not (tblsearch "layer" a))

(command "-layer" "n" a "c" b a "l" c a "lw" d a ""))

)

;;;-------------------------------------------------------------------------------

(defun wtxtMC (txt p h k)

;;;Write text Middle Center, specify text, point, height

(entmake (list (cons 0 "TEXT")

(cons 7 (getvar "textstyle"))

(cons 1 txt)

(cons 10 p)

(cons 11 p)

(cons 40 h)

(cons 72 1)

(cons 73 2)

(if k (cons 51 (DTR 18)) (cons 51 0))

)

)

)

;;;-------------------------------------------------------------------------------

(defun Collect (e / e2 SS)

;;;Selection set from e to entlast

(setq SS (ssadd))

(ssadd e SS)

(while (setq e2 (entnext e)) (ssadd e2 SS) (setq e e2))

SS

)

;;;-------------------------------------------------------------------------------

(defun Collect1 (e / ss)

;;;Selection set after e to entlast. If e nil, select all from fist entity of drawing.

(if (= e nil)

(setq ss (collect (entnext)))

(progn (setq ss (collect e)) (ssdel e ss))

)

)

;;;-------------------------------------------------------------------------------

 

;;;PRIVATE FUNCTIONS

;;;-------------------------------------------------------------------------------

(defun txt1 (txtL / p1 p2 p3 p4 pL i)

;;;Write texts in 1 row

(setq

p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))

p2 (polar p1 0 (* 7 h))

p3 (polar p2 0 (* 10 h))

p4 (polar p3 0 (* 9 h))

pL (list p1 p2 p3 p4)

i 0

)

(repeat 4

(wtxtMC (nth i txtL) (nth i pL) h t)

(setq i (1+ i))

)

)

;;;-------------------------------------------------------------------------------

(defun txt2 (txtL / p1 p2 p3 p4 pL i)

;;;Write texts in 1 row

(setq

p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))

p2 (polar p1 0 (* 7 h))

p3 (polar p2 0 (* 10 h))

p4 (polar p3 0 (* 9 h))

p4 (polar p4 (* 0.5 pi) h)

pL (list p1 p2 p3 p4)

i 0

)

(repeat 4

(wtxtMC (nth i txtL) (nth i pL) h t)

(setq i (1+ i))

)

)

;;;-------------------------------------------------------------------------------

 

 

;;;MAIN PROGRAM

;;;-------------------------------------------------------------------------------

(defun C:ghitd1 (/ h p et p0 p00 p01 p02 pt pvL n j pv num txtL ss bn ntp)

(setvar "cmdecho" 0)

 

;;;New layer check

(newlayer "kichthuoc" 7 "continuous" "default")

(newlayer "stt" 1 "continuous" "default")

(newlayer "bangtd" 7 "continuous" "default")

 

;;;GET TEXT HEIGHT

(if (not h0) (setq h0 1))

(setq h (getreal (strcat "\nChon chieu cao text <" (rtos h0) ">:")))

(if (not h) (setq h h0) (setq h0 h))

 

;;;GET DECIMAL PRECISION

(if (not ntp0) (setq ntp0 2))

(setq ntp (getint (strcat "\nSo chu so thap phan <" (itoa ntp0) ">:")))

(if (not ntp) (setq ntp ntp0) (setq ntp0 ntp))

 

;;;GET CIRCLE RADIUS

(if (not cr0) (setq cr0 0.3))

(setq cr (getreal (strcat "\nNhap ban kinh vong tron <" (rtos cr0) ">:")))

(if cr (setq cr0 cr))

 

;;;PICK & BASE POINT

(initget "Y")

(setq save (getkword "\nBan co muon luu file? < Y / Enter for No >:"))

 

(setq oldos (getvar "osmode")

pdau (getpoint "\nPick diem dau tien (so thu tu = 1) :"))

 

(while pdau

(setq p (getpoint "\nPick 1 diem giua mien kin:")

pvL nil pvL1 nil)

(command "boundary" p "")

(setq et (entlast)

pvL1 (reverse (getvert et)))

(redraw et 3)

(setq p00 (getpoint "\nDiem dat Bang TDGR:"))

(command "erase" et "")

(setq p0 p00

p01 (polar p00 (* 1.5 pi) (* h 3))

pvL (relist pdau pvL1)

n (length pvL)

p02 (polar p01 (* 1.5 pi) (+ (* h 3) (* (1- n) h 2)))

)

(setvar "osmode" 0)

;;;HEADER

(setvar "CLAYER" "bangtd")

(linepx p0 (* 32 h))

(command "copy" "L" "" "m" p00 p01 p02 "")

(linepy p0 (- (distance p0 p02)))

(command "copy" "L" "" "m" p0

(list (+ (car p0) (* 4 h)) (cadr p0))

(list (+ (car p0) (* 14 h)) (cadr p0))

(list (+ (car p0) (* 24 h)) (cadr p0))

(list (+ (car p0) (* 32 h)) (cadr p0))

"")

(setq Lkqua nil)

(wtxtMC "BAÛNG TOÏA ÑOÄ GOÙC RANH"

(polar (polar p0 0 (* 16 h)) (* 0.5 pi) (* 2 h))

(* 1.2 h) nil)

(txt1 (setq Lkq (list "TT" "X (m)" "Y (m)" "S (m)")))

(setq Lkqua (append Lkqua (list Lkq)))

(setq p0 (polar p0 (* 1.5 pi) (* 3 h)))

 

;;;MAKE RECORDS

(setq j 0

pt nil)

(repeat n

(setq

pv (nth j pvL)

num (itoa (1+ j))

)

(if pt

(setq S (rtos (distance pt pv) 2 ntp))

(setq S "")

)

(setq

txtL (list num (rtos (car pv) 2 ntp) (rtos (cadr pv) 2 ntp) S)

Lkqua (append Lkqua (list txtL))

)

(txt2 txtL)

(setq p0 (polar p0 (* 1.5 pi) (* 2 h)))

(setq pt pv)

(setq j (1+ j))

(if (= j (- n 1)) (setq j 0))

)

 

;;;MAKE BLOCK

(setq ss (collect1 et))

(setq bn "1")

(while (tblsearch "block" bn)

(setq bn (itoa (1+ (atoi bn))))

)

(command "block" bn p00 ss "")

(command "insert" bn p00 "" "" "")

 

;;;WRITE POINT NAME

(setvar "CLAYER" "stt")

(setq j 0)

(repeat (1- n)

(setq

pv (nth j pvL)

num (itoa (1+ j))

)

(wtxtMC num (polar pv 0 h) h t)

(command "circle" pv cr0)

(command "hatch" "S" (setq vtron (entlast)) "")

(command "erase" vtron "")

(setq j (1+ j))

)

 

;;;GHI CANH THUA

(setvar "CLAYER" "kichthuoc")

(ghicanh)

 

;;;FINISH

(savef)

(setvar "osmode" oldos)

(setq pdau (getpoint "\nPick diem dau tien (so thu tu = 1) :"))

)

(setvar "cmdecho" 1)

(princ)

)

 

;;;-------------------------------------------------------------------------------

(defun savef()

(if save

(progn

(setq file (open (setq tenfile (strcat (getvar "dwgprefix")

(vl-filename-base (vl-string-right-trim "\\" (getvar "dwgname"))) ".txt")) "a"))

(foreach line Lkqua

(setq line1 "")

(foreach it line

(setq line1 (strcat line1 " " it)))

(write-line line1 file)

)

(close file)

(princ (strcat "\nDa luu thanh file " tenfile))

)

)

)

 

;;;PHAN BO SUNG CUA elleHCSC

;;;------------------------------------------------------------------------------------

(defun Text_canh_TCA (S p a)

;;;Entmake text S at p with angle A - Top Center

(if (/= p nil)

(entmake (list

(cons 0 "TEXT")

(cons 62 5)

(cons 10 p)

(cons 40 h)

(cons 1 S)

(cons 50 a)

(cons 41 0.7)

(cons 7 (getvar "textstyle"))

(cons 72 1)

(cons 11 p)

(cons 73 3)

)

)

)

)

;;;------------------------------------------------------------------------------------

(defun Text_canh_BCA (S p a)

;;;Entmake text S at p with angle A - Bottom Center

(if (/= p nil)

(entmake (list

(cons 0 "TEXT")

(cons 62 5)

(cons 10 p)

(cons 40 h)

(cons 1 S)

(cons 50 a)

(cons 41 0.7)

(cons 7 (getvar "textstyle"))

(cons 72 1)

(cons 11 p)

(cons 73 1)

)

)

)

)

;;;-------------------------------------------------------------------------------

(defun Ghicanh (/ i k p1 p2 dist rad x_mp y_mp mp)

(setq

i 0

k (1- (length pvL))

)

(repeat k

(setq

p1 (nth i pvL)

p2 (nth (+ i 1) pvL)

dist (distance p1 p2)

rad (angle p1 p2)

x_mp (* (+ (car p1) (car p2)) 0.5)

y_mp (* (+ (cadr p1) (cadr p2)) 0.5)

mp (list x_mp y_mp)

)

(if (and (> rad (* 0.5 pi)) (<= rad (* 1.5 pi)))

(setq mp (polar mp (+ rad (* 0.5 pi)) (* 0.3 h)))

)

(if (and (> rad (* 0.5 pi)) (<= rad (* 1.5 pi)))

(progn

(setq rad (+ rad pi))

(Text_canh_TCA (rtos dist 2 2) mp rad)

)

(Text_canh_BCA (rtos dist 2 2) mp rad)

)

(setq i (1+ i))

)

;; repeat k;

)

;;;--------------------------

/codebox

  • Vote tăng 1

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

Chào bạn Kid112 mình đã có nhờ bác q288 sữa lại 1 lisp cũng giống yêu cầu như bạn

Nếu bạn chưa hiểu thì có thể coi từ trang 111

Hy vọng lisp này sẽ giải quyết được vấn đề của bạn đưa ra.

Tên lệnh : ghitd1

Yêu cầu: 1: nhập chiều cao chữ

2: chữ số thập phân ( dùng để định là cm hay mm)

3: bán kính vòng tròn ( dùng để tô đỉnh thửa)

4: có lưu file hay không ( file được save dạng .txt ngay tại thư mục của bản vẽ)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Chuong trinh danh so va lap bang toa do ho so thua dat dia chinh
;;;Bang toa do tao thanh block, duoc dat ten theo so thu tu 1, 2, 3...
;;;Chap nhan cac doi tuong la Region, Polyline, Line va Arc khep kin
;;;Written by ssg and elleHCSC - January 2009 - www.cadviet.com
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;PUBLIC FUNCTIONS
;;;-------------------------------------------------------------------------------
(Defun DTR (x) (/ (* x pi) 180))
;;;change degree to radian, return REAL
;;;-------------------------------------------------------------------------------
(defun lineP (p0 a r / p1)
;;;Line polar: point, degree angle, radius
 (setq p1 (polar p0 (dtr a) r))
 (command "line" p0 p1 "")
)
;;;-------------------------------------------------------------------------------
(defun linePX (p0 x) (lineP p0 0 x))
;;;Horizontal line: length x, from p0
;;;-------------------------------------------------------------------------------
(defun linePY (p0 y) (lineP p0 90 y))
;;;Vertical line: length y, from p0
;;;-------------------------------------------------------------------------------
(defun getVert (e / i L)
;;;Return list of all vertex from pline e
 (setq	i 0
L nil
 )
 (vl-load-com)
 (repeat (fix (+ (vlax-curve-getEndParam e) 1))
   (setq L (append L (list (vlax-curve-getPointAtParam e i))))
   (setq i (1+ i))
 )
 L
)

;;; First point of List rearrangement
(defun relist(pt0 Lst / i rt)
 (setq i 0)
 (foreach pt Lst
   (if (equal pt0 pt 0.001)
     (setq rt i))
   (setq i (1+ i)))
 (append (append (member (nth rt Lst) Lst)
     (cdr (reverse (cdr (member (nth rt Lst) (reverse Lst))))))
  (list (nth rt Lst)))
)

;;;New Layer
(defun newlayer(a b c d) 
   (if (not (tblsearch "layer" a))
      (command "-layer" "n" a "c" b a "l" c a "lw" d a ""))
)
;;;-------------------------------------------------------------------------------
(defun wtxtMC (txt p h k)
;;;Write text Middle Center, specify text, point, height
 (entmake (list (cons 0 "TEXT")
	 (cons 7 (getvar "textstyle"))
	 (cons 1 txt)
	 (cons 10 p)
	 (cons 11 p)
	 (cons 40 h)
	 (cons 72 1)
	 (cons 73 2)
	 (if k (cons 51 (DTR 18)) (cons 51 0))
   )
 )
)
;;;-------------------------------------------------------------------------------
(defun Collect (e / e2 SS)
;;;Selection set from e to entlast
 (setq SS (ssadd))
 (ssadd e SS)
 (while (setq e2 (entnext e)) (ssadd e2 SS) (setq e e2))
 SS
)
;;;-------------------------------------------------------------------------------
(defun Collect1	(e / ss)
;;;Selection set after e to entlast. If e nil, select all from fist entity of drawing.
 (if (= e nil)
   (setq ss (collect (entnext)))
   (progn (setq ss (collect e)) (ssdel e ss))
 )
)
;;;-------------------------------------------------------------------------------

;;;PRIVATE FUNCTIONS
;;;-------------------------------------------------------------------------------
(defun txt1 (txtL / p1 p2 p3 p4 pL i)
;;;Write texts in 1 row
 (setq
   p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
   p2 (polar p1 0 (* 7 h))
   p3 (polar p2 0 (* 10 h))
   p4 (polar p3 0 (* 9 h))
   pL (list p1 p2 p3 p4)
   i  0
 )
 (repeat 4
   (wtxtMC (nth i txtL) (nth i pL) h t)
   (setq i (1+ i))
 )
)
;;;-------------------------------------------------------------------------------
(defun txt2 (txtL / p1 p2 p3 p4 pL i)
;;;Write texts in 1 row
 (setq
   p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
   p2 (polar p1 0 (* 7 h))
   p3 (polar p2 0 (* 10 h))
   p4 (polar p3 0 (* 9 h))
   p4 (polar p4 (* 0.5 pi) h)
   pL (list p1 p2 p3 p4)
   i  0
 )
 (repeat 4
   (wtxtMC (nth i txtL) (nth i pL) h t)
   (setq i (1+ i))
 )
)
;;;-------------------------------------------------------------------------------


;;;MAIN PROGRAM
;;;-------------------------------------------------------------------------------
(defun C:ghitd1 (/ h p et p0 p00 p01 p02 pt pvL n j pv num txtL ss bn ntp)
 (setvar "cmdecho" 0)

;;;New layer check
 (newlayer "kichthuoc" 7 "continuous" "default")
 (newlayer "stt" 1 "continuous" "default")
 (newlayer "bangtd" 7 "continuous" "default")

;;;GET TEXT HEIGHT
 (if (not h0)  (setq h0 1))
 (setq h (getreal (strcat "\nChon chieu cao text <" (rtos h0) ">:")))
 (if (not h)  (setq h h0)  (setq h0 h))

;;;GET DECIMAL PRECISION
 (if (not ntp0)  (setq ntp0 2))
 (setq ntp (getint (strcat "\nSo chu so thap phan <" (itoa ntp0) ">:")))
 (if (not ntp)  (setq ntp ntp0)  (setq ntp0 ntp))

;;;GET CIRCLE RADIUS
 (if (not cr0)  (setq cr0 0.3))
 (setq cr (getreal (strcat "\nNhap ban kinh vong tron <" (rtos cr0) ">:")))
 (if cr (setq cr0 cr))

;;;PICK & BASE POINT
 (initget "Y")
 (setq save (getkword "\nBan co muon luu file? < Y / Enter for No >:"))

 (setq oldos (getvar "osmode")
pdau (getpoint "\nPick diem dau tien (so thu tu = 1) :"))  

 (while pdau
   (setq p (getpoint "\nPick 1 diem giua mien kin:")
  pvL nil pvL1 nil)
   (command "boundary" p "")
   (setq et (entlast)
         pvL1 (reverse (getvert et)))  
   (redraw et 3)  
   (setq p00 (getpoint "\nDiem dat Bang TDGR:"))
   (command "erase" et "")
   (setq  p0 p00
          p01  (polar p00 (* 1.5 pi) (* h 3))    
          pvL  (relist pdau pvL1)
          n	(length pvL)
          p02	(polar p01 (* 1.5 pi) (+ (* h 3) (* (1- n) h 2)))
   )  
   (setvar "osmode" 0)
;;;HEADER
 (setvar "CLAYER" "bangtd")
 (linepx p0 (* 32 h))
 (command "copy" "L" "" "m" p00 p01 p02 "")
 (linepy p0 (- (distance p0 p02)))
 (command "copy" "L" "" "m"  p0
   (list (+ (car p0) (* 4 h)) (cadr p0))
   (list (+ (car p0) (* 14 h)) (cadr p0))
   (list (+ (car p0) (* 24 h)) (cadr p0))
   (list (+ (car p0) (* 32 h)) (cadr p0))
   "")
 (setq Lkqua nil)
 (wtxtMC "BAÛNG TOÏA ÑOÄ GOÙC RANH"
  (polar (polar p0 0 (* 16 h)) (* 0.5 pi) (* 2 h))
	 (* 1.2 h) nil)
 (txt1 (setq Lkq (list "TT" "X (m)" "Y (m)" "S (m)")))
 (setq Lkqua (append Lkqua (list Lkq)))
 (setq p0 (polar p0 (* 1.5 pi) (* 3 h)))

;;;MAKE RECORDS
 (setq	j  0
pt nil)
 (repeat n
   (setq
     pv  (nth j pvL)
     num (itoa (1+ j))
   )
   (if	pt
     (setq S (rtos (distance pt pv) 2 ntp))
     (setq S "")
   )
   (setq
     txtL (list num (rtos (car pv) 2 ntp) (rtos (cadr pv) 2 ntp) S)
     Lkqua (append Lkqua (list txtL))
   )
   (txt2 txtL)
   (setq p0 (polar p0 (* 1.5 pi) (* 2 h)))
   (setq pt pv)
   (setq j (1+ j))
   (if	(= j (- n 1))  (setq j 0))
 )

;;;MAKE BLOCK
 (setq ss (collect1 et))
 (setq bn "1")
 (while (tblsearch "block" bn)
   (setq bn (itoa (1+ (atoi bn))))
 )
 (command "block" bn p00 ss "")
 (command "insert" bn p00 "" "" "")

;;;WRITE POINT NAME
 (setvar "CLAYER" "stt")
 (setq j 0)
 (repeat (1- n)
   (setq
     pv  (nth j pvL)
     num (itoa (1+ j))
   )
   (wtxtMC num (polar pv 0 h) h t)
   (command "circle" pv cr0)
   (command "hatch" "S" (setq vtron (entlast)) "")
   (command "erase" vtron "")
   (setq j (1+ j))
 )

;;;GHI CANH THUA
   (setvar "CLAYER" "kichthuoc")
   (ghicanh)  

;;;FINISH
   (savef)
   (setvar "osmode" oldos)
   (setq pdau (getpoint "\nPick diem dau tien (so thu tu = 1) :"))
 )  
 (setvar "cmdecho" 1)
 (princ)
)

;;;-------------------------------------------------------------------------------
(defun savef()  
 (if save
   (progn
     (setq file (open (setq tenfile (strcat (getvar "dwgprefix")
 (vl-filename-base (vl-string-right-trim "\\" (getvar "dwgname"))) ".txt")) "a"))
     (foreach line Lkqua
(setq line1 "")
(foreach it line
  (setq line1 (strcat line1 " " it)))
(write-line line1 file)
     )
     (close file)
     (princ (strcat "\nDa luu thanh file " tenfile))
   )
 )
)

;;;PHAN BO SUNG CUA elleHCSC
;;;------------------------------------------------------------------------------------
(defun Text_canh_TCA (S p a)
;;;Entmake text S at p with angle A - Top Center
 (if (/= p nil)
   (entmake (list
       (cons 0 "TEXT")
       (cons 62 5)
       (cons 10 p)
       (cons 40 h)
       (cons 1 S)
       (cons 50 a)
       (cons 41 0.7)
       (cons 7 (getvar "textstyle"))
       (cons 72 1)
       (cons 11 p)
       (cons 73 3)
     )
   )
 )
)
;;;------------------------------------------------------------------------------------
(defun Text_canh_BCA (S p a)
;;;Entmake text S at p with angle A - Bottom Center
 (if (/= p nil)
   (entmake (list
       (cons 0 "TEXT")
       (cons 62 5)
       (cons 10 p)
       (cons 40 h)
       (cons 1 S)
       (cons 50 a)
       (cons 41 0.7)
       (cons 7 (getvar "textstyle"))
       (cons 72 1)
       (cons 11 p)
       (cons 73 1)
     )
   )
 )
)
;;;-------------------------------------------------------------------------------
(defun Ghicanh (/ i k p1 p2 dist rad x_mp y_mp mp)
 (setq
   i	0   
   k	(1- (length pvL))
 )
 (repeat k
   (setq
     p1   (nth i pvL)
     p2   (nth (+ i 1) pvL)
     dist (distance p1 p2)
     rad  (angle p1 p2)
     x_mp (* (+ (car p1) (car p2)) 0.5)
     y_mp (* (+ (cadr p1) (cadr p2)) 0.5)
     mp   (list x_mp y_mp)
   )
   (if	(and (> rad (* 0.5 pi)) (<= rad (* 1.5 pi)))
     (setq mp (polar mp (+ rad (* 0.5 pi)) (* 0.3 h)))
   )
   (if	(and (> rad (* 0.5 pi)) (<= rad (* 1.5 pi)))
     (progn
(setq rad (+ rad pi))
(Text_canh_TCA (rtos dist 2 2) mp rad)
     )
     (Text_canh_BCA (rtos dist 2 2) mp rad)
   )
   (setq i (1+ i))
 )
 ;; repeat k;
)
;;;--------------------------

  • Vote tăng 1

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

Nhờ các Bác viết dùng em 1 lisp dùng để chạy kích thước và ghi text khoảng cách song song và nằm giữa với đường line hoặc pline được chọn. Lisp sẽ tạo layer kthuoc nếu bản vẽ chưa có layer kthuoc.

1: nhập tỷ lệ bản vẽ ( do em làm bên trắc địa nên tỷ lệ bản vẽ thường là 1/200 = tỷ lệ 5/2, 1/500 = tỷ lệ 1/1, 1/1000 = 5/10)

2: có vẽ mũi tên hay không(c/k)

3: chọn các đối tượng cần ghi kích thước.

Dưới đây là file mẫu em thể hiện ở 2 tỷ lệ 1/500 và 1/200

http://www.cadviet.com/upfiles/mau_7.dwg

Thank các Bác nhiều.

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
cho em hoi với các bác ơi,down sxtext.lsp,rồi chép vào đâu để sử dụng vậy. em đọc trên diễn đàn thấy hay, nhưng em con wá kém coi nên chịu,từ trước tới zờ toàn được ngưòi khác cài zùm cho xài,nên máy cài này em dốt đặc.

Chào bạn ngaxd050,

Để sử dụng được các lisp có trên diễn đàn này hay bất kỳ diễn đàn nào khác, bạn chỉ cần thực hiện như sau:

1/- Download về máy của bạn và save nó vào một thư mục nào đó.

2/- Mở Autocad và bổ sung thêm thư mục này của bạn vào các đường dẫn tìm kiếm của Cad

3/- Load file lisp này vào cad bằng cách sử dụng lệng Load application trên menu Tool.

4/- Nhập lệnh sử dụng của file lisp. Lệnh này được viết sau lý tự C: trong dòng (defun C:***** .........

 

Nhìn chung để có thể hiểu và sử dụng các lisp bạn nên tìm hiểu một cách kỹ lưỡng hơn về Lisp thông qua các tài liệu và qua các topic dưới đây trên diễn đàn này.

Khi đó bạn không những có thể xài mà bạn còn có khả năng cải tạo các lisp đó theo các yêu cầu riêng của bạn. Rất mong bạn thành công.

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

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

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

  • Vote tăng 1

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
Đây là kết quả mà Tue_NV test file của conghoan :

http://www.cadviet.com/upfiles/TRACNGANGCHITIET_1_1.dwg

Tue_NV xem hộ mình khi mình test thì nó báo như thế này, Tuê_Vn xem thử nó bị thế nào nhé. Cảm ơn nhiều.

Command: vbun

Select objects: Specify opposite corner: 3 found

Select objects:

Nhap do sau vet bun : 1

Nhap he so mai doc o diem dau :1

Nhap he so mai doc o diem cuoi :1

Nhap chieu cao chu ghi mai doc :1

So chu so thap phan :1

Chon diem dau :

Chon diem cuoi :

Cannot TRIM this object.

Cannot TRIM this object.

Chon diem dau :

Chon diem cuoi :

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
File đây conghoan test thử nhé. http://www.cadviet.com/upfiles/VBUN7.vlx

Conghoan nhớ rằng Lisp sẽ hiện sáng đối tượng và bạn phải chọn điểm đầu và điểm cuối trên đối tượng hiện sáng đó nhé.

 

Tue_NV xem hộ mình khi mình test thì nó báo như thế này, Tuê_Vn xem thử nó bị thế nào nhé. Cảm ơn nhiều.

Command: vbun

Select objects: Specify opposite corner: 3 found

Select objects:

Nhap do sau vet bun : 1

Nhap he so mai doc o diem dau :1

Nhap he so mai doc o diem cuoi :1

Nhap chieu cao chu ghi mai doc :1

So chu so thap phan :1

Chon diem dau :

Chon diem cuoi :

Cannot TRIM this object.

Cannot TRIM this object.

Chon diem dau :

Chon diem cuoi :

Trước khi chạy Lisp -> Conghoan đánh lệnh trim -> và thiết lập như sau :

Command: trim

 

Select objects: Specify opposite corner: 1 found : chọn đối tượng

 

Select objects: Enter

 

Select object to trim or shift-select to extend or [Project/Edge/Undo]: e : gõ e

Enter an implied edge extension mode [Extend/No extend] : e gõ e

Select object to trim or shift-select to extend or [Project/Edge/Undo]:

-> rồi sau đó mới sử dụng lệnh VBUN

Hy vọng bạn thành công :s_dead:

-> Conghoan sử dụng giải pháp này xem sao

  • Vote tăng 1

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
Chào bạn Kid112 mình đã có nhờ bác q288 sữa lại 1 lisp cũng giống yêu cầu như bạn

Nếu bạn chưa hiểu thì có thể coi từ trang 111

Hy vọng lisp này sẽ giải quyết được vấn đề của bạn đưa ra.

Tên lệnh : ghitd1

Yêu cầu: 1: nhập chiều cao chữ

2: chữ số thập phân ( dùng để định là cm hay mm)

3: bán kính vòng tròn ( dùng để tô đỉnh thửa)

4: có lưu file hay không ( file được save dạng .txt ngay tại thư mục của bản vẽ)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Chuong trinh danh so va lap bang toa do ho so thua dat dia chinh
;;;Bang toa do tao thanh block, duoc dat ten theo so thu tu 1, 2, 3...
;;;Chap nhan cac doi tuong la Region, Polyline, Line va Arc khep kin
;;;Written by ssg and elleHCSC - January 2009 - www.cadviet.com
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;PUBLIC FUNCTIONS
;;;-------------------------------------------------------------------------------
(Defun DTR (x) (/ (* x pi) 180))
;;;change degree to radian, return REAL
;;;-------------------------------------------------------------------------------
(defun lineP (p0 a r / p1)
;;;Line polar: point, degree angle, radius
 (setq p1 (polar p0 (dtr a) r))
 (command "line" p0 p1 "")
)
;;;-------------------------------------------------------------------------------
(defun linePX (p0 x) (lineP p0 0 x))
;;;Horizontal line: length x, from p0
;;;-------------------------------------------------------------------------------
(defun linePY (p0 y) (lineP p0 90 y))
;;;Vertical line: length y, from p0
;;;-------------------------------------------------------------------------------
(defun getVert (e / i L)
;;;Return list of all vertex from pline e
 (setq	i 0
L nil
 )
 (vl-load-com)
 (repeat (fix (+ (vlax-curve-getEndParam e) 1))
   (setq L (append L (list (vlax-curve-getPointAtParam e i))))
   (setq i (1+ i))
 )
 L
)

;;; First point of List rearrangement
(defun relist(pt0 Lst / i rt)
 (setq i 0)
 (foreach pt Lst
   (if (equal pt0 pt 0.001)
     (setq rt i))
   (setq i (1+ i)))
 (append (append (member (nth rt Lst) Lst)
     (cdr (reverse (cdr (member (nth rt Lst) (reverse Lst))))))
  (list (nth rt Lst)))
)

;;;New Layer
(defun newlayer(a b c d) 
   (if (not (tblsearch "layer" a))
      (command "-layer" "n" a "c" b a "l" c a "lw" d a ""))
)
;;;-------------------------------------------------------------------------------
(defun wtxtMC (txt p h k)
;;;Write text Middle Center, specify text, point, height
 (entmake (list (cons 0 "TEXT")
	 (cons 7 (getvar "textstyle"))
	 (cons 1 txt)
	 (cons 10 p)
	 (cons 11 p)
	 (cons 40 h)
	 (cons 72 1)
	 (cons 73 2)
	 (if k (cons 51 (DTR 18)) (cons 51 0))
   )
 )
)
;;;-------------------------------------------------------------------------------
(defun Collect (e / e2 SS)
;;;Selection set from e to entlast
 (setq SS (ssadd))
 (ssadd e SS)
 (while (setq e2 (entnext e)) (ssadd e2 SS) (setq e e2))
 SS
)
;;;-------------------------------------------------------------------------------
(defun Collect1	(e / ss)
;;;Selection set after e to entlast. If e nil, select all from fist entity of drawing.
 (if (= e nil)
   (setq ss (collect (entnext)))
   (progn (setq ss (collect e)) (ssdel e ss))
 )
)
;;;-------------------------------------------------------------------------------

;;;PRIVATE FUNCTIONS
;;;-------------------------------------------------------------------------------
(defun txt1 (txtL / p1 p2 p3 p4 pL i)
;;;Write texts in 1 row
 (setq
   p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
   p2 (polar p1 0 (* 7 h))
   p3 (polar p2 0 (* 10 h))
   p4 (polar p3 0 (* 9 h))
   pL (list p1 p2 p3 p4)
   i  0
 )
 (repeat 4
   (wtxtMC (nth i txtL) (nth i pL) h t)
   (setq i (1+ i))
 )
)
;;;-------------------------------------------------------------------------------
(defun txt2 (txtL / p1 p2 p3 p4 pL i)
;;;Write texts in 1 row
 (setq
   p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
   p2 (polar p1 0 (* 7 h))
   p3 (polar p2 0 (* 10 h))
   p4 (polar p3 0 (* 9 h))
   p4 (polar p4 (* 0.5 pi) h)
   pL (list p1 p2 p3 p4)
   i  0
 )
 (repeat 4
   (wtxtMC (nth i txtL) (nth i pL) h t)
   (setq i (1+ i))
 )
)
;;;-------------------------------------------------------------------------------
;;;MAIN PROGRAM
;;;-------------------------------------------------------------------------------
(defun C:ghitd1 (/ h p et p0 p00 p01 p02 pt pvL n j pv num txtL ss bn ntp)
 (setvar "cmdecho" 0)

;;;New layer check
 (newlayer "kichthuoc" 7 "continuous" "default")
 (newlayer "stt" 1 "continuous" "default")
 (newlayer "bangtd" 7 "continuous" "default")

;;;GET TEXT HEIGHT
 (if (not h0)  (setq h0 1))
 (setq h (getreal (strcat "\nChon chieu cao text <" (rtos h0) ">:")))
 (if (not h)  (setq h h0)  (setq h0 h))

;;;GET DECIMAL PRECISION
 (if (not ntp0)  (setq ntp0 2))
 (setq ntp (getint (strcat "\nSo chu so thap phan <" (itoa ntp0) ">:")))
 (if (not ntp)  (setq ntp ntp0)  (setq ntp0 ntp))

;;;GET CIRCLE RADIUS
 (if (not cr0)  (setq cr0 0.3))
 (setq cr (getreal (strcat "\nNhap ban kinh vong tron <" (rtos cr0) ">:")))
 (if cr (setq cr0 cr))

;;;PICK & BASE POINT
 (initget "Y")
 (setq save (getkword "\nBan co muon luu file? < Y / Enter for No >:"))

 (setq oldos (getvar "osmode")
pdau (getpoint "\nPick diem dau tien (so thu tu = 1) :"))  

 (while pdau
   (setq p (getpoint "\nPick 1 diem giua mien kin:")
  pvL nil pvL1 nil)
   (command "boundary" p "")
   (setq et (entlast)
         pvL1 (reverse (getvert et)))  
   (redraw et 3)  
   (setq p00 (getpoint "\nDiem dat Bang TDGR:"))
   (command "erase" et "")
   (setq  p0 p00
          p01  (polar p00 (* 1.5 pi) (* h 3))    
          pvL  (relist pdau pvL1)
          n	(length pvL)
          p02	(polar p01 (* 1.5 pi) (+ (* h 3) (* (1- n) h 2)))
   )  
   (setvar "osmode" 0)
;;;HEADER
 (setvar "CLAYER" "bangtd")
 (linepx p0 (* 32 h))
 (command "copy" "L" "" "m" p00 p01 p02 "")
 (linepy p0 (- (distance p0 p02)))
 (command "copy" "L" "" "m"  p0
   (list (+ (car p0) (* 4 h)) (cadr p0))
   (list (+ (car p0) (* 14 h)) (cadr p0))
   (list (+ (car p0) (* 24 h)) (cadr p0))
   (list (+ (car p0) (* 32 h)) (cadr p0))
   "")
 (setq Lkqua nil)
 (wtxtMC "BAÛNG TOÏA ÑOÄ GOÙC RANH"
  (polar (polar p0 0 (* 16 h)) (* 0.5 pi) (* 2 h))
	 (* 1.2 h) nil)
 (txt1 (setq Lkq (list "TT" "X (m)" "Y (m)" "S (m)")))
 (setq Lkqua (append Lkqua (list Lkq)))
 (setq p0 (polar p0 (* 1.5 pi) (* 3 h)))

;;;MAKE RECORDS
 (setq	j  0
pt nil)
 (repeat n
   (setq
     pv  (nth j pvL)
     num (itoa (1+ j))
   )
   (if	pt
     (setq S (rtos (distance pt pv) 2 ntp))
     (setq S "")
   )
   (setq
     txtL (list num (rtos (car pv) 2 ntp) (rtos (cadr pv) 2 ntp) S)
     Lkqua (append Lkqua (list txtL))
   )
   (txt2 txtL)
   (setq p0 (polar p0 (* 1.5 pi) (* 2 h)))
   (setq pt pv)
   (setq j (1+ j))
   (if	(= j (- n 1))  (setq j 0))
 )

;;;MAKE BLOCK
 (setq ss (collect1 et))
 (setq bn "1")
 (while (tblsearch "block" bn)
   (setq bn (itoa (1+ (atoi bn))))
 )
 (command "block" bn p00 ss "")
 (command "insert" bn p00 "" "" "")

;;;WRITE POINT NAME
 (setvar "CLAYER" "stt")
 (setq j 0)
 (repeat (1- n)
   (setq
     pv  (nth j pvL)
     num (itoa (1+ j))
   )
   (wtxtMC num (polar pv 0 h) h t)
   (command "circle" pv cr0)
   (command "hatch" "S" (setq vtron (entlast)) "")
   (command "erase" vtron "")
   (setq j (1+ j))
 )

;;;GHI CANH THUA
   (setvar "CLAYER" "kichthuoc")
   (ghicanh)  

;;;FINISH
   (savef)
   (setvar "osmode" oldos)
   (setq pdau (getpoint "\nPick diem dau tien (so thu tu = 1) :"))
 )  
 (setvar "cmdecho" 1)
 (princ)
)

;;;-------------------------------------------------------------------------------
(defun savef()  
 (if save
   (progn
     (setq file (open (setq tenfile (strcat (getvar "dwgprefix")
 (vl-filename-base (vl-string-right-trim "\\" (getvar "dwgname"))) ".txt")) "a"))
     (foreach line Lkqua
(setq line1 "")
(foreach it line
  (setq line1 (strcat line1 " " it)))
(write-line line1 file)
     )
     (close file)
     (princ (strcat "\nDa luu thanh file " tenfile))
   )
 )
)

;;;PHAN BO SUNG CUA elleHCSC
;;;------------------------------------------------------------------------------------
(defun Text_canh_TCA (S p a)
;;;Entmake text S at p with angle A - Top Center
 (if (/= p nil)
   (entmake (list
       (cons 0 "TEXT")
       (cons 62 5)
       (cons 10 p)
       (cons 40 h)
       (cons 1 S)
       (cons 50 a)
       (cons 41 0.7)
       (cons 7 (getvar "textstyle"))
       (cons 72 1)
       (cons 11 p)
       (cons 73 3)
     )
   )
 )
)
;;;------------------------------------------------------------------------------------
(defun Text_canh_BCA (S p a)
;;;Entmake text S at p with angle A - Bottom Center
 (if (/= p nil)
   (entmake (list
       (cons 0 "TEXT")
       (cons 62 5)
       (cons 10 p)
       (cons 40 h)
       (cons 1 S)
       (cons 50 a)
       (cons 41 0.7)
       (cons 7 (getvar "textstyle"))
       (cons 72 1)
       (cons 11 p)
       (cons 73 1)
     )
   )
 )
)
;;;-------------------------------------------------------------------------------
(defun Ghicanh (/ i k p1 p2 dist rad x_mp y_mp mp)
 (setq
   i	0   
   k	(1- (length pvL))
 )
 (repeat k
   (setq
     p1   (nth i pvL)
     p2   (nth (+ i 1) pvL)
     dist (distance p1 p2)
     rad  (angle p1 p2)
     x_mp (* (+ (car p1) (car p2)) 0.5)
     y_mp (* (+ (cadr p1) (cadr p2)) 0.5)
     mp   (list x_mp y_mp)
   )
   (if	(and (> rad (* 0.5 pi)) (<= rad (* 1.5 pi)))
     (setq mp (polar mp (+ rad (* 0.5 pi)) (* 0.3 h)))
   )
   (if	(and (> rad (* 0.5 pi)) (<= rad (* 1.5 pi)))
     (progn
(setq rad (+ rad pi))
(Text_canh_TCA (rtos dist 2 2) mp rad)
     )
     (Text_canh_BCA (rtos dist 2 2) mp rad)
   )
   (setq i (1+ i))
 )
 ;; repeat k;
)
;;;--------------------------

 

Chân thành cảm ơn anh.

 

Em có thêm 1 vấn đề phát sinh là mình muốn xuất các toạ độ đó qua Excel thì phải edit chỗ nào đây ạ?

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

Xin chào tất cả anh em trên diễn đàn, mình thấy khi chú thích kích thước hình chiếu trục đo, chúng ta thường dùng lệnh dimension aligned, sau đó dùng lệnh DED để hiệu chỉnh, vậy có cách nào kết hợp hai lệnh thành 1 không? Mong anh em góp ý và giúp đỡ dùm. Thank you anh em trước....

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
Chân thành cảm ơn anh.

 

Em có thêm 1 vấn đề phát sinh là mình muốn xuất các toạ độ đó qua Excel thì phải edit chỗ nào đây ạ?

Chào Kid112

Trong Excel có chức năng tách cột -> Data -> Text to Columns

Bạn copy nội dung file .txt sang Excel -> và thực hiện tách cột trong Excel

Bạn kid112 xuandao hãy cho ví dụ minh hoạ một file txt nào đó đi để Tue_NV chỉ cho cách tách cột nhé

 

Xin chào tất cả anh em trên diễn đàn, mình thấy khi chú thích kích thước hình chiếu trục đo, chúng ta thường dùng lệnh dimension aligned, sau đó dùng lệnh DED để hiệu chỉnh, vậy có cách nào kết hợp hai lệnh thành 1 không? Mong anh em góp ý và giúp đỡ dùm. Thank you anh em trước....

Bạn muốn kết hợp hai lệnh thành 1 như thế nào?? Hiệu chỉnh về cái gì ????

Bạn phải nói rõ ra thì mọi người mới có thể giúp bạn được

Cần thiết thì bạn upload file minh hoạ của bạn và nói rõ

 

Chào bạn. Chúc vui vẻ :s_dead:

  • Vote tăng 2

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
Khách
Chủ đề này bây giờ đã bị đóng lại để trả lời thêm.

×