Jump to content
InfoFile
Tác giả: hhhhgggg
Bài viết gốc: 70603
Tên lệnh: tdn
Lisp ghi tọa độ rất hay mà bị lỗi!

Đây là đoạn lisp mình viết riêng cho anh em trong cty mình dùng, nó có thêm một số lựa chọn có xuất bảng thống kê hay không. ngoài ra nó cũng được viết để phù...
>>
Đây là đoạn lisp mình viết riêng cho anh em trong cty mình dùng, nó có thêm một số lựa chọn có xuất bảng thống kê hay không. ngoài ra nó cũng được viết để phù hợp với việc bạn fải chạy lệnh nhiều lần trong 1 phiên làm việc. dùng cái nào tùy bạn nhé.

(prompt"\n - THONG KE TOA DO by Thaistreetz - huuthais@yahoo.com\n")
----------------------------------------------
(defun C:tdn ()
(setvar "cmdecho" 0 )
(command "Undo" "Begin")  
(setq om (getvar "osmode"))
(setq tapx '() tapy '() stt '()
     ten (getstring "\nTên Nút:"))
(if (not h) (setq h 1))
(if (not i) (setq i 1))
(setq i1  (getreal (strcat"\nSTT Nút Ðâu Tiên < " (rtos i 2 0) " >: "))
   caot1 (getreal (strcat "\nCao text < " (rtos h 2 0) " >:")))
(if i1 (setq i i1))
(if caot1 (setq h caot1))
(setvar "osmode" 125)
(setq lacol (getvar "CEColor") k (- i 1))
;================================================
(While
(setq D1 (getpoint (strcat"\nPick diem thu "(rtos (+ k 1) 2 0)"")))
(Progn
 (setvar "osmode" 0)
 (setq DX (getpoint (strcat"\nDiem dat text thu "(rtos (+ k 1) 2 0)"") D1)
       x   (rtos (car D1) 2 4)
       y   (rtos (cadr D1) 2 4)
TX (strcat "X:"(rtos (Car D1) 2 4))
TY (strcat "Y:"(rtos (Cadr D1) 2 4))
      tapx (append tapx (list x))
      tapy (append tapy (list y))
k   (+ 1 k)
       N   (strcat ten (rtos k 2 0))
       stt (append stt (list N))
 );setq
 (if (>= (car DX) (car D1)) 
(progn
(setq D2 (list (+ (car DX) (* 0.5 h)) (cadr DX)))	   
   	(command "text" "BL" D2 h 0 tX)
 	(setq   TB  (textbox (entget(entlast)))
   		LC  (car TB)
  		RC  (cadr TB)
   		di  (distance LC RC)
	PT3 (polar D2 0 (+ di (* 0.6 h)))
	pt4 (list (car D2) (- (cadr D2) (* 1.35 h)))
	pt5 (list (+ (car D2) di) (- (cadr D2) (* 1.35 h)))		
	C   (polar PT3 0 (* 1.5 h))
 	);setq
 	(command "text" "F" PT4 PT5 h ty
          	 "pline" D1 DX PT3 ""
          	 "circle" (polar PT3 0 (* 1.5 h)) (* 1.5 h)
          	 "circle" (polar PT3 0 (* 1.5 h)) (* 1.35 h)
          	 "text" "m" (polar PT3 0 (* 1.5 h)) h 0 N 
          	 "CECOLOR" 8
	 "circle" (polar PT3 0 (* 1.5 h)) (* 1.35 h)
 	  );command
  (setvar "CECOLOR" lacol)
);progn
  );if
 (if (< (car DX) (car D1)) 
(progn
  (setq D2 (list (- (car DX) (* 0.5 h)) (cadr DX)))	   
 	  (command "text" "BR" D2 h 0 tx)
 	  (setq   TB  (textbox (entget(entlast)))
   		  LC  (car TB)
  		  RC  (cadr TB)
   		  di  (distance LC RC)
	  PT3 (polar D2 0 (- (+ di (* 0.6 h))))
	  pt4 (list (- (car D2) di) (- (cadr D2) (* 1.35 h)))
	  pt5 (list (car D2) (- (cadr D2) (* 1.35 h)))
	  PT6 (list (- (car PT3) (* 3 h)) (cadr PT3))
	  C   (polar PT3 0 (* 1.5 h))
 	  );setq
 	  (command "text" "F" PT4 PT5 h TY
          	   "pline" D1 DX PT3 ""
          	   "circle" (polar PT6 0 (* 1.5 h)) (* 1.5 h)
          	   "text" "m" (polar PT6 0 (* 1.5 h)) h 0 N 
          	   "CECOLOR" 8
	   "circle" (polar PT6 0 (* 1.5 h)) (* 1.35 h)
 	  );command
  (setvar "CECOLOR" lacol)
);progn
  );if
);progn
(setvar "osmode" 125)
);while
(setq i (+ k 1))
;=============================================
(setq bit (cond (bit) ("Yes")))
(initget "Yes No")
(setq	Tmp (strcat "\nXuât Bang Toa Ðô?  <" bit ">: ")
bit (cond ((getkword Tmp)) (bit)))
(if (eq bit "Yes")
(progn
(setq	di (- di (* 1.7 h))
kc (* 2 di)
       PT (getpoint"\nVi tri dat bang")
   	PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))  
     	p1 (list (car PT) (+ (cadr PT)(* 2 h)))
     	p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))
     	p3 (list (car p1) (+ (cadr p1)(* 2 h)))
     	p4 (list (car p2) (+ (cadr p2)(* 2 h)))
    	PTD (list (+ (/ di 2) (car PT))  (+ h (cadr PT)))
    	PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
    	PTY (list (+ kc (car PTX)) (cadr PTX))
     	p11 (list (+ (/ di 2) (car p1))  (+ h (cadr p1)))
     	p22 (list (+ di (/ di 2) (car p11)) (cadr p11))
     	p33 (list (+ kc (car p22)) (cadr p22))
     	L1 (list (+ di (car p3))(cadr p3))
     	L2 (list (+ kc (car L1))(cadr L1))
PTB (list (+ (* 0.5 (+ (* 2 kc) di)) (car PT)) (+ (cadr P3) (* 1.8 h)))
    	n (length tapx)
    	k 0
);setq
(setvar "osmode" 0)
(command "CECOLOR" 3 "line" p1 p2 "" "line" p3 p4 "" "CECOLOR" 2
      	"text" "m" p11 h 0 "STT" 
      	"text" "m" p22 h 0 "Täa ®é X" 
      	"text" "m" p33 h 0 "Täa ®é Y"
      	"text" "m" pTB (* 1.3 h) 0 "%%UB¶ng thèng kª täa ®é nót")    
