- page 235

Info

File

Tác giả: dovananh.xd
Bài viết gốc: 181370
Tên lệnh: zs

nếu cái khung bên model của bạn là một rectang thì bạn có thể xài lisp này. Sau khi bạn gõ lệnh zs bạn chọn cái khung là lisp làm...
>>
nếu cái khung bên model của bạn là một rectang thì bạn có thể xài lisp này. Sau khi bạn gõ lệnh zs bạn chọn cái khung là lisp làm việc!!
(defun c:zs(/ dt)
(command "Mspace")
 (setq dt (car(entsel))
)
 (command "zoom" (vlax-curve-getPointatParam dt 1) (vlax-curve-getPointatParam dt 3))
(command "pspace")
(princ)
 )
Thanks pro nhiều lắm!

Dùng thế này cũng đã tiện hơn rất nhiều rồi.

<<

Download lisp

Filename: 181370_zs.lsp

Tác giả: tranquangtriet
Bài viết gốc: 347528
Tên lệnh: tc

Xin lisp căn Text vào chính giữa ô

Chọn 1 lúc nhiều text. lisp sẽ di chuyển text vào đúng trọng tâm của miền kín gần nhất bao quanh mỗi text.

>>

Download lisp

Filename: 347528_tc.lsp

Tác giả: vietthuong89
Bài viết gốc: 197704
Tên lệnh: t2u

chuyển bảng mã từ TCVN3 sang UNICODE

Bạn dùng lệnh T2U (TCVN3 to Unicode)