(while (< k n) 
(setq xx (nth k tapx) yy (nth k tapy) tstt(nth k stt))
(command "CECOLOR" 2
 "text" "m" PTD h 0 tstt 
        "text" "m" PTX h 0 xx 
        "text" "m" PTY h 0 yy
 "CECOLOR" 3 
        "line" PT PTC "")    
(setq 	PT (list (car PT) (- (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
PTD (list (+ (/ di 2) (car PT))  (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
PTY (list (+ kc (car PTX)) (cadr PTX))
k (+ 1 k));setq
);while
(if (= k n)
(setq 	PT (list (car PT) (+ (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
L11 (list (+ di (car PT))(cadr PT))
L22 (list (+ kc (car L11))(cadr L11))
);setq
);if
(command "CECOLOR" 3 
"line" p3 PT ""
"line" p4 PTC ""
"line" L1 L11 ""
"line" L2 L22 "")
);progn
);if
(setvar "CECOLOR" lacol)
(setvar "osmode" om)
(prompt"\n by Thaistreetz - huuthais@yahoo.com\n")
(command "Undo" "End")
(setvar "cmdecho" 1)
(princ)
);DONG toado

 

Cảm ơn bạn rất nhiều. Lisp của bạn giúp ích cho mình được rất nhiều. Nhưng mình góp ý chân thành rằng ko chỉ riêng mình mà với tất cả các bản vẽ thì tên nút nhiều khi nó được đặt từ trước rồi, cho nên việc tự đặt ra tên nút như thế chưa thực sự phù hợp. Nếu bạn lầm thêm được phần: " Danh ten nut tu dong " thì lisp này hoàn thiện.

Trong trường hợp ko đánh tự động thì lisp mang chức năng thống kê toạ độ cho người sử dụng, Tên nút là tên do người dùng nhập vào.Và mình đề xuất đổi dòng : (setvar "osmode" 125) thành (setvar "osmode" 15359)

mình ko hiểu về lisp, ko biết viết lisp. Hjxhjx !!! Cảm ơn bạn đã quan tâm giúp đỡ !

Khi nào rỗi bạn có thể sửa giúp mình 1 chút thui được ko ? Vì nếu có được 1 lisp như thế thì nó sẽ júp ích được mình rất nhìu !!!

Command : TDN

Ten nut:

Pick diem:

 

Ten nut:

Pick diem:

 

Ten nut:

Pick diem:

 

Ten nut:

Pick diem:

 

Vi tri dat bang:

 

Tên nút là tên mình nhập vào, ko phải là đánh tự động !!!

Cảm ơn bạn nhé !!!


<<

Filename: 70603_tdn.lsp
Tác giả: 790312
Bài viết gốc: 153709
Tên lệnh: ho styb
Lisp chỉnh style TEXT trong block thuộc tính

Tue_NV sửa lại code wo -> đổi bề rộng Block Att. Bạn download Lisp wo ở bài viết trên của Tue_NV nhé.

Còn đây là Lisp đổi chiều...

>>

Tue_NV sửa lại code wo -> đổi bề rộng Block Att. Bạn download Lisp wo ở bài viết trên của Tue_NV nhé.

Còn đây là Lisp đổi chiều cao của Block Att

và Lisp styb đổi Style của Block ATT về Textstyle hiện hành

(defun c:ho( / ssdt sodt index tt entdt w)  
 (setq ssdt (ssget '((0 . "INSERT") (66 . 1)))
sodt (sslength ssdt)
index 0
  )
 (or *w* (setq *w* 1.0))
 (setq w (getreal (strcat "\n Nhap chieu cao < " 
			(rtos *w* 2 2) " > :")))
 (if w (setq *w* w) (setq w *w*))
 (repeat sodt
   (setq entdt (ssname ssdt index)
  index (1+ index))
   (while (/= (cdr(assoc 0 (entget entdt))) "SEQEND")
   	(setq
    entdt (entnext entdt)
  tt (entget entdt)
  tt (subst (cons 40 w) (assoc 40 tt) tt)
   	)
  	 (entmod tt)
   	(entupd entdt)
   )
 )
 (princ)
)
;;
(defun c:styb( / ssdt sodt index tt entdt)  
 (setq ssdt (ssget '((0 . "INSERT") (66 . 1)))
sodt (sslength ssdt)
index 0
  )

 (repeat sodt
   (setq entdt (ssname ssdt index)
  index (1+ index))
   (while (/= (cdr(assoc 0 (entget entdt))) "SEQEND")
   	(setq
    entdt (entnext entdt)
  tt (entget entdt)
  tt (subst (cons 7 (getvar "textstyle")) (assoc 7 tt) tt)
   	)
  	 (entmod tt)
   	(entupd entdt)
   )
 )
 (princ)
)

Không thể nhập chung thành 1 dòng lệnh được sao bác?thí dụ đánh wo thì hỏi nhập chiều dày text xong hỏi nhập chiều cao text nếu không nhập enter thì giữ nguyên chiều cao,tiếp hỏi nhập tên text style nếu không nhập enter giữ nguyên.Cảm ơn sự nhiệt tình của bác.


<<

Filename: 153709_ho_styb.lsp
Tác giả: buithengan1
Bài viết gốc: 312250
Tên lệnh: dcap
Nhờ Giúp Lisp Đánh Cấp

 

Bạn dkkx3a và bạn xaakiii_mboet có thể cho biết bạn đánh cấp cho Pline gấp khúc, nhưng bạn đánh cấp với trường...

>>

 

Bạn dkkx3a và bạn xaakiii_mboet có thể cho biết bạn đánh cấp cho Pline gấp khúc, nhưng bạn đánh cấp với trường hợp các cấp nằm dưới Pline sử dụng trong trường hợp thực tế nào không?

Tue_NV sử dụng Lisp đánh cấp với các cấp nằm trên Pline trong trường hợp đánh bậc cấp.

Tue_NV xin nâng cấp vào Lisp : đánh cấp cho pline gấp khúc ở 2 trường hợp :

1. Các cấp nằm trên pline

2. các cấp nằm dưới pline

Các bạn sử dụng thử xem : (áp dụng đúng luôn cho Spline)

(defun c:dcap(/ curve B sp ep Lx n po1 po2 po3 i oldos ans)(vl-load-com)(command "undo" "be")(setq oldos (getvar "osmode"))(setvar "osmode" 0)(setvar "cmdecho" 0)(setq curve (car(entsel "\n Ban Pick chon Pline :")) ss (ssadd))(while (null curve) (setq curve (car(entsel "\n Ban Pick chon lai Pline :")))) (setq B (getdist "\n Nhap be rong danh cap :"))(initget "T D")	(setq ans (getkword "\n Ban danh cap Tren hay Duoi duong pline < T / D > :"))(setq sp (vlax-curve-getStartPoint curve))(setq ep (vlax-curve-getEndPoint curve))	(if (> (cadr sp) (cadr ep))   		(progn			(setq ep (vlax-curve-getStartPoint curve))			(setq sp (vlax-curve-getEndPoint curve))		))(setq Lx (abs (- (car ep) (car sp)) ))(setq n (abs(fix (/ (- Lx (rem Lx B )) B ))) i 1)(setq po1 sp)(Repeat n(setq dvi (list (+ (car sp) (* i B )) (cadr sp) 0))(command "Xline" "Ver" dvi "")(setq po3 (car (giaodt curve (entlast))) )(entdel (entlast))(if (= ans "D")(setq po2 (list (car po3) (cadr po1) 0))(setq po2 (list (car po1) (cadr po3) 0)))(dline po1 po2) (dline po2 po3)(setq po1 po3)(setq i (1+ i)))(if (= ans "D")(setq po2 (list (car ep) (cadr po1) 0))(setq po2 (list (car po1) (cadr ep) 0)))(dline po1 po2)(dline po2 ep) (setvar "osmode" oldos)(command "undo" "end")(princ));(defun dline(p1 p2)(entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2))));(defun GiaoDT (ent1 ent2)(setq ob1 (vlax-ename->vla-object ent1)ob2 (vlax-ename->vla-object ent2))(setq g (vlax-variant-value(vla-IntersectWith ob1 ob2 acExtendNone)))(if (/= (vlax-safearray-get-u-bound g 1) -1)(setq g (vlax-safearray->list g))(setq g nil))(if g(progn(setq kq nilsd (fix (/ (length g) 3)))(repeat sd(setq kq (append kq (list (list (car g) (cadr g) (caddr g))))g (cdddr g)))kq)nil))
Hiện nay chức năng download Lisp file của diễn đàn bị lỗi. Nếu bạn sử dụng chức năng download Lisp file của diễn đàn bị lỗi thì hãy nhấn nút Reply bài viết này của Tue_NV -> chép hết code về (không sót đấy nhé về chạy thử là được

Chúc thành công tongue2.gif

bạn tue-nv ơi bạn có thể sửa giùm mình cái lisp này thành  đánh cấp với chiều cao H cho trước được không. cảm ơn bạn trước nha


<<

Filename: 312250_dcap.lsp
Tác giả: taipham
Bài viết gốc: 406783
Tên lệnh: vtt
Nhờ Thêm Vòng Lặp Vào Lisp
(defun C:VTT()
(command "undo" "be")
  (setq cmd (getvar "cmdecho")
	osm (getvar "osmode"))
  (setvar "cmdecho" 0)
  (or (and mut...
>>
(defun C:VTT()
(command "undo" "be")
  (setq cmd (getvar "cmdecho")
	osm (getvar "osmode"))
  (setvar "cmdecho" 0)
  (or (and mut (or (= (type mut) 'int) (= (type mut) 'real))) (setq mut 30)) 
  (setq mut (cond ((getdist (strcat "\nChieu dai doan mu <" (rtos mut 2 2) ">: "))) (mut)))
  (setq chk t)
  (while
    (or	(and chk
	  (setq dt (entsel "\nChon duong thang: "))
	    )
	(and (setq p1 (getpoint "\nChon diem dau"))
	     (setq p2 (getpoint p1 "\nChon diem cuoi"))
	     (not (setq chk nil))
	)
    )
  (if dt
;;;    (= dt nil)
;;;	(progn
;;;	(setq p1 (getpoint "\nChon diem dau")
;;;	      p2 (getpoint p1 "\nChon diem cuoi")))
    (if
      (= "LWPOLYLINE" (cdr (assoc 0 (entget (car dt)))))
      (progn
	(setq pt (acet-geom-vertex-list (car dt))
	   p1 (car pt)
	   p2 (last pt)))
      (if
	(= "LINE" (cdr (assoc 0 (entget (car dt)))))
	(progn
        (setq dt (car dt)
	   dt (entget dt)
	   p1 (cdr (assoc 10 dt))
	   p2 (cdr (assoc 11 dt))))
	(princ "\nChon sai")))
    )
  (setvar "osmode" 0)
  (setq	p3 (polar p1 (+ pi (angle p1 p2)) mut)
	p4 (polar p2 (angle p1 p2) mut))
  (command ".mline" p3 p4 "")
  (setvar "osmode" osm)
  );while
  (setvar "cmdecho" cmd)
  (command "undo" "e")
  (princ))

dùng tạm cái này

 

Oke, hay quá, cảm ơn anh nhiều nhé!


<<

Filename: 406783_vtt.lsp
Tác giả: phamngoctukts
Bài viết gốc: 108837
Tên lệnh: vtb
nhờ các cao thủ viết dùm lisp hatch,ve thang cat.

Còn cái vẽ thang này đúng ý của bạn

Buồn quá có việc bận nên không offline cùng anh em cadviet được. Thật là tiếc!!!

Ngồi buồn quá dở cái lisp vẽ...

>>

Còn cái vẽ thang này đúng ý của bạn

Buồn quá có việc bận nên không offline cùng anh em cadviet được. Thật là tiếc!!!

Ngồi buồn quá dở cái lisp vẽ thang của bác hoành ra sửa lại tí chút cho đúng cấu tạo.

tiện thể port lên đây cho anh em nào cần thì nhậu.

lisp này kết hợp với lisp vẽ lan can sắt của mình thì rất tiện.

(defun c:vtb (/ p c r sb oldos nb bk MBTong1 tl1 angh1 MBTong2 tl2 angh2
MBTong3 tl3 angh3 d oldos di ang p2 p3 p4 dibt pbt1 
pbt2 pbt3 el1 el2 el3 ans)
(setvar "cmdecho" 0)
(setq old_layer (getvar "clayer"))
(setq tbl (tblsearch "layer" "_cat"))
(if (= tbl nil) (command "-layer" "n" "_cat" "c" "4" "_cat" ""))
(setq tbl1 (tblsearch "layer" "_hatch"))
(if (= tbl1 nil) (command "-layer" "n" "_hatch" "c" "8" "_hatch" ""))
(setq tbl2 (tblsearch "layer" "_thay"))
(if (= tbl2 nil) (command "-layer" "n" "_thay" "c" "23" "_thay" ""))
(setvar "clayer" "_cat")
(setq nb 20.0 bk 10.0
MBTong1 "ANSI32" tl1 100 angh1 0
MBTong2 "ar-conc" tl2 10 angh2 0
MBTong3 "ANSI31" tl3 200 angh3 0
MBTong4 "ar-sand" tl4 4 angh4 0
p (getpoint "\nVao diem dau tien: ")
c (getdist p "\nVao chieu cao bac: ")
r (getdist p "\nVao chieu rong bac: ")
sb (getint "\nVao so bac: ")
d (getdist "\nVao be day ban thang be tong : ")
oldos (getvar "osmode")
di (* sb (sqrt (+ (* c c) (* r r)) ))
ang (atan (/ c r))
p01 (polar p 0 10)
p02 (polar p01 (/ (* 270 pi) 180) 20)
p03 (polar p02 ang (/ 20 (sin ang)))
p2 (polar p02 ang di)
p22 (polar p2 (/ (* 90 pi) 180) 20)
p222 (polar p22 (/ (* 180 pi) 180) 10)
p3 (polar p03 0 (/ d (sin ang)))
p33 (polar p02 0 (/ d (sin ang)))
p4 (polar p2 (/ (* 3 pi) 2) (/ d (cos ang))) 
dibt (/ 10 (cos ang))
pbt1 p02
pbt3 (polar p02 ang (/ (distance p02 p2) sb) ) 
pbt2 (list (car pbt1) (cadr pbt3) 0)
pbt4 (polar pbt2 (/ (* 90 pi) 180) 10)
)
(setvar "osmode" 0 )
(command ".pline")
(command p)
(repeat sb
(command
(strcat "@0," (rtos (- c (* 2.0 bk))))
(strcat "@" (rtos (- bk nb)) ",0")
"a"
(strcat "@0," (rtos (* 2.0 bk)))
"l"
(strcat "@" (rtos (+ (- nb bk) r)) ",0")
)
)
(command "")
(setq thay (entlast))
(initget "C K")
(setq ans (getkword "\n Ban muon cat qua cau thang hay khong < C / K > :"))
(if (= ans "K")
(progn
(command "pline" p p3 p4 p2 p22 p222 "")
(command "change" "l" "" "p" "la" "_thay" "")
(command "change" thay "" "p" "la" "_thay" "")
)
)
(if (= ans "C") 
(progn
(setvar "cmdecho" 0)
(command "line" p p01 "")
(setq el4 (entlast))
(command "pline" p02 p33 p4 p2 "c")
(setq eL (entlast))
(command "hatch" MBTong1 tl1 angh1 eL "")
(command "change" "l" "" "p" "la" "_hatch" "")
(command "hatch" MBTong2 tl2 angh2 eL "")
(command "change" "l" "" "p" "la" "_hatch" "")
(command "pline" pbt1 pbt2 pbt3 "C")
(setq eL1 (entlast))
(command "hatch" MBTong3 tl3 angh3 eL1 "")
(command "change" "l" "" "p" "la" "_hatch" "")
(setq eL2 (entlast))
(command "line" pbt3 (list (car p) (cadr pbt3) 0) "")
(setq eL3 (entlast))
(command "ucs" "z" p02 p2)
(command "ARray" el1 el2 el3 el4 "" "R" "1" sb (/ di sb))
(command "ucs" "")
(command "-BOUNDARY" pbt4 "")
(setq eL5 (entlast))
(command "rectang" p pbt2)
(setq eL6 (entlast))
(command "hatch" MBTong4 tl4 angh4 eL5 "")
(command "change" "l" "" "p" "la" "_hatch" "")
(setq eL8 (entlast))
(command "hatch" MBTong4 tl4 angh4 el6 "")
(command "change" "l" "" "p" "la" "_hatch" "")
(setq eL7 (entlast))
(command "ucs" "z" p02 p2)
(command "ARray" eL5 eL6 el7 el8 "" "R" "1" sb (/ di sb))
(command "ucs" "")
)
)
(setvar "osmode" oldos)
(setvar "clayer" old_layer)
(princ)
)


<<

Filename: 108837_vtb.lsp
Tác giả: thanhduan2407
Bài viết gốc: 424613
Tên lệnh: 00
Chèn points vào vị trí text
(defun c:00 (/ LTSTEXT  SSTEXT)
  (vl-load-com)
  (setvar "CMDECHO" 0)
  (setq Olmode (getvar "OSMODE"))
  (_layer2 "POINTS" 7)
  (setq ssText (ssget '((0 . "TEXT"))))
  (if ssText
    (Progn
      (setq LtsText (LM:ss->ent ssText))
      (foreach e LtsText
	(entmake (list (cons 0 "POINT") (cons 8 "POINTS")(cons 10 (TD:Text-Base e))))
      )
    )
  )
  (princ)
)
(defun LM:ss->ent (ss / i l)
  (if ss
    (repeat...
>>
(defun c:00 (/ LTSTEXT  SSTEXT)
  (vl-load-com)
  (setvar "CMDECHO" 0)
  (setq Olmode (getvar "OSMODE"))
  (_layer2 "POINTS" 7)
  (setq ssText (ssget '((0 . "TEXT"))))
  (if ssText
    (Progn
      (setq LtsText (LM:ss->ent ssText))
      (foreach e LtsText
	(entmake (list (cons 0 "POINT") (cons 8 "POINTS")(cons 10 (TD:Text-Base e))))
      )
    )
  )
  (princ)
)
(defun LM:ss->ent (ss / i l)
  (if ss
    (repeat (setq i (sslength ss))
      (setq l (cons (ssname ss (setq i (1- i))) l))
    )
  )
)
(defun _layer2 (name colour)
  (if (null (tblsearch "LAYER" name))
    (entmake
      (list
	'(0 . "LAYER")
	'(100 . "AcDbSymbolTableRecord")
	'(100 . "AcDbLayerTableRecord")
	'(70 . 0)
	(cons 2 name)
	(cons 62 colour)
      )
    )
  )
)

(defun TD:Text-Base (ent / MA71 MA72 X11)
  (setq Ma10 (cdr (assoc 10 (entget ent))))
  (setq Ma11 (cdr (assoc 11 (entget ent))))
  (setq X11 (car Ma11))
  (setq Ma71 (cdr (assoc 71 (entget ent))))
  (setq Ma72 (cdr (assoc 72 (entget ent))))
  (if (or (and (= Ma71 0) (= Ma72 0) (= X11 0))
	  (and (= Ma71 0) (= Ma72 3))
	  (and (= Ma71 0) (= Ma72 5))
      )
    Ma10
    Ma11
  )
)

 


<<

Filename: 424613_00.lsp
Tác giả: ndtnv
Bài viết gốc: 106606
Tên lệnh: ins point
Chèn points vào vị trí text
Update theo yêu cầu.

Lisp chèn Point vào điểm insertion của Text (nếu có), t/hợp Text không có điểm insertion chèn Point vào điểm Node.

>>
Update theo yêu cầu.

Lisp chèn Point vào điểm insertion của Text (nếu có), t/hợp Text không có điểm insertion chèn Point vào điểm Node.

(chú ý: Lisp này chưa xét đến t.hợp nội dung Text không phải là số. Vd: " 123 0" có khoảng trắng giữa các kí tự)

(defun c:ins_point (/ curlayer edata i pt ss txt)
 (if (setq ss (ssget (list (cons 0 "TEXT"))))
   (progn
     (setq i 0
    curLayer (getvar "clayer"))
     (if (not (tblsearch "layer" "points"))
(command "-layer" "n" "points"  "c" "1" "points" "") )
     (setvar "clayer" "points")
     (repeat (sslength ss)
(setq edata (entget(ssname ss i))
      pt (if (equal (setq pt (cdr (assoc 11 edata))) '(0 0 0))
	   (cdr (assoc 10 edata))
	   pt)
      txt (atof(cdr (assoc 1 edata)))
      pt (list (car pt)(cadr pt) txt)
      i	 (1+ i)	)
(entmake (list (cons 0 "POINT") (cons 10 pt))) )
     (setvar "clayer" curLayer)  )  )
 (princ))

Lisp của bạn

(setq pt (if (equal (setq pt (cdr (assoc 11 edata))) '(0 0 0)) (cdr (assoc 10 edata)) pt))

ngắn hơn 1 chút so với lisp

(setq pt (cdr (assoc (if (< 0 (+ (cdr (assoc 72 edata)) (cdr (assoc 73 edata)))) 11 10) edata)))

nhưng sẽ sai trong trường hợp text có điểm chèn tại '(0 0 0) mặc dù xác suất xảy ra trong thực tế =0


<<

Filename: 106606_ins_point.lsp
Tác giả: conghoan1003
Bài viết gốc: 74652
Tên lệnh: ctn
Viết lisp theo yêu cầu [phần 2]
Chiều nay em bận quá, giờ mới post lên cho bác được.

Lisp của bác đây ạ:

- Pick điểm tim trắc ngang -> Pick chọn text cao độ tương ứng của tim

-...

>>
Chiều nay em bận quá, giờ mới post lên cho bác được.

Lisp của bác đây ạ:

- Pick điểm tim trắc ngang -> Pick chọn text cao độ tương ứng của tim

- Pick các điểm cần lấy cao độ thiết kế -> Pick chọn text để ghi cao độ điểm đó. -> tiếp tục pick các điểm khác... Enter để kết thúc.

(defun DXF (code elist)  (cdr (assoc code elist)))
(prompt"\n - GHI CAO DO TRAC NGANG\n")
(defun c:ctn ()
(command "Undo" "BEGIN")
(setq CMLAST (getvar "cmdecho"))
(setq OSLAST (getvar "OSMODE"))
(setq DZ (getvar "DIMZIN"))
(setq OT (getvar "ORTHOMODE"))
(setvar "ORTHOMODE" 0)
(setvar "cmdecho" 0)
(command "osmode" 1)
(setq pt0 (osnap (getpoint "Diem tim TN tu nhien") "end")) (print)
(setq y0 (cadr pt0))
(setq ed (entget (car (entsel "\nChon text cao do tim: "))))
(setq H0 (read (DXF 1 ed)))    
(command "osmode" 4335)
(setq pt (getpoint "\nDiem tra cao do: "))
(While (/= pt nil)
(setq y (- (cadr pt) y0 (- H0)) out 0)
(while (= out 0)
(setq res (entsel "\n Chon text ghi cao do"))
(if res
(progn
(setvar "dimzin" 0)
(entmod (subst (cons 1 (rtos y 2 2)) (assoc 1 (entget (car res))) (entget (car res))))
(setq out 1)
);progn
);if
);while
(setvar "DIMZIN" DZ)
(command "osmode" 4335)
(setq pt (getpoint "\nDiem chen: "))
);while 
(setvar "OSMODE" OSLAST)
(setvar "ORTHOMODE" OT)
(setvar "cmdecho" CMLAST)
(prompt"\n by Thaistreetz - huuthais@yahoo.com\n")
(command "Undo" "End")
(princ)
);end
;---------------------------------------------------------------

Cảm ơn Thaistreets! Đúng cái mình cần rồi, Lisp tốt lắm!


<<

Filename: 74652_ctn.lsp
Tác giả: nguyenngoc02n
Bài viết gốc: 411458
Tên lệnh: test
Lisp Viết Text/mtext Trên Pline

   BƯỚC 1: GÕ LỆNH CHỌN TẬP HỢP CÁC ĐỐI TƯỢNG (có thể kết hợp chỉ chọn PLINE,LINE) dùng qua hàm

>>

   BƯỚC 1: GÕ LỆNH CHỌN TẬP HỢP CÁC ĐỐI TƯỢNG (có thể kết hợp chỉ chọn PLINE,LINE) dùng qua hàm

(ssget '(( 0 . "LINE,LWPolyline")))

   BƯỚC 2: LỌC QUA TOÀN BỘ ĐỐI TƯỢNG LÀM CÁC CÔNG VIỆC SAU:

        - Lấy chiều dài của đối tượng đang sử lý (có ename được setq là "dt") gán giá trị này cho biến "L"

        - Lấy 1 điểm trên (gần) Pline, Line làm điểm chèn TEXT ký hiệu điểm này là p

        - Entmakex TEXT (hoặc Mtext) giá trị L tại điểm chèn p đã có ở trên

   BƯỚC 4: KẾT THÚC LỆNH

http://www.cadviet.com/forum/topic/47335-da-xong-lisp-xuat-chieu-dai-line-ra-text-co-san-va-co-tien-to-hau-to/

 

(defun c:test()
  (defun vText(str p k / xp yp)
    (entmakex
      (list
'(0 . "TEXT")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 1 str);string
(cons 7 (getvar "textstyle"));style
(cons 8 (getvar "clayer"));layer
(cons 62 256);color
(cons 10 p);insertion point
(cons 11 p);alignment point
(cons 40 k);text height - change by suit
(cons 41 1.0);text width
(cons 50 0.0);1.5708 - vertical, 0.0 - horizontal
(cons 51 0.0);oblique angle
'(71 . 0);alignment
'(72 . 0);alignment
'(73 . 0);alignment
)
      )    
    )
  (vl-load-com)
  (foreach dt (acet-ss-to-list (setq ss (ssget '(( 0 . "*LINE")))))
    (setq p (cdr(assoc 10 (entget dt))))
    (setq L (vla-get-length (vlax-ename->vla-object dt)))
    (vText (rtos L 2 4) p 25))
  (princ))

 

Toàn bộ (defun vtext .... để xác định hàm con với 3 tham số đầu vào sẽ hoạt động in ra màn hình một Dtext với nội dung như string, tại điểm chèn p; với chiều cao chữ k

Phần hoạt động chính chỉ đơn giản như sau:

 

  - foreach --... lọc qua một lượt toàn bộ đối tượng.

  - (setq p (cdr(assoc 10 (entget dt)))) xác định điểm p trên đối tượng

  - (setq L (vla-get-length (vlax-ename->vla-object dt))) xác định chiều dài từng đối tượng.

  - vtext (rtos L 2 4) p 25    in ra màn hinh Dtext nội dung "L", tại điểm p, chiều cao 25

kết thúc

Hay quá cám ơn bạn nhiều


<<

Filename: 411458_test.lsp
Tác giả: ketxu
Bài viết gốc: 108584
Tên lệnh: recc
Cùng nhau học LISP

Trích dẫn(ketxu @ Sep 20 2010, 17:40)

Vấn đề của mình là tạo HCN,sau đó "cầm" nó để pick vào các điểm tâm một cách trực quan,gần gần giống như copy vậy. code mình mới viết được như ở dưới.Nhưng bị vướng ở chỗ mình đã tạo điểm...

>>
Trích dẫn(ketxu @ Sep 20 2010, 17:40)

Vấn đề của mình là tạo HCN,sau đó "cầm" nó để pick vào các điểm tâm một cách trực quan,gần gần giống như copy vậy. code mình mới viết được như ở dưới.Nhưng bị vướng ở chỗ mình đã tạo điểm tâm rõ ràng rồi,nhưng không hiểu sao nếu user nhập vào bằng bàn phím chiều dài cạnh,thì Tâm lại là trung điểm 1 cạnh Còn nếu user input chiều dài cạnh bằng cách pick điểm thì mới đúng ý mình.Thêm 1 ý nữa,lệnh copy chỉ thực hiện 1 lần,kể cả khi đã thêm dòng multiple trước khi thực hiện lệnh ,không đúng ý mình..Mọi người xem code giùm mình với.Vạn sự khởi đầu nan ( Cám ơn mọi người

phamngoctukts

Mình chỉnh sửa lại cho đúng ý bạn rồi nhé

 

file: recc.lsp

;; free lisp from cadviet.com(defun C:RECc (/ GOC1 dx dy temp-1 temp-2 GOC2 TAM)(setq dx (getdist "\nChieu dai canh theo truc x: ")dy (getdist "\nChieu dai canh theo theo truc y: ")GOC1 (getpoint "\nDiem dat.: ")GOC2 (list (+ (car GOC1) dx) (+ (cadr GOC1) dy) 0)TAM (list (+ (car GOC1) (/ dx 2)) (+ (cadr GOC1) (/ dy 2)) 0))(vl-cmdf "._RECTANGLE" "_non" GOC1 "D" dx dy "_non" GOC2"_.copy" "L" "" "m" TAM pause))

 

Sau khi bạn tạo hình chữ nhật xong tạo cho nó một biến để sau này dung lại.

Khi tạo xong dùng hàm entlast. Ví dụ (setq el (entlast)). Biến el chính là hình chữ nhật bạn vừa tạo.

khi bạn muốn hatch nó chỉ việc: (vl-cmdf "hatch" "tenvatlieu" "tile" el "") là hình chữ nhật của bạn se đưọc hatch. Chúc bạn mau chóng thành công.


<<

Filename: 108584_recc.lsp
Tác giả: amateurday
Bài viết gốc: 81423
Tên lệnh: kt2
lisp kích thước
Fix lỗi :
;----kich thuoc duong thang --------
(defun c:kt2(/ vl ov ss d1 d2 d3 d4 d5 ent kc)
 (vl-load-com)
 (command "_.undo" "_begin")  
 (setq vl '("osmode" "orthomode" "cmdecho") ;...
>>
Fix lỗi :
;----kich thuoc duong thang --------
(defun c:kt2(/ vl ov ss d1 d2 d3 d4 d5 ent kc)
 (vl-load-com)
 (command "_.undo" "_begin")  
 (setq vl '("osmode" "orthomode" "cmdecho") ; Sys Var list
       ov (mapcar 'getvar vl))              ; Get Old values
 (mapcar 'setvar vl '(0 0 0))
 (princ "\nChon duong thang can ghi kich thuoc : ")
 (if (and
(setq ss (ssget (list (cons 0 "LINE")) ))
(setq kc (getdist "\nNhap khoang cach : "))
(setq d4 (getpoint "\nHuong dat kich thuoc ? ") ) )
   (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
     (setq d1 (vlax-curve-getStartPoint ent)
    d2 (vlax-curve-getEndPoint ent)
    d5 (vlax-curve-getClosestPointTo ent d4 T)
    d3 (polar d5 (angle d5 d4) kc))
     (command "dimaligned" d1 d2 d3)
     )
   )
 (mapcar 'setvar vl ov) ; reset Sys Vars
 (command "_.undo" "_end")
 (princ)
 )

 

không phải như vậy giabach ơi. nếu thế này thì dùng quịckdimlinear có sẵn rồi

sorry vì không nói rõ là thế này, mình đã có sẵn các đường kích thước nằm rải rác trên bản vẽ rồi, bây giờ mình muốn cho tất cả cách đường kt cách đường ghi kt 1 khoảng cách nhất định.

Lý do: annotative khi thay đổi, mũi tên, text thay đổi theo nhưng khoảng cách từ đg kt đến đg ghi kt thì lại cố định, nếu có lisp thì không phải kéo từng cái.


<<

Filename: 81423_kt2.lsp
Tác giả: whatcholingon
Bài viết gốc: 169626
Tên lệnh: rot
Lisp chèn text vào Pl

Nề bạn. :b

(Defun c:rot ( )
(princ "\nPHAM QUOC DUY Binh Son - Quang ngai")
(command "undo" "be")
(Princ "\nHay chon doi tuong...
>>

Nề bạn. :b

(Defun c:rot ( )
(princ "\nPHAM QUOC DUY Binh Son - Quang ngai")
(command "undo" "be")
(Princ "\nHay chon doi tuong :")
(setq SS (ssget '((0 . "TEXT"))))

 (setq gqtTB (getstring 5"\nNhap goc xoay: "))

(setq i 0)
(setq N (sslength ss))
(while (< i N)
  (setq TEXTENT (ssname SS i))
(setq luubatdiem (getvar "osmode"))
 (setvar "osmode" 0)
(command "ucs" "object" textent)
(setq tbTB (textbox (list (cons -1 textent)))
	ll (car tbTB)
   	ur (cadr tbTB)
   	ul (list (car ll) (cadr ur))
   	lr (list (car ur) (cadr ll))
)

 (setq  daitext (distance ul lr))
 (setq goctext(angle ul lr))
 (setq dainuatext (/ daitext 2))
 (setq diemquay (polar ul goctext dainuatext))

(command ".rotate" textent "" diemquay gqtTB)
(command "ucs" "p")
  (setq i (1+ i))
(setvar "osmode" luubatdiem)
)
(command "undo" "end")
(setvar "MODEMACRO" "**CHUC BAN LAM VIEC HIEU QUA** PHAM QUOC DUY - BINH SON - QUANG NGAI")
 	(Princ)
)

 

Hay thật Thanks bạn nhiều nhé!


<<

Filename: 169626_rot.lsp
Tác giả: codered8x
Bài viết gốc: 94130
Tên lệnh: thw
Làm cân đối lại Text khi Scale 1 chiều ??
Bạn có thể sử dụng lệnh MO -> Bảng Properties để chỉnh. Nhưng nếu quá nhiều thì có thể sử dụng code Lisp sau :

(defun c:thw(/ as doc schx scwx schy...
>>
Bạn có thể sử dụng lệnh MO -> Bảng Properties để chỉnh. Nhưng nếu quá nhiều thì có thể sử dụng code Lisp sau :

(defun c:thw(/ as doc schx scwx schy scwy)
 (vl-load-com)
 (setq ss (ssget '((0 . "*TEXT"))))
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (setq schx (getreal "\n he so tang chieu cao cua chu theo phuong X :"))
 (setq scwx (getreal "\n he so tang do rong cua chu theo phuong X :"))
 (setq schy (getreal "\n he so tang chieu cao cua chu theo phuong Y :"))
 (setq scwy (getreal "\n he so tang do rong cua chu theo phuong Y :"))
 (vlax-for x (setq as (vla-get-activeselectionset doc))
   (if (= (vla-get-Rotation x) 0)
     (progn
(vlax-put x 'height (* (vla-get-height x) schx))
(vlax-put x 'scalefactor (* (vla-get-scalefactor x) scwx))
     )
   )
   (if (= (vla-get-Rotation x) (/ pi 2))
     (progn
(vlax-put x 'height (* (vla-get-height x) schy))
(vlax-put x 'scalefactor (* (vla-get-scalefactor x) scwy))
     )
   )
)
 (vla-delete as)
(princ)
)

Của bạn sử dụng như sau :

 

Command: thw -> gõ lệnh thw

Select objects: Specify opposite corner: 425 found -> Quét chọn toàn bộ đối tượng và khai báo các hệ số như dưới đây

 

Select objects:

he so tang chieu cao cua chu theo phuong X :2

 

he so tang do rong cua chu theo phuong X :0.5

 

he so tang chieu cao cua chu theo phuong Y :0.5

 

he so tang do rong cua chu theo phuong Y :2

 

Chúc thành công

lisp rất tuyệt vời, kết quả như ý muốn.Cảm ơn bạn !Nhưng mình cho mình hỏi là chữ theo phương x , phương y là phương nào hả bạn?theo trục tọa độ của cad à?bạn giải thik dùm mấy dòng lệnh

he so tang chieu cao cua chu theo phuong X :2

 

he so tang do rong cua chu theo phuong X :0.5

 

he so tang chieu cao cua chu theo phuong Y :0.5

 

he so tang do rong cua chu theo phuong Y :2


<<

Filename: 94130_thw.lsp
Tác giả: xuangiangtedi
Bài viết gốc: 89417
Tên lệnh: ltr
lisp tính chiều dài một phần polyline
Lệnh LTR (Lý trình) dưới đây sẽ giúp bạn:

(defun c:ltr()
 (setq
   ent (car (entsel "\nVao pline: "))
   p   (getpoint "\nVao diem xac dinh ly trinh: ")
...
>>
Lệnh LTR (Lý trình) dưới đây sẽ giúp bạn:

(defun c:ltr()
 (setq
   ent (car (entsel "\nVao pline: "))
   p   (getpoint "\nVao diem xac dinh ly trinh: ")
 )
(command ".copy" ent "" "0,0,0" "@")
 (setq ent (entlast))
 (command ".break" ent p "@")
 (setq ent1 (entlast))
 (command ".lengthen" ent "")
 (setq l (rtos (getvar "perimeter")))
 (command ".lengthen" ent1 "")
 (setq l1 (rtos (getvar "perimeter")))
 (command ".erase" ent ent1 "")
 (alert (strcat "diem vua pick chia pline thanh 2 doan\n\nTu dau den diem pick: " l "\n\nTu diem pick den cuoi: " l1))
 (princ)
)

Bác Hoành ơi giúp em thêm một đoạn líp ghi kết quả vừa tra được ra màn hình được khônng ví dụ khi pick vào một điểm bất kỳ sẽ ghi ra màn hình " từ đầu đến điẻm pick là 350.53m" hoặc đơn giản chỉ ghi " 350.53" cũng được. Cảm ơn bác nhiều!


<<

Filename: 89417_ltr.lsp
Tác giả: levanhuong1989
Bài viết gốc: 308936
Tên lệnh: loadall
Chia sẻ Bộ Lisp rất hay: ”Kho báu của Minh”

 

Ketxu đóng góp thêm 1 chút , nếu đã chọn con đường load bằng getfield, để tránh cứ 1 thư mục lại làm 1 lần , đoạn sau sẽ load...

>>

 

Ketxu đóng góp thêm 1 chút , nếu đã chọn con đường load bằng getfield, để tránh cứ 1 thư mục lại làm 1 lần , đoạn sau sẽ load toàn bộ LSP,FAS,VLX,ARX ở thư mục mẹ + các thư mục con :

(defun c:loadall (/ duongdan lstLsp lstArx)
  (setq duongdan (vl-filename-directory (getfiled "Chon 1 file VLX,LSP,FAS,ARX bat ki trong thu muc" "" "LSP;VLX;FAS;ARX" 0))
		lstLsp (append (ST:File_GetAll duongdan "*.lsp")(ST:File_GetAll duongdan "*.vlx")(ST:File_GetAll duongdan "*.fas"))
		lstArx (ST:File_GetAll duongdan "*.arx"))
  
  (mapcar 'Load lsp)
  (mapcar 'arxLoad lstArx)
  ) 

(defun ST:File_GetAll ( Dir typ ) ;@ketxu
  (append (mapcar '(lambda ( x ) (strcat Dir "\\" x)) (vl-directory-files Dir typ 1))
    (apply 'append
      (mapcar '(lambda ( x ) (ST:File_GetAll (strcat dir "\\" x) typ))
        (cddr (vl-directory-files dir "*" -1))
      )
    )
  )
)

 

Chào bác Ketxu và các bác trong diễn đàn!

Các bác chỉ cho em cách mà khi mình chạy 1 lần giống như gọi menu, lần sau khi tắt cad đi và bật lại thì cad tự động load các líp mà mình chỉ đường dẫn cho nó.

Em đã có menu  nhưng để cad tự động load lisp thì lại phải dùng lệnh AP thì không được chuyên nghiệp khi cài cho máy khác, hiiii.

Thanks các bác.


<<

Filename: 308936_loadall.lsp
Tác giả: duy782006
Bài viết gốc: 48694
Tên lệnh: df
Hiệu chỉnh Dt Text??????
Cám ơn anh Duy. Em dựa vào chính đoạn Code mà anh Duy đã viết cho bạn hhhhgggg để đổi font cho text sang font .VnHelvetlnsH.

Như các bạn đã biết khi ta đánh lệnh Style và thiết...

>>
Cám ơn anh Duy. Em dựa vào chính đoạn Code mà anh Duy đã viết cho bạn hhhhgggg để đổi font cho text sang font .VnHelvetlnsH.

Như các bạn đã biết khi ta đánh lệnh Style và thiết lập cho font chữ style đó là font chữ đậm thì nó tác dụng lên toàn bộ Text của Style đó. Còn muốn tô chữ đậm cho text riêng lẻ thì sử dụng đoạn Code của anh Duy và thay cái chuỗi ".VnHelvetInsH Medium" bằng textstyle tô đậm thích hợp là được.

(defun c:df ()
(command "undo" "be")
(command "-style" "doifont" ".VnHelvetInsH Medium" "0" "1" "0" "n" "n")
(prompt "\nChon chu muon chinh.")
(setq ss (ssget))
(setq c 0)
(if ss (setq e (ssname ss c)))
(while e
(setq e (entget e))
(if (= (cdr (assoc 0 e)) "TEXT")
(progn
(setq txt "doifont")
(setq e (subst (cons 7 txt) (assoc 7 e) e))
(entmod e)
)
)
(setq c (1+ c)) 
(setq e (ssname ss c)) 
)
(command "undo" "end")
(Princ)
)

Ví dụ :

Để đổi sang font chữ :

.VnArial (Regular) : Thì thay cái chuỗi ".VnHelvetInsH Medium" bằng chuỗi : "VNARIAL.TTF"

.VnArial (Bold) (Chữ đậm) : Thì thay cái chuỗi ".VnHelvetInsH Medium" bằng chuỗi : "VNARIALB.TTF"

.VnArial (Italic) (Chữ nghiêng) : Thì thay cái chuỗi ".VnHelvetInsH Medium" bằng chuỗi : "VNARIALI.TTF"

.VnArial (Bold Italic) (Chữ đậm nghiêng) : Thì thay cái chuỗi ".VnHelvetInsH Medium" bằng chuỗi : "VNARIABI.TTF"

 

Như vậy, bạn phải xác định truớc font chữ của Style đó rồi mới tô thành cái chữ đậm được.

Anh Duy cho thêm ý kiến nhé. Cảm ơn.

Theo mình nên nghiên cứu theo cách.

-Đọc tên kiểu chử được chọn.

-Đọc fon chử của kiểu chử.

-Tạo kiểu chử mới là kiểu được chọn + "dam"

Các bước khác như của bạn.


<<

Filename: 48694_df.lsp
Tác giả: shitty
Bài viết gốc: 129860
Tên lệnh: h1
Viết lisp theo yêu cầu [phần 2]

Bạn edit cho phù hợp nhu cầu nhé. Nhớ là trong bản vẽ phải có layer 00-08Hatch rồi đó, vì mình k để code tạo layer vào

>>

Bạn edit cho phù hợp nhu cầu nhé. Nhớ là trong bản vẽ phải có layer 00-08Hatch rồi đó, vì mình k để code tạo layer vào

(defun c:h1()	
(initget 1 "0 WALL W GRASS GR GROUND G MARBLE M WC S SAND B BRICK")
(setq s1 (getkword "\n0/Wall/Grass/Ground/MARBLE/WC/Sand/BRICK "))
	(cond
	  ((= "0" (strcase s1)) (SetHvar "ansi37" 1 0 1 20 ))
	  ((= "WC" (strcase s1)) (SetHvar "ansi31" 1 0 1 20))
	  ((or (= "GR" (strcase s1)) (= "GRASS" (strcase s1)))(SetHvar "GRASS" 1 0 1 20))								   
	  ((or (= "S" (strcase s1)) (= "SAND" (strcase s1)))(SetHvar "AR-CONC" 1 0 1 20))			
	  ((or (= "G" (strcase s1)) (= "GROUND" (strcase s1))) (SetHvar "AR-CONC" 1 0 1 20))
	  ((or (= "M" (strcase s1)) (= "MARBLE" (strcase s1))) (SetHvar "AR-CONC" 1 0 1 20))
	  ((or (= "B" (strcase s1)) (= "BRICK" (strcase s1))) (SetHvar "AR-CONC" 1 0 1 20))
	  ((or (= "W" (strcase s1)) (= "WALL" (strcase s1)))(SetHvar "AR-CONC" 1 0 1 20))
	);end cond
 	(command "-hatch")
(while (< 0 (getvar "CMDACTIVE"))	(command pause))
(acet-sysvar-restore)
);END C:
(defun SetHvar ( hName hScale hAng hAssoc hGap) ;hLayer)
(acet-sysvar-set (list "hpname" hname "hpscale" hScale "hpang" hAng "hpassoc" hAssoc "hpgaptol" hgap "clayer" "00-08hatch" "HPSEPARATE" 1))
)

e xin cảm ơn bác nhiều,nhưng bác có thể giúp e sửa lại chút chút là khi đánh lệnh h1 xong thi se pick luôn khoang cần hatch,sau đó thì hiện bảng hatch rồi mình chon kiểu hatch bằng phím 0 hay W(wall)... la sẽ hatch xong .à còn lisp bác vừa viết giúp e thi e đánh lệnh h1 rồi hiện cái bảng kiểu hatch nhưng khi e đánh kí tự W hay WC hay B thi hok hiện ra ji nữa :( (với nút thanks e hok nhìn thấy chỗ nào..giao diện mới quá bác thông cảm :P )


<<

Filename: 129860_h1.lsp
Tác giả: thanhduan2407
Bài viết gốc: 310284
Tên lệnh: gcd
hỏi vấn đề tạo liên kết LSP và dialog DCL

Xin lỗi bác Hạ, em mải mê làm việc nên lúc viết quên béng mất điều viết. Em sửa lại rồi bác ạ.

Trong câu 2 là em muốn lựa chọn bảng màu sắc cho chữ đó bác. Nếu viết trong DCL thì viết như nào ạ? và cách gọi nó ra thì ntn ạ?

Trong 3 thì em chưa biết cách gán layer lựa chọn hay style  lựa chọn cho Text.

Em vừa sửa lại thấy tự dưng có layer mới xuất hiện mà em ko tạo...

>>

Xin lỗi bác Hạ, em mải mê làm việc nên lúc viết quên béng mất điều viết. Em sửa lại rồi bác ạ.

Trong câu 2 là em muốn lựa chọn bảng màu sắc cho chữ đó bác. Nếu viết trong DCL thì viết như nào ạ? và cách gọi nó ra thì ntn ạ?

Trong 3 thì em chưa biết cách gán layer lựa chọn hay style  lựa chọn cho Text.

Em vừa sửa lại thấy tự dưng có layer mới xuất hiện mà em ko tạo ra. Cái này em cảm thấy hơi lạ

 

GHICHU
: dialog
{
label = "Ch\U+01B0\U+01A1ng tr\U+00ECnh ghi ch\U+00FA";
	: boxed_column
	{
		: edit_box
		{
			label = "Nh\U+1EADp t\U+00EAn c\U+1EA7n vi\U+1EBFt ghi ch\U+00FA";
			key = "Text_ghichu";
			edit_width = 30;
			alignment = left;
			edit_limit = 50;
			value = "Vi\U+1EBFt ghi ch\U+00FA v\U+00E0o \U+0111\U+00E2y";

		}
		: edit_box
		{
			label = "Nh\U+1EADp chi\U+1EC1u cao ch\U+1EEF:";
			key = "Height_Text";
			edit_width = 3.0;
			alignment = left;
			edit_limit = 5;
			value = 1;
		}


	}
	: boxed_column
	{
        	: row
		{
		 : column
		 {
		      : popup_list
		      {
		          label       = "L\U+1EF1a ch\U+1ECDn Layer" ;
		          key         = "LTSLAY" ;
		          edit_width  = 50 ;  
		          list        = "" ;
		          alignment = left;
		      }
		      : popup_list
		      {
		          label       = "L\U+1EF1a ch\U+1ECDn TextStyle" ;
		          key         = "LTSTEXTSTYLE" ;
		          edit_width  = 50 ;  
		          list        = "" ;
		          alignment = left;
		      }
		 }
		}
	}	
	: boxed_column
	{
		: button
		{
			label = "Pick >>>";
			key = "Accept";
			is_default = true;
			fixed_width = centered;
		}
		: button
		{
			label = "H\U+1EE7y";
			key = "Cancel";
			is_default = false;
			fixed_width = centered;
		}

	}

}

 

(defun C:GCD ( / dcl_id  LtsLayer LtsStyle h Text_ghichu )
(setq dcl_id (load_dialog "GHICHU.DCL"))
(if (not (new_dialog "GHICHU" dcl_id))
 (exit)
)

  
(action_tile "Text_ghichu"  "(setq TextGhiChu $value)")
(mode_tile "Text_ghichu" 2)
(action_tile "Height_Text"  "(setq h $value)")
(mode_tile "Height_Text" 2)
(action_tile "Text_ghichu"  "(setq TextGhiChu $value)")

(setq LtsLayer_ (Getlayer))
(start_list "LTSLAY")
(mapcar 'add_list  LtsLayer_)
(end_list)
(set_tile "LTSLAY" "0")
(action_tile "LTSLAY" "(setq LayerText_ $value)")


(setq LtsStyle_ (GetTextStyle))
(start_list "LTSTEXTSTYLE")
(mapcar 'add_list  LtsStyle_)
(end_list)

;;;(action_tile "LTSTEXTSTYLE" "(setq TextStyle_ $value)")
  

(action_tile "Accept" "(setq UseButton 1)(done_dialog)")
(action_tile "Cancel" "(setq UseButton 2)(done_dialog)")

(start_dialog)
(unload_dialog dcl_id)
(if (= UseButton 1)
	(progn
		(GCT TextGhiChu h LayerText_ )
	)
)
(if (= UseButton 2)
	(alert (strcat "\nTho\U+00E1t"))
)


(Princ)
)




(defun Getlayer ( / lyr LstLayer)
(vlax-for lyr
	(vla-get-layers
		(vla-get-activedocument
			(vlax-get-acad-object)
	        )
        )		
(setq LstLayer (cons (vla-get-name lyr) LstLayer))
)
LstLayer
)




(defun GetTextStyle ( / styl_  LstTextStyle)
(vlax-for styl_
	(vla-get-textstyles
		(vla-get-activedocument
			(vlax-get-acad-object)
	        )
        )		
(setq LstTextStyle (cons (vla-get-name styl_) LstTextStyle))
)
LstTextStyle
)


(defun GCT(TextGhiChu h LayerText  / i Olmode Gocxoay);;;;GHI CHU TEXT
(setq i 0)
(while
  	(setvar "OSMODE" 0)
	(setq P1 (Getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m ch\U+00E8n TEXT ghi ch\U+00FA: :  "))
	(setq P2 (Getpoint  P1 "\nChon huong ghi chu TEXT:  "))
  	(setq Gocxoay (Angle (trans P1 1 0)
                             (trans P2 1 0)
		      )
	)
	(command "Style" "Times New Roman"  "Times New Roman"  0 1 0 "" "" "" )
;;;	(entmake (list  (cons 0 "TEXT") (cons 10 P1) (cons 8 LayerText) (cons 40 (atof h)) (cons 50 Gocxoay) (cons 7 TextStyle) (cons 1 TextGhiChu)))
  	(entmake (list  (cons 0 "TEXT") (cons 10 P1) (cons 8 LayerText) (cons 40 (atof h)) (cons 50 Gocxoay)(cons 7 "Times New Roman")   (cons 1 TextGhiChu)))
  	(setq i (1+ i))
)
)

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



<<

Filename: 310284_gcd.lsp
Tác giả: ndn386
Bài viết gốc: 85253
Tên lệnh: gb
Lisp tính diện tích
Chào bạn huong259 và bạn ndn386

Đây là Lisp viết theo ý của bạn huong259.

Lisp tính diện tích nhiều hình khác nhau, mỗi hình lại có nhiều...

>>
Chào bạn huong259 và bạn ndn386

Đây là Lisp viết theo ý của bạn huong259.

Lisp tính diện tích nhiều hình khác nhau, mỗi hình lại có nhiều lỗ khác nhau. Đúng luôn cho trường hợp không có lỗ. Vì không có lỗ thì diện tích lỗ bằng 0. :cheers:

Đây là code. Các Bạn thử nhé :

(defun c:gb(/ p ss S frome cur toe tt)
(setq p (getpoint "\n Pick 1 diem vao mien trong hinh kin :") 
ss (ssadd) S 0)
(while p
(setq frome (entlast))
(command ".boundary" p "")
(setq toe (entlast));; 
(setq cur frome
)
   (while (not (eq cur toe))
(setq cur (entnext cur)
	ss (ssadd cur ss))
(command "area" "S" "O" ss "" "")
(setq tt (getvar "area"))
(setq S (+ S tt))
    )
 (command "area" "A" "O" "L" "" "")
 (setq tt (getvar "area"))
 (setq S (+ S (* tt 2))) 
(sssetfirst ss ss)
(setq p (getpoint "\n Pick 1 diem vao mien trong hinh kin :"))

)
(if (> (sslength ss) 0)
(alert (strcat "Area = " (rtos S 2 2)))
(alert "\n Ban chua Pick vao mien kin nao ca ")
)
(command "erase" ss "")
(Princ)
)

@ ndn386 : Bạn muốn thêm 3 chữ số thập phân thì thay dòng này

(alert (strcat "Area = " (rtos S 2 2)))

thành dòng :

(alert (strcat "Area = " (rtos S 2 3)))

thay số 2 thành số 3 : chính là chữ số thập phân đó bạn

Anh Tue_NV oi, cai lisp này chỉ tính diện tích cho hình khoét lỗ, nhưng em muốn tính diện tích phần giao của 2 hình thì không đuợc nó thông báo là "; error: Function cancelled

Polyline boundary could not be derived. Create Region? "

Hay là cái lisp này không phải giải quyết bài toán đó nhỉ?

Cảm ơn anh em đã làm cho ra kết quả 3 số sau dấu phẩy rồi anh ạ.


<<

Filename: 85253_gb.lsp
Tác giả: Tue_NV
Bài viết gốc: 126078
Tên lệnh: test
Bản quyền VLX
Cũng có gì nà oai đâu bác.Việc làm key là công việc thầm lặng mà ^^

Bác thử nghiên cứu qua ví dụ này xem sao nhé


 (defun getHDD (/   where Dowhat...
>>
Cũng có gì nà oai đâu bác.Việc làm key là công việc thầm lặng mà ^^

Bác thử nghiên cứu qua ví dụ này xem sao nhé


 (defun getHDD (/   where Dowhat ModelObject  SerialObject  Model Serial)
 (setq where (vlax-create-object "WbemScripting.SWbemLocator"))
 (setq   Dowhat
   (vlax-invoke
     where 'ConnectServer nil nil nil nil nil nil nil nil)
  )
 (setq   ModelObject (vlax-invoke
        Dowhat
        'ExecQuery
        "Select * from Win32_DiskDrive"
           )
  SerialObject (vlax-invoke
        Dowhat
        'ExecQuery
        "Select * from Win32_PhysicalMedia"
           )
 )
 (vlax-for Obj   ModelObject
   (setq Model (cons (vlax-get Obj 'Model) Model))
 )
 (vlax-for Obj   SerialObject
   (setq Serial (cons (vlax-get Obj 'SerialNumber) Serial))
 )
 (setq 
Model (vl-remove nil Model);1 
Serial (vl-remove nil Serial) ;2  
)   
)
(defun c:test()
(gethdd)
)

Cảm ơn bạn ketxu đã chia sẻ. Cho mình hỏi thêm là muốn Lấy Model + Serial của USB thì làm sao?

Hàm DiskDriveSerial có thể lấy Serial của USB, nhưng khi format USB thì số bị thay đổi liền

Một câu hỏi thêm nữa mà Tue_NV còn thắc mắc là Có hàm Lisp nào xử lý việc máy tính nhận được USB hay không?

Tức là : Khi cắm USB vào thì hàm trả về T, còn rút USB ra thì hàm trả về giá trị NIL

Liệu có hàm Lisp nào như vậy và hàm Lisp lấy Model + Serial của USB không nhỉ?

 

Lệnh MCADD cho ra 1 List gồm các phần tử String là có nghĩa gì vậy?

("00:80:AD:89:96:98" "00:80:AD:89:96:98" "6A:72:20:52:41:53"

"33:50:6F:45:30:30" "50:50:54:50:30:30")

Bạn Ketxu có thể giải thích dùm Tue_NV được không?

Thanks


<<

Filename: 126078_test.lsp

Trang 262/330

262