(defun c:t2u (/ taptext)  (defun chuyenfontstr	         (stsua / daichuoi index stdich...
>>

Bạn dùng lệnh T2U (TCVN3 to Unicode)

(defun c:t2u (/ taptext)  (defun chuyenfontstr	         (stsua / daichuoi index stdich chuht CHUSUA tAPSUA)                                (setq    tapsua (list(cons "®" "\U+0110")(cons "§" "\U+0110")(cons "µ" "À")(cons "¸" "Á")(cons "¶" "\U+1EA2")(cons "·" "Ã")(cons "¹" "\U+1EA0")(cons "©" "Â")(cons "¢" "Â")(cons "Ç" "\U+1EA6")(cons "Ê" "\U+1EA4")(cons "È" "\U+1EA8")(cons "É" "\U+1EAA")(cons "Ë" "\U+1EAC")(cons "¨" "\U+0102")(cons "¡" "\U+0102")(cons "»" "\U+1EB0")(cons "¾" "\U+1EAE")(cons "¼" "\U+1EB2")(cons "½" "\U+1EB4")(cons "Æ" "\U+1EB6")(cons "Ì" "È")(cons "Ð" "É")(cons "Î" "\U+1EBA")(cons "Ï" "\U+1EBC")(cons "Ñ" "\U+1EB8")(cons "ª" "Ê")(cons "£" "Ê")(cons "Ò" "\U+1EC0")(cons "Õ" "\U+1EBE")(cons "Ó" "\U+1EC2")(cons "Ô" "\U+1EC4")(cons "Ö" "\U+1EC6")(cons "×" "Ì")(cons "Ý" "Í")(cons "Ø" "\U+1EC8")(cons "Ü" "\U+0128")(cons "Þ" "\U+1ECA")(cons "ß" "Ò")(cons "ã" "Ó")(cons "á" "\U+1ECE")(cons "â" "Õ")(cons "ä" "\U+1ECC")(cons "«" "Ô")(cons "¤" "Ô")(cons "å" "\U+1ED2")(cons "è" "\U+1ED0")(cons "æ" "\U+1ED4")(cons "ç" "\U+1ED6")(cons "é" "\U+1ED8")(cons "¬" "\U+01A0")(cons "¥" "\U+01A0")(cons "ê" "\U+1EDC")(cons "í" "\U+1EDA")(cons "ë" "\U+1EDE")(cons "ì" "\U+1EE0")(cons "î" "\U+1EE2")(cons "ï" "Ù")(cons "ó" "Ú")(cons "ñ" "\U+1EE6")(cons "ò" "\U+0168")(cons "ô" "\U+1EE4")(cons "" "\U+01AF")(cons "¦" "\U+01AF")(cons "õ" "\U+1EEA")(cons "ø" "\U+1EE8")(cons "ö" "\U+1EEC")(cons "÷" "\U+1EEE")(cons "ù" "\U+1EF0")(cons "ú" "\U+1EF2")(cons "ý" "Ý")(cons "û" "\U+1EF6")(cons "ü" "\U+1EF8")(cons "þ" "\U+1EF4")(cons "a" "A")(cons "b" "B")(cons "c" "C")(cons "d" "D")(cons "e" "E")(cons "f" "F")(cons "g" "G")(cons "h" "H")(cons "i" "I")(cons "j" "J")(cons "k" "K")(cons "l" "L")(cons "m" "M")(cons "n" "N")(cons "o" "O")(cons "p" "P")(cons "q" "Q")(cons "r" "R")(cons "s" "S")(cons "t" "T")(cons "u" "U")(cons "v" "V")(cons "w" "W")(cons "x" "X")(cons "y" "Y")(cons "z" "Z")                )  )   (setq    daichuoi (strlen stsua)    index    1    stdich   ""  )  (repeat daichuoi    (setq      chuht  (substr stsua index 1)      index  (1+ index)      chusua         (cond           ((assoc chuht tapsua) (cdr (assoc chuht tapsua)))           (t chuht)         )      stdich (strcat stdich chusua)    )  )  stdich)  (defun doone(ent / new old tt)    (setq      tt (entget ent)      old (assoc 1 tt)      new (cons 1 (chuyenfontstr (cdr old)))          )    (if (/= new old)      (progn	(setq tt (subst new old tt))	(entmod tt)	(entupd ent)      )    )  )   (setq	taptext	(ssget '((0 . "TEXT"))))  (sudung doone taptext) )(defun sudung (ham ss / sodt index entdt soapp)  (setq	sodt  (cond		(ss (sslength ss))		(t 0)      	)	soapp 0	index 0  )  (repeat sodt    (setq entdt	(ssname ss index)  	index	(1+ index)    )    (if	(ham entdt)      (setq soapp (1+ soapp))    )  )  soapp)

bác nguyenhoanh ơi, co thể cho em xin đc mail hoặc nik yahoo của bác đc không, đẻ có gì em ll với bác cho tiện,cám ơn bác nhiều!

Download lisp

Filename: 197704_t2u.lsp

Tác giả: hugo75
Bài viết gốc: 153648
Tên lệnh: xo

Xoay text thuộc tính trong block

Lệnh XO của lisp dưới đây sẽ xoay góc nghiêng của Attribute Block về 0.
(defun c:XO( / ssdt sodt index...
>>
Lệnh XO của lisp dưới đây sẽ xoay góc nghiêng của Attribute Block về 0.
(defun c:XO( / ssdt sodt index tt entdt)  
 (setq ssdt (ssget)
sodt (sslength ssdt)
index 0
 )
 (repeat sodt
   (setq entdt (ssname ssdt index)
  index (1+ index)
  entdt (entnext entdt)
  tt (entget entdt)
  tt (subst (cons 50 0.0) (assoc 50 tt) tt)
   )
   (entmod tt)
   (entupd entdt)
 )
 (princ)
)
Sử dụng đặc hiệu trong trường hợp block ký hiệu trục nằm nghiêng.
Nhờ bác Hoành hoặc bác nào biết sửa lại cho có thể nhập góc xoay vào được.Thanks.

<<

Download lisp

Filename: 153648_xo.lsp

Tác giả: vbao
Bài viết gốc: 3089
Tên lệnh: test reset

code giới hạn thời gian sử dụng File lisp

Với file lisp thì rất khó để làm được điều này. Bởi người biết sử dụng lisp sẽ vô hiệu hoá ngay nếu như đọc được mã lisp. Tuy nhiên, có thể làm được...
>>
Với file lisp thì rất khó để làm được điều này. Bởi người biết sử dụng lisp sẽ vô hiệu hoá ngay nếu như đọc được mã lisp. Tuy nhiên, có thể làm được điều này với 1 file VLX đã được mã hoá. Cách làm thông thường như sau: Ghi thông tin các lần sử dụng lệnh vào 1 vị trí trên registry, hoặc vào file config của AutoCAD. Sau đó, đọc các thông tin này để có hành động phù hợp.

Sau đây là 1 ví dụ đơn giản:
(defun c:TEST()
 ;;; Doc gia tri
 (setq tmp (getcfg "AppData/CADViet/Count")
sl (cond
     ((or (not tmp) (= tmp "")) "5")
     (t tmp)
   )
 )

 ;;; Kiem tra va thong bao
 (if (/= sl "0")
   (progn
     ;;; Thuc thi ma lenh
     (princ (strcat "\nBan con " sl " lan su dung nua"))      
     ;;; Luu gia tri
     (setcfg "AppData/CADViet/Count" (itoa (1- (atoi sl))))
   )
   (princ "\nBan da het han su dung!")
 )  

 (princ)
)

(defun c:RESET()
 ;;; Reset lai gia tri
 (setcfg "AppData/CADViet/Count" "")
 (princ)
)
Lệnh TEST để xác định số lần thực thi. Chỉ thực thi lệnh được 5 lần. Không quan trọng ngày tháng, không quan trọng số lần sử dụng ACAD, cứ dùng lệnh TEST quá 5 lần là hết hạn.

Lệnh RESET để khởi tạo lại giá trị.

Tất nhiên, ví dụ trên là 1 cái khoá đơn giản chỉ khoá được người ngay chứ không khoá được kẻ gian.
Cảm ơn anh Hoành đã giải đáp, anh cho hỏi thêm nếu file lisp đã được mã hóa ta có thể áp dụng code trên được không? hay là chỉ dùng trong VLX. Thanhs

<<

Download lisp

Filename: 3089_test_reset.lsp

Tác giả: NguyenNgocSon
Bài viết gốc: 136502
Tên lệnh: td

Xin Lisp xuat toa độ

Khuyên bạn: Trước khi đặt câu hỏi bạn nên thử tự tìm câu trả lời cho mình trước đã. ok?

Font sử dụng khi điền tọa...
>>
Khuyên bạn: Trước khi đặt câu hỏi bạn nên thử tự tìm câu trả lời cho mình trước đã. ok?

Font sử dụng khi điền tọa độ cũng như khi thống kê bảng chính là font của textstyle đang hiện hành lúc bạn chạy lisp. không khó để nhận ra điều đó. Nếu bạn không hiển thị tốt tiếng việt trong bảng thống kê thì chuyển sang 1 textstyle khác dùng các font thuộc bảng mã TCVN3.

Về yêu cầu của bạn: mình hiểu là khi chạy lisp bạn sẽ tiến hành các bước: nhập cao text -> nhập tên mốc -> nhập chiều dài các cạnh của bảng rồi mới bắt đầu thực hiện pick truy vấn tọa độ mốc đúng không?

=> 1. quá rườm rà

=> 2. Bạn có chắc chiều dài cạnh bạn nhập không quá rộng hoặc không quá hẹp so với cao text? lisp trên đã được tính toán để text được bố trí vào bảng một cách hợp lý nhất. vì thế mình không sửa lại theo yêu cầu nhập chiều dài các cạnh của bảng nữa.

Riêng phần xuất ra file text, mình chưa bg fải làm việc với những file text chứa tọa độ điểm nên không hiểu nội dung của nó sẽ được bố trí như thế nào vì đây không fải chuyên ngành của mình. thế nên mình bó tay khoản này.

đây là lisp bạn có thể nhập tên mốc theo ý muốn của mình
;GHI TOA DO CAC DIEM VA THONG KE THANH BANG
----------------------------------------------
(defun C:td (/ diem PT1 PT2 PT3 tapx tapy 
	   x y xx yy h n di kc ten
	   C PT PTX PTY PTD PTC N
	   p1 p2 p3 p4 p11 p22 p33 L1 L2 L11 L22)
(setvar "cmdecho" 0 )
(command "Undo" "Begin")  
 (setq om (getvar "osmode"))
 (setq tapx '()
tapy '()
stt '()
k 0
h (getreal "\nnhap chieu cao chu:")
ten (getstring "\nNhap ten diem:"))


(while
 (setq diem (getpoint "\nchon cac vi tri co toa do can ghi:"))
 (progn
(setq   PT1 (list(+ (* 3 h) (car diem))(+ (* 3 h) (cadr diem)))
	PT2 (list (car PT1) (- (cadr PT1)(+ 1 h) ) )
	 x (rtos(car diem) 2 4)
		 y (rtos (cadr diem) 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
 (setvar "osmode" 0)
 (command "text" "j" "BL" PT1 h 0 x)
 (setq TB (textbox (entget(entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar PT1 0 (+ di h))
C  (polar PT3 0 (* 1.5 h))
  );setq
(command "text" PT2 h 0 y
	 "pline" diem PT1 PT3 ""
	 "circle" (polar PT3 0 (* 1.5 h)) (* 1.5 h)
	 "text" "m" (polar PT3 0 (* 1.5 h)) h 0 N )

(setvar "osmode" om)
);progn   
 );dong while

;tao bang thong ke
 (setq	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))
 n (length tapx)
 k 0
);setq
(setvar "osmode" 0)
 (command "line" p1 p2 ""
   "text" "j" "m" p11 h 0 "STT" 
   "text" "j" "m" p22 h 0 "Täa ®é X" 
   "text" "j" "m" p33 h 0 "Täa ®é Y"
   "line" p3 p4 "")	

 (while (< k n) 
(setq xx (nth k tapx)
  yy (nth k tapy)
 tstt(nth k stt))
(command "text" "j" "m" PTD h 0 tstt 
		 "text" "j" "m" PTX h 0 xx 
	 "text" "j" "m" PTY h 0 yy 
	 "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 "line" p3 PT ""
	  "line" p4 PTC ""
  "line" L1 L11 ""
  "line" L2 L22 "")
(setvar "osmode" om )
(setvar "cmdecho" 1)
(prompt"\nxong\n")
 (command "Undo" "End")
 (princ)
);DONG toado
PS: mọi người trong diễn đàn thường chỉ cần cảm ơn nhau bằng nút Thank dưới mỗi bài post bạn ạ. thế là đủ :s_dead:
Phải nói rằng lisp này rất hay. Nhưng mình nghĩ nếu cải tiến thêm: "Lisp chọn hướng(góc) nghiêng của text theo đwờng chuẩn là oke"

<<

Download lisp

Filename: 136502_td.lsp

Tác giả: eng-hiep
Bài viết gốc: 81277
Tên lệnh: cc

Cần lisp đánh toạ độ cọc.

Bạn dùng thử lisp này, lệnh CC, chọn hàng loạt vòng tròn. Chỗ nào chưa đúng ý (liên quan đến toạ độ quy ước, trình bày kết quả...) thì nêu cụ thể, sửa 1 phát nữa là...
>>
Bạn dùng thử lisp này, lệnh CC, chọn hàng loạt vòng tròn. Chỗ nào chưa đúng ý (liên quan đến toạ độ quy ước, trình bày kết quả...) thì nêu cụ thể, sửa 1 phát nữa là OK:
;;;-------------------------------------------------------
(defun wtxt (txt p / sty d h) ;;;Write txt on graphic screen, defaul setting
(setq
   sty (getvar "textstyle")
   d (tblsearch "style" sty)
   h (cdr (assoc 40 d))
)
(if (= h 0) (setq h (cdr (assoc 42 d))))
(entmake
   (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 40 h) (assoc 41 d))
)
)
;;;-------------------------------------------------------
(defun C:CC( / ss e p) ;;;Coordinate of Circles
(setq ss (ssget '((0 . "CIRCLE"))))
(while (setq e (ssname ss 0))
   (setq p (cdr (assoc 10 (entget e))))
   (wtxt (strcat "x=" (rtos (car p)) "; y=" (rtos (cadr p))) p)
   (ssdel e ss)
)
(princ)
)
;;;-------------------------------------------------------
Bác ơi ! Sao em dùng lisp này ko được nhỉ ??? Gõ AP và Load file này rồi ra ngoài màn hình gõ CC ko thấy gì cả ??? Thx

<<

Download lisp

Filename: 81277_cc.lsp

Tác giả: 47c1
Bài viết gốc: 135543
Tên lệnh: ee

Xin lisp giống lệnh trim

Bạn nên chú ý cách giải thích vấn đề của mình, tránh làm cả bạn và mọi người mất quá nhiều thời gian

Ý xanh : được

Ý...
>>
Bạn nên chú ý cách giải thích vấn đề của mình, tránh làm cả bạn và mọi người mất quá nhiều thời gian

Ý xanh : được

Ý đỏ : được

Bạn có thể theo dõi ở đây, chính là topic mà bạn nói chỉ có "trong" chứ chưa có ngoài, nhưng thực ra đã có, các lisp bác giabach và bác thiep viết rất hay :

http://www.cadviet.com/forum/index.php?showtopic=27121&st=40

Còn đây là mình độ giùm theo 2 yêu cầu của bạn. Yêu cầu xanh : mình cụ thể là bên trái hoặc bên phải Line,Pline, chưa có thời gian làm tổng quát :)

Link EE
;free lisp from Cadviet.com @gia_bach -> ketxu ^^
(defun C:EE ( / en ss lst ssall bbox tmpvt lit) 
(vl-load-com)
(if (null etrim)(load "extrim.lsp"))
(setq tmpvt '(1e+10 0 0))
 (if (and (setq en (car(entsel "\n Chon duong bao : ")))
          (wcmatch (cdr(assoc 0 (entget en))) "LINE,*POLYLINE"))		   
   (progn
     (setq bbox (ACET-ENT-GEOMEXTENTS en))
     (setq bbox (mapcar '(lambda(x)(trans x 0 1)) bbox))
     (setq lst (ACET-GEOM-OBJECT-POINT-LIST en 1e-3)
		lit (nth (1- (length lst)) lst))
     (ACET-SS-ZOOM-EXTENTS (ACET-LIST-TO-SS (list en)))
     (command "_.Zoom" "0.95x") 
  (setq ssall (ssget "_X" (list (assoc 410 (entget en)))))
  (if (vlax-curve-isClosed en)	  
	(progn
		(etrim en (getpoint "\n Phia cat va xoa bo : "))
		(setq ss (ssget "_CP" lst))			
	)
	(progn	
		(initget 1 "t p T P")
		(if (= (strcase(getkword "\n Phia cat va xoa bo : ")) "T")
			(progn
				(etrim en (mapcar '- (nth 0 lst) '(1e+10 0 0)))
				(setq ss (ssget "_CP"  
					(append  (list (nth 0 lst) (mapcar '+ (nth 0 lst) tmpvt) (mapcar '+ lit tmpvt) lit))))
			)
			(progn
			(etrim en (mapcar '+ (nth 0 lst) '(1e+10 0 0)))
			(setq ss (ssget "_CP"  
				(append  (list (nth 0 lst) (mapcar '- (nth 0 lst) tmpvt) (mapcar '- lit tmpvt) lit))))
			)
		)
	)
  )
  (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
			(foreach e1 lst (ssdel e1 ssall))
			(ACET-SS-ENTDEL ssall)
  )
 )
)
Chú ý : chưa kiểm định, mần trên lý thuyết ^^
Hoàn toàn làm mình ưng ý với lisp này.Hix quả thật là giải thích đôi khi hơi khó hiểu.Nhưng mà thực ra người nào gặp tình trạng như mình thì biết ngay mình nói gì mà.

Cái link bạn đưa mình chưa đọc trước đó mà đọc link khác. Thank bạn ketxu

<<

Download lisp

Filename: 135543_ee.lsp

Tác giả: auduongphuc
Bài viết gốc: 81209
Tên lệnh: trimit

Lisp Trim đối tượng

Bạn chạy thử Lisp này.

(vl-load-com)
(defun C:TRIMIT (/ bit iPts lstObj lstPts lstPtsObj lstPtsPa obj pts ss)
 (command "undo" "be")
 (setq ss (ssget (list (cons 0 "*LINE,ARC"))))
...
>>

Download lisp

Filename: 81209_trimit.lsp

Tác giả: limfx
Bài viết gốc: 237459
Tên lệnh: linkt

Tạo liên kết Text với Block attribute trong cad

Lisp tạo liên kết các Text vào Block ứng với file Cad bạn gửi.

(defun c:linkT (/ blk fieldexp ss);link...
>>

Download lisp

Filename: 237459_linkt.lsp

Tác giả: kienartist
Bài viết gốc: 139510
Tên lệnh: tb

viết lisp tính chiều dài trung bình của nhiều đoạn thẳng

Bạn dùng tạm cái này, lệnh tb :

(defun add_mline ()
 (foreach e_record_sub	e_record
   (cond ((= 10 (car e_record_sub))
 ...
>>

Download lisp

Filename: 139510_tb.lsp

Tác giả: almodeus
Bài viết gốc: 130564
Tên lệnh: bf

Cắt đường thẳng tại điểm giao

Phải thế này không ?

(defun c:bf (/ dt diem)
 (if (setq dt (car (entsel "\nChon doi tuong can chat")))
   (progn
     (redraw dt...
>>

Download lisp

Filename: 130564_bf.lsp

Tác giả: vu dinh loc
Bài viết gốc: 354318
Tên lệnh: ddm

nhờ viết lisp vẽ thêm đường đồng mức phụ

Bạn thử cái này, quét 2 đường đồng mức rồi nhập số khoảng chia, ở đây là 5.

(defun c:ddm (/...
>>

Download lisp

Filename: 354318_ddm.lsp

Tác giả: HuynhBaVinh
Bài viết gốc: 418878
Tên lệnh: ddm

nhờ viết lisp vẽ thêm đường đồng mức phụ

Bạn thử cái này, quét 2 đường đồng mức rồi nhập số khoảng chia, ở đây là 5.
(defun c:ddm (/...
>>
Bạn thử cái này, quét 2 đường đồng mức rồi nhập số khoảng chia, ở đây là 5.
(defun c:ddm (/ ss sk dd dn lst d1 dis n)
  
  (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "LWPOLYLINE"))))))
sk (getint "\nSo khoang chia:")
dd (car (vl-sort ss
   '(lambda (x y) (> (vlax-curve-getDistAtParam x (vlax-curve-getEndParam x))
     (vlax-curve-getDistAtParam y (vlax-curve-getEndParam y))))))
dn (car (vl-remove dd ss))
dd (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget dd)))
lst nil
  )
  (repeat (1- sk) (setq lst (cons '() lst)))
 
  (foreach d0 dd 
    (setq d1 (vlax-curve-getclosestpointto dn d0)
 dis (/ (distance d0 d1) sk)
          n 0)    
    (setq lst (mapcar '(lambda (x) (append x (list (polar d0 (angle d0 d1) (* (setq n (1+ n)) dis))))) lst)) 
  )
  (foreach v lst
    (entmake (append '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline"))
    (list (cons 90 (length v))) (mapcar '(lambda (x) (cons 10 x)) v  )
    ))
  )
  (princ)      
)
Lisp anh tải lên em load rồi nhưng vẫn không sử dụng được. Anh có thể xem lại và cho em xin với được không ak. Lisp này rất là hay. Mong các Cadman sư huynh chỉ giáo.

<<
Download lisp
Filename: 418878_ddm.lsp

Tác giả: thanhlam03xt
Bài viết gốc: 189707
Tên lệnh: kbg

vẽ độ dốc

Hề hề hề,

Bạn hãy tham khảo cái này coi đã gần đúng ý bạn chưa nhé.


(defun c:kbg (/ e1 e2 a ...
>>

Download lisp

Filename: 189707_kbg.lsp

Tác giả: chutuan
Bài viết gốc: 208438
Tên lệnh: nn

Lisp nối Line thành Pline ?

Hề hề, có 1 dấu tick Thanks, bạn tick vào đó là được mờ.

NgocSon hãy thử code này :

Bạn pick vào 1 trong các line, arc, pline nào...
>>
Hề hề, có 1 dấu tick Thanks, bạn tick vào đó là được mờ.

NgocSon hãy thử code này :

Bạn pick vào 1 trong các line, arc, pline nào đó -> là nó tự tìm các đoạn liên kết được để nối và các đoạn này có cùng tên layer. Tên Layer này được lấy theo đối tượng mà bạn đã pick. OK?

Đây là code
(defun c:nn (/ tdt ssdt sodt index)(defun ObjName (ssdt /)(cdr (assoc '0 (entget ssdt))))(defun MoPL (ssdt /)(= (cdr (assoc '70 (entget ssdt))) 0))(defun NoiPL (ssdt /)(if (MoPL ssdt)(command ".PEDIT" ssdt "J" tdt "" "X")))(defun NoiLC (ssdt /)(command ".PEDIT" ssdt "Y" "J" tdt "" "X"))(setq ent (car(entsel "\nPick vao 1 doi tuong de noi :")))(setqtdt (ssget "X"	(list        (assoc 8 (entget ent) )	) 	)sodt (sslength tdt)index 0)(repeat sodt(setqssdt (ssname tdt index)index (1+ index))(if (or (= (Objname ssdt) "LWPOLYLINE")(= (Objname ssdt) "POLYLINE"))(NoiPL ssdt))(if (or (= (Objname ssdt) "LINE") (= (Objname ssdt) "ARC"))(NoiLC ssdt)))(princ))
Hy vọng trúng ý của bạn
em thấy lisp này rất hay, em thường xuyên sử dụng, nhưng mà lisp này khi chọn layer nó lại nối toàn bộ các layer trong hết 1 bản vẽ, giờ em muốn các bác chỉnh lại giúp em là chỉ nối trong 1 vùng bản vẽ mình chọn thôi, cảm ơn các bác.

<<

Download lisp

Filename: 208438_nn.lsp

Tác giả: huynhphuoc
Bài viết gốc: 403483
Tên lệnh: xuatgoc

Nhờ Viết Lisp Xuat Xyz Sang Góc Cạnh

-Trước tết mình nhận được cái yêu cầu i chang như vậy. Tin rằng với yêu cầu như của bạn với cái suy nghĩ ai biết...

-Trước tết mình nhận được cái yêu cầu i chang như vậy. Tin rằng với yêu cầu như của bạn với cái suy nghĩ ai biết viết lisp thì mọi lĩnh vực chỉ cần nhá xèng cái video cái là viết theo được ngay thì bạn sẽ chờ đến muôn thu trừ khi cái người viết lisp làm cùng lĩnh vực với bạn.

-Còn cái tác giả theo như bạn nói cũng là mem của cadviet đấy thì phải.

-Kết quả của việc viết theo yêu cầu trước tết của mình là không thành mặc dù người yêu cầu ngồi bên cạnh mình nhưng vẩn ko giải thích được là mình phải làm gì. Vì trong dữ liệu nhập có chiều cao máy và chiều cao gương thì ko giải thích được nó tham gia vào việc tính toán như nào.

-Cái không thành phẩm của trước tết nó như này. Lệnh là xuatgoc

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:s_radian>do (gt / gt kq)
(setq kq (* (/ 180 pi) gt))
kq)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:3d>2d (diemtinh / diemtinh)
(setq diembet (list (car diemtinh) (cadr diemtinh)))
diembet)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:3point>gocnam (diemgoch diemdinhhuongh diemxacdinhh / diemgoch diemdinhhuongh diemxacdinhh gocnamh)
(setq gocnamh (- (angle (duy:3d>2d diemgoch) (duy:3d>2d diemxacdinhh)) (angle (duy:3d>2d diemgoch) (duy:3d>2d diemdinhhuongh))  )  )
(setq gocnamh (duy:s_radian>do gocnamh))
gocnamh)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:3point>gocdung (diemgoch diemdinhhuongh diemxacdinhh / diemgoch diemdinhhuongh diemxacdinhh gocdungh)
(setq diemgocnam ( duy:3d>2d diemgoch))
(setq diemdinhhuongnam ( duy:3d>2d diemdinhhuongh))
(setq diemxacdinhnam ( duy:3d>2d diemxacdinhh))
(setq kcgocdinhhuong (distance diemgocnam diemdinhhuongnam))
(setq kcgocgoc (distance diemgocnam diemgocnam))
(setq kcgocxacdinh (distance diemgocnam diemxacdinhnam))
(setq diemgocdung (list kcgocgoc (caddr diemgoch) ))
(setq diemxacdinhdung (list kcgocxacdinh (caddr diemxacdinhh) ))
(setq diemdinhhuongdung (list kcgocdinhhuong (caddr diemdinhhuongh) ))
(setq gocdungh (- (angle diemgocdung diemdinhhuongdung) (angle diemgocdung diemxacdinhdung)))

(setq gocdungh (duy:s_radian>do gocdungh))

(cond
((> gocdungh 90) (setq gocdungh (- 90 gocdungh) ))
((< gocdungh 90) (setq gocdungh (- 90 gocdungh) ))
)


gocdungh)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:point>dongnd (diemgoc diemdinhhuong diemxacdinh / diemgoc diemdinhhuong diemxacdinh)
(setq gocnam  (rtos (duy:3point>gocnam diemgoc diemdinhhuong diemxacdinh) 2 6))
;(setq gocnam (rtos (duy:s_radian>do (- (angle (duy:3d>2d diemgoc) (duy:3d>2d diemdinhhuong)) (angle (duy:3d>2d diemgoc) (duy:3d>2d diemxacdinh)))) 2 6)  )
(setq gocdung  (rtos (duy:3point>gocdung diemgoc diemdinhhuong diemxacdinh) 2 6))
(setq kcxien (rtos (distance diemgoc diemxacdinh) 2 2))
(setq nddong (strcat gocnam dauphancach gocdung dauphancach kcxien))
nddong)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:xuatgoc ()
(command "undo" "be")

(setq dauphancach ",")

(setq cdiemgoc (getpoint "\nChon diem goc:"))
(setq tdiemgoc (getstring "\nNhap ten diem goc:"))
(setq cdiemdinhhuong (getpoint "\nChon diem dinh huong:"))
(setq tdiemdinhhuong (getstring "\nNhap ten diem dinh huong:"))
(setq docaoguong (getstring "\nNhap do cao guong:"))

(princ "\nChon cac diem can tinh toan")
(setq tapdiemchon (ssget (list (cons 0 "POINT"))))

 (setq vitrifiledulieu (getfiled "File xuat du lieu " "" "csv" 1))

(setq nddong1 (strcat tdiemgoc dauphancach (rtos (car cdiemgoc) 2 4)  dauphancach (rtos (cadr cdiemgoc) 2 4) dauphancach (rtos (caddr cdiemgoc) 2 4) dauphancach  tdiemgoc))
(setq nddong2 (strcat tdiemdinhhuong dauphancach (rtos (car cdiemdinhhuong) 2 4)  dauphancach (rtos (cadr cdiemdinhhuong) 2 4) dauphancach (rtos (caddr cdiemdinhhuong) 2 4) dauphancach  tdiemdinhhuong))

(setq filedulieu (open vitrifiledulieu "w"))
(write-line nddong1 filedulieu)
(write-line nddong2 filedulieu)
(write-line "" filedulieu)
(write-line (strcat "stt" dauphancach "goc nam" dauphancach "gocdung" dauphancach "kcxien" dauphancach "Cao guong") filedulieu)

 (setq stt 0)
 (setq sodiem (sslength tapdiemchon))
 (while (< stt sodiem)
 (setq diemdocduoc (cdr (assoc 10 (entget (ssname tapdiemchon stt)))))
(setq nddongn (duy:point>dongnd cdiemgoc cdiemdinhhuong diemdocduoc))
(write-line (strcat (rtos (+ stt 1) 2 0) dauphancach nddongn dauphancach docaoguong) filedulieu)
 (setq stt (+ stt 1))
 )

(close filedulieu)
(command "undo" "end")
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(princ "\nLenh xuatgoc dung xuat tu XYZ sang goc")

cảm ơn, vì tác gia lisp mình post họ không share, cảm ơn

cao máy cao gương để hiển thị đúng góc đứng, nếu điểm tọa độ có độ cao, mới cần, ko thôi

Download lisp

Filename: 403483_xuatgoc.lsp

Tác giả: whoang
Bài viết gốc: 399211
Tên lệnh: kdg

Nhờ các bác viết lisp vẽ đường dóng trắc ngang

Bạn sửa lại như thế này, dùng cho L1 là Line,Pline, Sline,*Line :

(defun c:kdg(/ ST:Ss->ListEnt...
>>

Download lisp

Filename: 399211_kdg.lsp

Tác giả: namhai
Bài viết gốc: 83087
Tên lệnh: cdx

Lisp điền cao độ bị lỗi!!!

Bận nên không có thời gian xem lại giúp bạn lisp trên. nhưng có cái này share cho bạn.
Lisp này dùng để ghi cao độ trên trắc ngang và khá đẹp với các trắc ngang...
>>
Bận nên không có thời gian xem lại giúp bạn lisp trên. nhưng có cái này share cho bạn.
Lisp này dùng để ghi cao độ trên trắc ngang và khá đẹp với các trắc ngang chạy bằng nova. có thể chạy được trên cad14 vô tư :rolleyes:
(defun DXFcn (code elist)
 (cdr (assoc code elist))
)
;============================================================
(prompt"\n - GHI CAO DO DIEM TREN TRAC NGANG by Thaistreetz - huuthais@yahoo.com\n")
;============================================================
(defun c:Cdx (); / DZ pt y ptside ang OT sc1 scale tx ty tx1 ty1)
(command "Undo" "BEGIN")
(if (not h) (setq h 1))
(if (= tx nil) (setq tx 1))
(if (= ty nil) (setq ty 1))
(setq h1 (getreal (strcat "\n Cao text < " (rtos h 2 2) " >: "))
        tx1 (getreal (strcat "\nTy le theo phuong X <1/"(rtos tx 2 2)">: 1/")) 
        ty1 (getreal (strcat "\nTy le theo phuong Y <1/"(rtos ty 2 2)">: 1/")))
(if h1 (setq h h1))
(if tx1 (setq tx tx1))
(if ty1 (setq ty ty1))
(setq ATLAST (getvar "Attreq"))
(setq CMLAST (getvar "cmdecho"))
(setq OSLAST (getvar "OSMODE"))
(setq DZ (getvar "DIMZIN"))
(setq OT (getvar "ORTHOMODE"))
(setvar "ORTHOMODE" 0)
(setvar "cmdecho" 0)
(command "osmode" 99)
(setq pt0 (osnap (getpoint "Diem tim TN tu nhien") "end")) (print)
(setq x0 (car pt0) y0 (cadr pt0))
(setq ed (entget (car (entsel "\nChon cao do tim: "))))
(setq H0 (read (DXFcn 1 ed)))    
(command "osmode" 15359) 
(setq pt (getpoint "\nDiem chen: "))
(While (/= pt nil)
(command "osmode" 0)
(Progn
(setq ptside (getpoint "\nPhia chen:" pt)
ang (angle pt ptside))
(setq y (- (cadr pt) y0 (- H0)))
(setq x (- (car pt) x0))
(setvar "DIMZIN" 0)         
(cond ((> x 0) (setq x (strcat "" (rtos (* x tx) 2 2))))
        ((< x 0) (setq x (rtos (abs (* x tx)) 2 2)))
        ((= x 0) (setq x "0.00"))         )
(cond ((> y 0) (setq y (strcat "+" (rtos (* y ty) 2 2))))
        ((< y 0) (setq y (rtos (* y ty) 2 2)))
        ((= y 0) (setq y "%%p0.00")))
;(setq x (ustr 0 "Khoang cach: " x T))
;(setq y (ustr 0 "Cao do: " y T))
(progn
(if (AND (>= ang 0) (< ang (/ pi 2)))
(setq 	pt3 (list (car pt) (+ (cadr pt) (* 1.15 h)))
pt4 (list (car pt) (+ (cadr pt) (* 2.5 h)))
pt5 (list (+ (car pt4) (* 5 h)) (cadr pt4))
pt6 (list (+ (car pt4) (* 2.5 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (+ (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
(if (AND (>= ang (/ pi 2)) (< ang pi))
(setq 	pt3 (list (car pt) (+ (cadr pt) (* 1.15 h)))
pt4 (list (car pt) (+ (cadr pt) (* 2.5 h)))
pt5 (list (- (car pt4) (* 5 h)) (cadr pt4))
pt6 (list (- (car pt4) (* 2.5 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (- (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
(if (AND (>= ang pi) (< ang (+ pi (/ pi 2))))
(setq 	pt3 (list (car pt) (- (cadr pt) (* 1.15 h)))
pt4 (list (car pt) (- (cadr pt) (* 2.5 h)))
pt5 (list (- (car pt4) (* 5 h)) (cadr pt4))
pt6 (list (- (car pt4) (* 2.6 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (- (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
(if (AND (>= ang (+ pi (/ pi 2))) (< ang (* 2 pi)))
(setq 	pt3 (list (car pt) (- (cadr pt) (* 1.15 h)))
pt4 (list (car pt) (- (cadr pt) (* 2.5 h)))
pt5 (list (+ (car pt4) (* 5 h)) (cadr pt4))
pt6 (list (+ (car pt4) (* 2.5 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (+ (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
);progn
(command "pline" pt "w" 0 (* 0.45 h) pt3 "w" 0 0 pt4 pt5 ""
 "text" "m" pt6 h 0 y
 "text" "m" pt7 h 0 x)
(setvar "DIMZIN" DZ)
(command "osmode" 15359)
(setq pt (getpoint "\nDiem chen: "))
);progn
);while 
(setvar "OSMODE" OSLAST)
(setvar "ORTHOMODE" OT)
(setvar "cmdecho" CMLAST)
(prompt"\n by Thaistreetz - huuthais@yahoo.com\n")
(command "Undo" "End")
(princ)
);end
- Chọn kích thước của text muốn ghi cao độ (nên chọn bằng hoặc nhỏ hơn 1 chút so với chiều cao các text cao độ trên trắc ngang của bạn)

- Chọn tỷ lệ vẽ của trắc ngang (Với Nova thì thường là 1:1 nên mình mặc định lisp sẽ lấy giá trị tỷ lệ X là 1/1 và Y là 1/1, nếu tỷ lệ khác thì bạn có thể nhập lại)

- Chọn điểm tim trắc ngang (điểm tim đường)

- Chọn cao độ của tim đường (pick chuột vào text cao độ của tim)

- Chọn các điểm cần tra cao độ.

- Phía chèn text cao độ: bạn có thể chèn cao độ theo 4 hướng. thử sẽ bít :(
Bác Thaistreet à, Lisp của bác rất hay, lisp này dùng để tra cao độ thì ổn rồi, nhưng bác có thể giúp e vấn đề này không, vì nhiều lúc e phải sửa trắc ngang bằng Cad (chứ không sửa trong Nova) bằng cách Stretch đường tự nhiên tại các k/c lẻ nên tất nhiên cao độ cũng thay đổi, giờ e đang làm thủ công băng cách Di rồi lại +,-.. để tính lại cao độ rồi lại edit...hic!Có cách nào có thể tự động hoá việc này không, mong các bác giúp đỡ. ý tưởng của e có thể là :

- Chọn cao độ tại tim đường làm chuẩn

- sau đó pick vào các điểm mình muốn chèn(Các điểm mình đã thay đổi cao độ)

- Chọn text mình muốn thay thế(Là text cao độ cũ)

P/s : E chỉ thay đổi cao độ thôi, còn khoảng cách lẻ vẫn giữ nguyên nên ko cần quan tâm đến k/c lẻ

Rất mong nhận được sự giúp đỡ của các bác, thanks alot!!

<<

Download lisp

Filename: 83087_cdx.lsp

Tác giả: Tue_NV
Bài viết gốc: 187446
Tên lệnh: h2

Lisp hatch nhanh.

(defun c:h2 () (command "_layer" "Set" "--5-DUYTUAN-HATCH" "")
(setvar "cmdecho" 0)
(initget "P S")
(setq ansp (getkword "\n...
>>
(defun c:h2 () (command "_layer" "Set" "--5-DUYTUAN-HATCH" "")
(setvar "cmdecho" 0)
(initget "P S")
(setq ansp (getkword "\n Chon kieu pick diem hay chon doi tuong < P/S > :"))
(setq p nil dt t)
;(WHILE (or (not p) (not dt))
(progn
(setq ten "SOLID" )
(if (= ansp "P")
  (progn
(while (setq p (getpoint "\n Chon 1 diem trong vung can hatch :"))
  	(lh1 p ten sc ang)
)
  )
  (progn
(princ "\n Chon doi tuong can hatch :")
(while (setq dt (ssget) )
(lh dt ten sc ang)
)
  )
 )
)
;);WHILE
(princ)
)
;;;;;;;;
(defun lh1(p name tle goc)
(setvar "hpgaptol" 50.0)
(vl-cmdf "bhatch" "P" name tle goc p "")
)
;;;;;;;;;;
(defun lh(dt name tle goc)
(setvar "hpgaptol" 50.0)
(vl-cmdf "bhatch" "P" name tle goc "S" dt "" "")
)
Tình hình là lisp này lúc dùng được lúc không, nó hiện ra thông báo

"this area has already been specified"

Em không biết gì về lisp và cái trên là em tự chắp vá nên không hiểu nguyên lý lắm (sau khi bị bác Thanh Bình mắng nên mặc cảm, tự mò)

Nhờ các cao thủ sửa giúp ạ. Em xin cảm ơn.
Lisp trên là Tue_NV viết. Bạn vào đây nhé :

http://www.cadviet.c...showtopic=19720

Tình hình là Bạn chỉnh sửa Lisp và bạn đã bỏ đi các đối số làm LISP không hiểu được.

Topic mà Tue_NV gửi Link có chứa yêu cầu của bạn.

Thắc mắc gì bạn post vào topic ở đường Link trên nhé.

Chúc vui

<<