Jump to content
InfoFile
Tác giả: Duong Nhat Duy
Bài viết gốc: 451270
Tên lệnh: dg
Autolips đo góc và xuất giá trị sang text.

Của bạn đây:

Lisp nó hoạt động như lệnh Dim góc nhé:

- Dim giữa 2 đối tượng thì pick 2 đối tượng và 1 điểm xuất text

- Dim 3 điểm thì bạn cần enter 1 phát sau khi DG, sau đó mới chọn 3 điểm (điểm góc trước, 2 điểm ở 2 cạnh sau) + 1 điểm xuất text.

- Hay có thể dim cung cũng được.

Tóm lại bạn dùng lệnh DAN ntn thì lisp như thế.

>>

Của bạn đây:

Lisp nó hoạt động như lệnh Dim góc nhé:

- Dim giữa 2 đối tượng thì pick 2 đối tượng và 1 điểm xuất text

- Dim 3 điểm thì bạn cần enter 1 phát sau khi DG, sau đó mới chọn 3 điểm (điểm góc trước, 2 điểm ở 2 cạnh sau) + 1 điểm xuất text.

- Hay có thể dim cung cũng được.

Tóm lại bạn dùng lệnh DAN ntn thì lisp như thế.

(defun C:dg ( / ENT_DIM ENT_LAST PT RAD STR)
  (setq ent_last (entlast))
  (command "_DIMANGULAR")
  (while (> (getvar "CMDACTIVE") 0)
    (command pause)
    )
  (setq ent_dim (entlast))
  (if (not (eq ent_last ent_dim))
    (progn
      (setq pt (getvar "lastpoint"))
      (setq rad (vla-get-Measurement (vlax-ename->vla-object ent_dim)))
      (setq str (vl-string-subst "%%d" "d" (angtos rad 1 4)))
      (entmake (list
		 (cons 0 "TEXT")
		 (cons 100 "AcDbEntity")
		 (cons 100 "AcDbText")
		 (cons 8 (getvar "CLAYER"))
		 (cons 1 str)
		 (cons 7 (getvar "TEXTSTYLE"))
		 (cons 10 pt)
		 (cons 40 1.0)
	      ))
      (entdel ent_dim)
      )
    )
  (print)
  )
(vl-load-com)

Muốn sửa cao chữ bạn sửa chỗ 1.0 ở dòng (cons 40 1.0) nhé!


<<

Filename: 451270_dg.lsp
Tác giả: Tue_NV
Bài viết gốc: 131128
Tên lệnh: df
Nhờ viết hộ lisp chia trần siêu tốc

Gửi bạn Tuệ,

Rất cám ơn bạn. Lisp của bạn chưa đáp ứng đưọc yêu cầu là các cạnh phải thoả mãn từ 305x305 trở lên để...

>>

Gửi bạn Tuệ,

Rất cám ơn bạn. Lisp của bạn chưa đáp ứng đưọc yêu cầu là các cạnh phải thoả mãn từ 305x305 trở lên để tránh cắt vụn tấm trần. Đây là phần khó nhất của lisp này.

Trong file cad lúc đầu của mình có minh họa cách chia trần đúng và sai để các bạn tham khảo. Minh post lại để bạn xem.

 

http://www.cadviet.c...ia_tran_gia.dwg

Hoàng

Ơ, sao vậy nhỉ??

Lisp chạy ra đúng kết quả như vậy cơ mà???

(defun c:df(/ e kcv p kcx kcy dvx dvy dv)
 (setq e (car(entsel)))
 (setq kcv (getreal "\n Khoang cach luoi o vuong :"))
 (setq p (ACET-ENT-GEOMEXTENTS e) d1 (car p) d2 (cadr p)
 	kcx (abs (- (car d1) (car d2)))
kcy (abs (- (cadr d1) (cadr d2)))	
dvx (* (/ (- (/ kcx kcv) (fix (1- (/ kcx kcv)))) 2) kcv)
dvy (* (/ (- (/ kcy kcv) (fix (1- (/ kcy kcv)))) 2) kcv)
 )
(if (< dvx 305) (setq dvx (+ dvx 305)))  
(if (< dvy 305) (setq dvy (+ dvx 305)))
(setq dv (mapcar '+ d1 (list dvx dvy 0.0)))
 (command "ucs" "m" dv)
 (command "hatch" "u" "0" kcv "y" e "")
 (command "ucs" "p" )
)

Bạn sửa lại một chút lisp bác Tuệ viết cho bạn là như trên là được

Bạn sửa như vậy là không hợp lý rồi

dvx và dvy bao giờ cũng lớn hơn kcv/2 (tức là lớn hơn 305). Bạn đọc kỹ rồi kiểm tra lại nhé

Hơn nữa, Bạn sửa vô 305 như vậy thì khoảng cách lưới không bằng 610 thì sao????

Lisp của Tue_NV chạy tốt, không có vấn đề gì cả.


<<

Filename: 131128_df.lsp
Tác giả: Duong Nhat Duy
Bài viết gốc: 451437
Tên lệnh: test
Lisp chọn lựa 3 defun để thực hiện! help me!
(defun C:test ()

(defun thang ()
(setq A (getpoint "diem1: "))
(setq B (getpoint "diem2: "))
(command "line" A B "")
)

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

(defun tron ()
(setq C (getpoint "tam duong tron: "))
(setq D (getdist "nhap ban kinh: "))
(command "circle" C D "")
)

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

(defun Hinhchunhat ()
(setq A (getpoint "\n Diem dau tien: "))
(initget (+ 1 2 4))
(setq B (getreal "\n Chieu...
>>
(defun C:test ()

(defun thang ()
(setq A (getpoint "diem1: "))
(setq B (getpoint "diem2: "))
(command "line" A B "")
)

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

(defun tron ()
(setq C (getpoint "tam duong tron: "))
(setq D (getdist "nhap ban kinh: "))
(command "circle" C D "")
)

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

(defun Hinhchunhat ()
(setq A (getpoint "\n Diem dau tien: "))
(initget (+ 1 2 4))
(setq B (getreal "\n Chieu dai: "))
(initget (+ 1 2 4))
(setq C (getreal "\n Chieu rong: "))

(setq A1 (polar A 0 B))
(setq A2 (polar A1 (/ pi 2) C))
(setq A3 (polar A (/ pi 2) C))

(command ".pline" A A1 A2 A3 "close")
)

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

(setq E (getstring "\nve thAng/Tron/Hinhchunhat: "))
(cond
  ((= (strcase E) "T") (tron))
  ((= (strcase E) "H") (Hinhchunhat))
  (t (thang))
  )
  (print)
)

 


<<

Filename: 451437_test.lsp
Tác giả: SoftvnBin
Bài viết gốc: 207882
Tên lệnh: csum
Lisp lọc các số sau chữ L, rồi tính tổng.

Ý mình là từ cái lisp Demigod post lên:

Tặng mọi người Lisp giải bài toán này.

Lệnh: Csum

- Xuất thống kê...

>>

Ý mình là từ cái lisp Demigod post lên:

Tặng mọi người Lisp giải bài toán này.

Lệnh: Csum

- Xuất thống kê (txt hoặc excel).

- Có 2 tùy chọn để nhặt đối tượng (TEXT và MTEXT)

M: chọn 1 text mẫu -> trình tự động nhặt tất cả

C: Chọn trên màn hình

- Xuất txt chọn: T

Xuất Excel chọn: E

 

Good Luck :D.

 

(defun CreateDataList(text / i truoc sau)
 (vl-load-com)
 (setq i (1+ (vl-string-search "," text))
truoc (substr text 1 (1- i))
sau (substr text (1+ i) (- (strlen text) i))
sau (vl-string-subst "" " " sau)
sau (vl-string-subst "" "l" sau)
sau (vl-string-subst "" "L" sau)
 )
 (list truoc sau)
)
;======================================================================================================
(defun GetObject(/ kw)
 (initget "M C")
 (if (= key nil)
(progn
 	(setq kw (getkword (strcat "\nKi\U+1EC3u ch\U+1ECDn  <C>: ")))
 	(if (= kw nil) (setq kw "C"))
)
(progn
 	(setq kw (getkword (strcat "\nKi\U+1EC3u ch\U+1ECDn  <" key ">: ")))
 	(if (= kw nil) (setq kw key))
)
 )
 (setq key kw)
 (defun Mselect(/ chk mau ssx)
(setq chk T)
(while chk
 	(setq mau (car (entsel "\nCh\U+1ECDn \U+0111\U+1ED1i t\U+01B0\U+1EE3ng m\U+1EABu: ")))
 	(if mau (setq chk nil))
)
(setq ssx (ssget "_X" (list
  	(cons -4 "<OR")
  	(cons 0 "TEXT")
  	(cons 0 "MTEXT")
  	(cons -4 "OR>")
  	(cons 8 (cdr (assoc 8 (entget mau))))
  	(cons -4 "<OR")
  	(cons 1 "*#*`,L#*")
  	(cons 1 "*#*`, L#*")
  	(cons -4 "OR>")
)
  	)
)
 )
 (defun Cselect(/ ssx)
(setq ssx (ssget (list
  	(cons -4 "<OR")
  	(cons 0 "TEXT")
  	(cons 0 "MTEXT")
  	(cons -4 "OR>")
  	(cons -4 "<OR")
  	(cons 1 "*#*`,L#*")
  	(cons 1 "*#*`, L#*")
  	(cons -4 "OR>")
)
  	)
)
 )
 (cond
((= kw "C") (setq ssx (Cselect)))
((= kw "M") (setq ssx (Mselect)))
 )
 ssx
)
;======================================================================================================
(defun Summary(/ ssx DataList di AllType Dtype TypeI xi Tsum ExportData)
 (setq ssx (GetObject)
DataList '()
di 0
 )
 (while (< di (sslength ssx))
(setq DataList (append DataList (list (CreateDataList (cdr (assoc 1 (entget (ssname ssx di))))))))
(setq di (1+ di))
 )
 (setq AllType (mapcar 'car Datalist) Dtype '())
 (while AllType
(setq Dtype (append Dtype (list (car AllType))))
(setq AllType (vl-remove (car AllType) AllType))
 )
 (setq ExportData '())
 (while Dtype
(setq TypeI (car Dtype) xi 0 Tsum 0.0)
(while (< xi (length DataList))
 	(if (= (car (nth xi DataList)) TypeI) (setq Tsum (+ Tsum (atof (cadr (nth xi DataList))))))
 	(setq xi (1+ xi))
)
(setq ExportData (append ExportData (list (list TypeI Tsum))))
(setq Dtype (cdr Dtype))
 )
 ExportData
)
;======================================================================================================
(defun 2excel(ExportData / xlapp ex ex-wb nwb sheet cell exi coci Xchen Ychen)
 (VL-LOAD-COM)
 (setq xlapp (vlax-create-object "Excel.Application"))
 (setq ex (vlax-put-property xlapp "Visible" T))
 (setq ex-wb (vlax-get-property xlapp "Workbooks"))
 (setq nwb (vlax-invoke-method ex-wb "add"))
 (setq sheet (vlax-get-property nwb "ActiveSheet"))
 (setq cell (vlax-get-property sheet "Cells"))
 (setq exi 0)
 (vlax-put-property cell "item" (1+ exi) 1 "LOAI")
 (vlax-put-property cell "item" (1+ exi) 2 "TONG DAI")

 (while (< exi (length ExportData))
(setq coci (nth exi ExportData))
(setq Xchen (nth 0 coci))
(setq Ychen (nth 1 coci))
(vlax-put-property cell "item" (+ exi 2) 1 Xchen)
(vlax-put-property cell "item" (+ exi 2) 2 ychen)
(setq exi (1+ exi))
 )
 (princ)
 (princ)
)
;======================================================================================================
(defun 2txt(ExportData / Path txtFile file i coci Xchen Ychen)
 (setq Path (getvar "DWGPREFIX"))
 (setq txtFile (strcat Path "Summary.txt"))
 (setq file (Open txtFile "w"))
 (setq txi 0)
 (write-line (strcat "LOAI" " " "TONG DAI") file)
 (while (< txi (length ExportData))
(setq typi (nth txi ExportData))
(setq Xchen (nth 0 typi))
(setq Ychen (nth 1 typi))
(write-line (strcat Xchen " " (rtos Ychen 2 3)) file)
(setq txi (1+ txi))
 )
 (close file)
 (startapp "Notepad" txtFile)
 (princ)
 (princ)
)
;======================================================================================================
(defun c:Csum(/ kw ExportData)
 (setq ExportData (Summary))
 (initget "E T")
 (if (= keyx nil)
(progn
 	(setq kw (getkword (strcat "\nXu\U+1EA5t  <T>: ")))
 	(if (= kw nil) (setq kw "T"))
)
(progn
 	(setq kw (getkword (strcat "\nXu\U+1EA5t  <" keyx ">: ")))
 	(if (= kw nil) (setq kw keyx))
)
 )
 (setq keyx kw)
 (cond
((= kw "T") (setq ssx (2txt ExportData)))
((= kw "E") (setq ssx (2excel ExportData)))
 )
 (princ)
 (princ)
)

 

Mình cải tiến cái lisp này thành như sau:

1. bỏ các tùy chọn sau:

- Xuất thống kê (txt hoặc excel).

- Có 2 tùy chọn để nhặt đối tượng (TEXT và MTEXT)

M: chọn 1 text mẫu -> trình tự động nhặt tất cả

C: Chọn trên màn hình

- Xuất txt chọn: T

Xuất Excel chọn: E

 

2. Thay thế bằng:

 

1. Nhập tên lệnh: AAA

2. Chọn vùng tính toán

3. Pick vị trí đặt bảng <đỉnh mép trái>: pick điểm đặt

Ghi chú: - Lisp chỉ chọn các *text có định dạng ký tự chung là "*** D***, L = *****m. (các *text có định dạng ký tự khác thì bỏ qua)

- Trên ống đã ghi "BBB D25, L = 2,5m" và có Block tên "Chech D25" (cùng là D25) thì sẽ lấy ký tự trước trên ống, chính là ký tự BBB và lấy tên tên Block "Chech D25" để cho ra text trong bảng là chech BBB D25......

 

5. Lisp sẽ tính toán và thống kê ra bảng như sau:

17200_gui_lai.jpg

File cad như sau:

http://www.cadviet.c...toan_nuoc_1.rar


<<

Filename: 207882_csum.lsp
Tác giả: w1nDream
Bài viết gốc: 93972
Tên lệnh: nbpl
Thêm node vào đường Pline
Chào bác Meohoang,

Bác thử dùng cái này coi sao nhé.

Mình bổ sung thêm vào lisp để có thể sử dụng với các loại đường LINE, POLYLINE, và LWPOLYLINE bác...

>>
Chào bác Meohoang,

Bác thử dùng cái này coi sao nhé.

Mình bổ sung thêm vào lisp để có thể sử dụng với các loại đường LINE, POLYLINE, và LWPOLYLINE bác ạ.

Thực ra cái đường 2Dpolyline như bác nêu chính là cái đường LWPOLYLINE mà mình đã làm trong cái lisp cũ. Tuy nhiên với POLYLINE tức là đường 3Dpolyline thì lisp không đúng nữa do với các POLYLINE này sau khi break nó sẽ tạo ra hai đối tượng hoàn toàn mới và cái đối tượng cũ (ename) bị mất đi. Vì thế cái lệnh Pedit của mình không còn đúng nữa.

Với các line cũng vậy break thì ngon nhưng khi pedit lại phải thay đổ cấu trúc lệnh mới được và sau khi pedit thì các LINE sẽ trở thành LWPOLYLINE.

Vì thế mình dùng thêm hàm điều kiện để pedit cho từng trường hợp cụ thể. Bác cứ xem thêm trong lisp sẽ hiểu cách mình làm.

Cách này tuy chưa gọn gàng lắm nhưng có thể dùng được bác ạ.

Mong bác dùng thử và cho ý kiến để mình rút kinh nghiệm nha.

(defun c:NBPL()
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq ss (car (entsel "\n Pick chon doi tuong : ")))
(Hli ss)
(setq po (getpoint "\n Chon diem cat : "))
;;;(setq ddau (vlax-curve-getstartPoint ss  ))
;;;(setq dcuoi (vlax-curve-getEndPoint ss ))
(if (= (cdr (assoc 0 (entget ss))) "POLYLINE")
(progn
(Command "break" ss po "@")
(setq ent (entlast))
(command "undo" "be")
(entdel ent )
(command "undo" "e")
(setq ss (entlast))
(command "undo" "1")
(Command "Pedit" ss "j" ent "" "")
(Hli (entlast))
(while po 
(setq po (getpoint "\n Chon diem cat tiep theo : "))
;;;(Command "select" ddau dcuoi "")
;;;(setq ss (ssget "P"))
(if (/= po nil)
(progn
(Command "break" ss po "@")
(setq ent (entlast))
(command "undo" "be")
(entdel ent)
(command "undo" "e")
(setq ss (entlast))
(command "undo" "1")
(Command "Pedit" ss "j" ent "" "")
;;;(sssetfirst ss ss)
(Hli ss)
)
)
)
)
)
(if (= (cdr (assoc 0 (entget ss))) "LWPOLYLINE")
(progn
(Command "break" ss po "@")
(setq ent (entlast))
(Command "Pedit" ss "j" ent "" "")
(Hli ss)
(while po 
(setq po (getpoint "\n Chon diem cat tiep theo : "))
(if (/= po nil)
(progn
(Command "break" ss po "@")
(setq ent (entlast))
(Command "Pedit" ss "j" ent "" "")
(Hli ss)
)
)
)
)
)
(if (= (cdr (assoc 0 (entget ss))) "LINE")
(progn
(Command "break" ss po "@")
(setq ent (entlast))
(Command "Pedit" ss "y" "j" ent "" "")
(setq ss (entlast))
(Hli ss)
(while po 
(setq po (getpoint "\n Chon diem cat tiep theo : "))
(if (/= po nil)
(progn
(Command "break" ss po "@")
(setq ent (entlast))
(Command "Pedit" ss "j" ent "" "")
(Hli ss)
)
)
)
)
)
(setvar "osmode" oldos)

(princ)
)
;
(defun HLI(ent)
(sssetfirst (ssadd ent (ssadd)) (ssadd ent (ssadd)))
) 

Chúc bác khỏe và vui.

 

PS: các loại đường khác như arc , cung elip và spline mình thấy hình như mọi người ít dùng nên cũng chưa nghiên cứu rõ lắm. Nếu bác xét thấy cần thiết thì mình sẽ thử cố tí nữa xem sao. Hề hề hề....

 

Lisp của Bác Bình rất hay. :cheers:

thaks bác .Đúng cái em đang cần.

PS: à.Em có 1 ý kiến nhỏ là có lẽ bác nên để chế độ Osnap để bắt điểm chèn.


<<

Filename: 93972_nbpl.lsp
Tác giả: Tue_NV
Bài viết gốc: 32595
Tên lệnh: cg1
Chọn text là số

Hy vọng đoạn code sau đúng ý bạn.

 

(DEFUN IsNumeric (str)
 (if (not(vl-string-search " " str))
   (if (member (type (read str)) '(REAL INT) )
     T
     nil
    ...
>>
Hy vọng đoạn code sau đúng ý bạn.

 

(DEFUN IsNumeric (str)
 (if (not(vl-string-search " " str))
   (if (member (type (read str)) '(REAL INT) )
     T
     nil
     )
   nil
   )
 )

(defun C:cg1 ()
 (setvar "CMDECHO" 0)
 (setq pre (getint "\nSo chu so sau dau phay?"))
 (command "luprec" pre)
 (setq tong 0)
 (SETQ TH (SSGET (list (cons 0 "TEXT"))))
 (SETQ QUANT (SSLENGTH TH))
 (SETQ INDEX 0)
 (WHILE (< INDEX QUANT)
 (setq s (entget (SSNAME TH INDEX)))
 (setq otext (assoc 1 s))
 (setq ot (cdr otext))
 (if (IsNumeric ot) ;neu noi dung ot la so
   (setq ot (atof ot)
	 tong (+ ot tong)) ; tinh tong
   ) 	 
   (setq index (+ index 1))
 )
 (prompt "\n Chon gia tri can thay the")
 (SETQ TT (SSGET))
 (SETQ QUAN (SSLENGTH TT))
 (SETQ INDE 0)
 (WHILE (< INDE QUAN)
 (setq s (entget (SSNAME TT INDE)))
 (setq otext (assoc 1 s))
 (setq nt (cons 1 (rtos Tong 2 pre)))
 (setq s (subst nt otext s))
 (entmod s)
   (setq inde (+ inde 1))
 )
)

Đúng là đoạn Code trên tính tổng của các số (sau khi loại bỏ các text chữ). Nhưng ý của em ngay từ đầu là muốn chọn đối tượng là text số để xử lý phép tính số học sau khi chọn bằng Grid.

Ứng dụng hàm IsNumeric là hàm kiểm tra nội dung của 1 chuỗi là số, em viết đoạn Code dưới đây để thực hiện phép tính cộng thêm vào giá trị được chọn để giá trị được chọn nhận kết quả mới là thêm một giá trị cộng thêm vào. Nhưng đoạn Code dưới bị lỗi mà em chưa biết sai ở đâu. Anh sửa lại giúp em với nhé.

(DEFUN IsNumeric (str)
 (if (not(vl-string-search " " str))
   (if (member (type (read str)) '(REAL INT) )
     T
     nil
     )
   nil
   )
 )
(defun c:cso()
(setvar "CMDECHO" 0)
(setq pre (getint "\nSo chu so sau dau phay?"))
(command "luprec" pre)  
(setq co (getreal "\nGia tri can cong them:"))
(SETQ TH (SSGET(list(cons 0 "TEXT"))))
(SETQ QUANT (SSLENGTH TH))
 (SETQ INDEX 0)
 (WHILE (< INDEX QUANT)
		 (setq s (entget (SSNAME TH INDEX)))
	   (setq otext (assoc 1 s))
	   (setq ot (cdr otext))
	  (if(IsNumeric ot)
	      (setq ot (atof ot))
	      (setq nt (cons 1 (rtos (+ ot co))))  
	      (setq s (subst nt otext s))
	      (entmod s)
   		   )
   (setq index (+ index 1))
 )
)

Cám ơn anh nhé.


<<

Filename: 32595_cg1.lsp
Tác giả: Danh Cong
Bài viết gốc: 451502
Tên lệnh: pl-center
Cách vẽ 1 đoạn thẳng cách đều 2 đoạn thẳng cho trước.

Lisp tạo đường PLine giữa 2 đường Pline khác: 

 



; Write by Danh Cong - Cadviet.com 13-11-2020
; SDT 0336 760 750

(defun c:PL-CENTER (/ I KC LEN_PL_1 LST_POINT N PL_1 PL_2 PT1 PT2 PT3)
  (vl-load-com)
  (prompt "Select PLINE_1 ?")
  (setq PL_1 (car (entsel)))
  (prompt "Select PLINE_2 ?")
  (setq PL_2 (car (entsel)))

  (INITGET (+ 1 2 4))
  (setq KC...

>>

Lisp tạo đường PLine giữa 2 đường Pline khác: 

 



; Write by Danh Cong - Cadviet.com 13-11-2020
; SDT 0336 760 750

(defun c:PL-CENTER (/ I KC LEN_PL_1 LST_POINT N PL_1 PL_2 PT1 PT2 PT3)
  (vl-load-com)
  (prompt "Select PLINE_1 ?")
  (setq PL_1 (car (entsel)))
  (prompt "Select PLINE_2 ?")
  (setq PL_2 (car (entsel)))

  (INITGET (+ 1 2 4))
  (setq KC (getreal "/nKhoang cach chia ?"))

  (setq lst_Point '())

  (setq Len_PL_1 (vlax-curve-getDistAtParam PL_1 (vlax-curve-getEndParam PL_1)))
  (setq i 0 n (/ Len_PL_1 KC))

  (while (< i n)
    (progn
      (setq Pt1 (vlax-curve-getPointAtDist PL_1 (* i KC)))
      (setq Pt2 (vlax-curve-getClosestPointTo PL_2 Pt1))
      (setq Pt3 (list (/ (+ (nth 0 Pt1) (nth 0 Pt2)) 2) (/ (+ (nth 1 Pt1) (nth 1 Pt2)) 2)))
      (setq lst_Point (append lst_Point (list Pt3)))
      (setq i (+ i 1))
      ); endprogn
    ); end while

  (acet-pline-make (list lst_Point))
  
  (princ))


<<

Filename: 451502_pl-center.lsp
Tác giả: Ar_Chanwoo
Bài viết gốc: 14254
Tên lệnh: show
Giao diện hộp thoại trong AutoLisp
Kiểu này chuối lắm dùng file *.chm hoặc *.hlp hay hơn nhiều

code đây không biết có đúng ý bạn không?

Thuty.dcl:

(defun read-txt (filename /...
>>
Kiểu này chuối lắm dùng file *.chm hoặc *.hlp hay hơn nhiều

code đây không biết có đúng ý bạn không?

Thuty.dcl:

(defun read-txt (filename / open_f line_r list-out file_read)
(setq list-out nil)
(if (/= (findfile filename) nil)
 (progn  
 (setq file_read (open filename "r"))
 (while
 (/= nil
 (setq line_r (read-line file_read))
  )
 (setq list-out (append list-out (list line_r)))
  )
 (close file_read)
)
(princ)  
)
list-out
)
;;;;;;;;;;;;;;;
;==== Load and check dialog ===========
; dia_name : string
(defun loadcl ( dia_name)
 (if (= -1 (setq dcl_id (load_dialog (strcat dia_name ".dcl"))))
(progn
  (alert (strcat dia_name ".dcl" "not found")
  (setq dialogloaded nil)
)		 
);p
(setq dialogloaded 1)
);f
);defun
;;;;;;;;;;;=========================
(defun c:show (/ fname  l1  dcl_id dialogloaded)
 (setq fname (getfiled "chon file"  "c:\\"  "*" 16)); lựa chọn file
;(setq fname "c:\\abc\\abc.txt"); hoặc chỉ định file
 (if (and
(/= fname nil)
(> (loadcl "thuty") 0); load and check dialog 
  ) 
  (if (not (new_dialog "thuty" dcl_id))
 (exit); Error
 (progn;else
		(start_list "doctxt")	 
		(mapcar' add_list (read-txt fname))  
		(end_list)
		(start_dialog)						 
		(done_dialog)
	(unload_dialog dcl_id)
);p

  );if1 
  );if
 (princ)
);defun

Have fun

 

Thanks Pro đã viết cho e nhưng ko đúng với ý e lắm! Anh viết lại hộ e như thế này đc ko:

Sau khi gõ lệnh, sẽ hiện ra hôp thoại "Doc file txt" luôn, không phải chọn đường dẫn nữa, mà em thắc mác cái "dùng file *.chm hoặc *.hlp hay hơn nhiều" của bác nói?


<<

Filename: 14254_show.lsp
Tác giả: tientracdia
Bài viết gốc: 230883
Tên lệnh: kk
Lisp up nội dung từ Excel vào Cad

 

Lisp mới đây. Trước khi chạy bạn Copy cái này vào Support:

 

Lisp mới đây. Trước khi chạy bạn Copy cái này vào Support:

http://www.cadviet.com/upfiles/3/71162_block_tientracdia.dwg

(Chú ý: sau khi download về thì đổi tên File thành BLOCK_TIENTRACDIA.dwg)

Sau khi chạy Lisp thì số liệu sẽ là Block thuộc tính. Dùng Lisp ở #11 để xuất ngược lại sang TXT. Nếu muốn số liệu trên bản vẽ là các Text bình thường thì dùng lệnh BURST để phá vỡ các Block thuộc tính.

;========LISP UPDATE SO LIEU TU FILE TXT VAO CADU==========
;================KANGKUNG 25/03/2013=======================
;=================UPDATED 05/04/2013=======================
(defun C:KK()
  (command "UNDO" "BE")
  (setq taphop(ssget '((0 . "TEXT"))))
  (setq os(getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (if (not Path)
    (setq Path(getvar "dwgprefix")))
  (setq file(getfiled "Select File:" Path "txt" 2))
  (setq Path file)
  (setq index 0)
  (setq TEXT_LIST (list))
  (while (< index (sslength taphop))
    (setq TEXT (entget (ssname taphop index)))
    (if (/= (read (cdr(assoc 1 TEXT))) (atof (cdr(assoc 1 TEXT))))
      (progn
	(setq String(cdr(assoc 1 TEXT)))
	(if (= (+ (cdr(assoc 72 TEXT)) (cdr(assoc 73 TEXT))) 0)
	  (setq InsertPoint(cdr(assoc 10 TEXT)))
	  (setq InsertPoint(cdr(assoc 11 TEXT)))
	  )
	(setq TEXT_LIST (append (list (list String InsertPoint)) TEXT_LIST))
	)
      )
    (setq index (1+ index))
    )
  (setq file_in(open file "R"))
  (setq lst_solieu(list))
  (while(setq txt(read-line file_in))
    (if (/= txt nil) (setq lst (read (strcat "(" txt ")"  ))))
    (foreach dt TEXT_LIST
      (if (= (car dt) (vl-princ-to-string(car lst)))
	(progn
	  (setq pt(cadr dt))
	  (command "ZOOM" "W" (list (- (car pt) 3) (+ (cadr pt) 2)) (list (+ (car pt) 3) (- (cadr pt) 5)))
	  (command "ERASE" "W" (list (- (car pt) 3) (+ (cadr pt) 2)) (list (+ (car pt) 3) (- (cadr pt) 5)) "")
	  (command "INSERT"  "BLOCK_TIENTRACDIA"  pt  "1" "1" "0"
		   (vl-princ-to-string(car lst))
		   (rtos (nth 1 lst) 2 2)
		   (rtos (nth 2 lst) 2 2)
		   (rtos (nth 3 lst) 2 2)
		   (rtos (nth 4 lst) 2 2)
		   (rtos (nth 5 lst) 2 2)
		 )
	  )
	)
      )
    )
  (close file_in)
  (setvar "OSMODE" os)
  (command "UNDO" "END")
  (alert "Da xong \n\n Muon pha Block thi dung lenh BURST")
  (princ "\n BURST de pha Block")
  (princ)
  )
(princ "\n                Written By KangKung - 25/03/2013\n")
(princ "\n                  Nhap KK de chay chuong trinh\n")

Đúng là ứng dụng block thuộc tính thực hiện rất hay, mình chưa hiểu được về vấn đề này.

Công việc mình cần nhiều dạng thực hiện như vầy lắm, muốn thêm vào nhiều dử liệu tính toán, sợ làm phiền bạn viết hoài.

Mong muốn Bạn giải thích cho mình ý nghĩa các đoạn lệnh của Lisp trên, để tự nghiên cứu chỉnh lý theo yêu cầu về sau.


<<

Filename: 230883_kk.lsp
Tác giả: ngokiet
Bài viết gốc: 451771
Tên lệnh: pl2tg tg
Nhờ các cao thủ viết giúp Lisp vẽ tam giác bất kỳ khi biết chiều dài 3 cạnh
(defun acos (x) (if (<= -1 x 1) (atan (sqrt(- 1 (* x x))) x)))
(defun gg(a b c)
  (if (and (/= a 0) (/= b 0))
    (acos (/ (- (+ (* a a) (* b b)) (* c c)) (* 2 a b)))))
(defun cdtg(en / lp d ag a0 a1)
  (setq en (entget en))
  (if (and (eq (cdr (assoc 0 en)) "LWPOLYLINE")
	   (eq (cdr (assoc 90 en)) 4)
	   (eq (cdr (assoc 70 en)) 0)
	   (setq lp (mapcar 'cdr (vl-remove-if-not '(lambda(x) (eq (car x) 10)) en))
		 d ...
>>
(defun acos (x) (if (<= -1 x 1) (atan (sqrt(- 1 (* x x))) x)))
(defun gg(a b c)
  (if (and (/= a 0) (/= b 0))
    (acos (/ (- (+ (* a a) (* b b)) (* c c)) (* 2 a b)))))
(defun cdtg(en / lp d ag a0 a1)
  (setq en (entget en))
  (if (and (eq (cdr (assoc 0 en)) "LWPOLYLINE")
	   (eq (cdr (assoc 90 en)) 4)
	   (eq (cdr (assoc 70 en)) 0)
	   (setq lp (mapcar 'cdr (vl-remove-if-not '(lambda(x) (eq (car x) 10)) en))
		 d  (mapcar 'distance lp (cdr lp))
		 ag (apply 'gg d)))
    (progn
      (setq a0 (if (> (sin (- (angle (cadr lp) (caddr lp)) (setq a1 (angle (cadr lp) (car lp))))) 0) (+ a1 ag) (- a1 ag))
	    lp (list (car lp) (cadr lp) (polar (cadr lp) a0 (cadr d)))
	    en (vl-remove-if '(lambda(x) (vl-position (car x) '(10 40 41 42 91))) en))
      (entmod (append
		(subst '(90 . 3) '(90 . 4) (subst '(70 . 1) '(70 . 0) en))
		(apply 'append
		       (mapcar '(lambda(x) (cons (cons 10 x) '((40 . 0) (41 . 0) (42 . 0) (91 . 0)))) lp)))))))
(defun c:pl2tg()
  (cdtg (car(entsel)))
  (princ))
(defun c:tg(/ en n)
  (setq en (entlast) n 4)
  (while (entnext en) (setq en (entnext en)))
  (command "pline" pause)
  (while (/= (getvar 'cmdactive) 0)
    (if (> (setq n (1- n)) 0) (command pause) (command "")))
  (if (/= en (entlast)) (cdtg (entlast)))
  (princ))

Buổi sáng code nhanh cho bạn.

- Lệnh pl2tg: Chuyển đỗi polyline có 3 cạnh (4 dỉnh ,  open) thành pl tam giác có chiều dài 3 cạnh bằng 3 cạnh pl.

- Lệnh tg. Vẽ tam giác bằng cách vẽ pl 3 cạnh trên.

* Lưu ý là cạnh đầu tiên pl sẽ không đổi, điểm thứ 3 sẽ định hướng tam giác.

 Nếu xác định được tam giác sẽ chuyển nếu ko thì thôi.


<<

Filename: 451771_pl2tg_tg.lsp
Tác giả: zizpo_hetxang
Bài viết gốc: 142663
Tên lệnh: cht1
Viết lisp theo yêu cầu [phần 2]

(defun c:cht1(/ hText chLay Lay chFont)
(vl-load-com)
(command "undo" "be")
(princ "Ch\U+1ECDn Dim, *Text, ATT* c\U+1EA7n thay \U+0111\U+1ED5i...
>>

(defun c:cht1(/ hText chLay Lay chFont)
(vl-load-com)
(command "undo" "be")
(princ "Ch\U+1ECDn Dim, *Text, ATT* c\U+1EA7n thay \U+0111\U+1ED5i :")
(setq ss (ssget '((0 . "DIMENSION,LEADER,*TEXT,ATT*"))))
(setq hText (getreal "\Chi\U+1EC1u cao ch\U+1EEF :") chLay "k" chFont "k")
(initget 1 "c k")
(setq chLay (getkword "B\U+1EA1n c\U+00F3 mu\U+1ED1n thay \U+0111\U+1ED5i layer Text ? <K> :"))
(if (or (null chLay) (= (strcase chLay) "K"))
   (setq Lay nil)
   (setq Lay (getstring "T\U+00EAn layer :"))    
)
(initget 1 "c k")
(setq chFont (getkword "B\U+1EA1n c\U+00F3 mu\U+1ED1n thay \U+0111\U+1ED5i Font ? <K>  :"))
(if  (not(or (null chLay) (= (strcase chLay) "K")))
   (progn 
   (vlax-for x (vla-get-textstyles
         (vla-get-activedocument (vlax-get-acad-object))
       )
       (vla-put-fontfile x "VNswitzerlandcondlight.TTF")
   )
   )
)
(foreach ent 
(mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(if (vlax-property-available-p ent 'TextHeight) (vlax-put-property ent 'TextHeight (rtos hText 2 0) ))
(if (vlax-property-available-p ent 'Height) (vlax-put-property ent 'Height (rtos hText 2 0)) )
(if (and lay (vlax-property-available-p ent 'Layer)) (vlax-put-property  ent 'Layer Lay))
)
(command "undo" "en")
)

Bạn dùng tạm :(

thankyou ketxu nhé. dùng rất là ok


<<

Filename: 142663_cht1.lsp
Tác giả: huunhantvxdts
Bài viết gốc: 451810
Tên lệnh: had1
Nhờ viết Lisp tạo Dim theo tỷ lệ khung bản vẽ

15 giờ trước, HALUMGLASS@GMAIL.COM đã nói:

Nhờ các anh...

>>
15 giờ trước, HALUMGLASS@GMAIL.COM đã nói:

Nhờ các anh tạo code lệnh theo mong muốn của em như sau:

- Gõ lệnh TAODIM

- Lấy chiều cạnh dài khung bản vẽ  (BẰNG CÁCH PICK ĐIỂM ĐẦU ĐIỂM CUỐI) Được kích thước L = A mm.

- Lấy A mm/420mm = B mm

- Lấy B mm/3 = C mm (lấy giá trị C thành giá trị Dimscale trong biến hệ thống) 

- Cuối cùng sẽ tạo được dimstyle là Ha-D-C (C chính là giá trị được tạo ra ở trên)

Trân thành cảm ơn!

(defun       c:had1()
   (setvar   "cmdecho" 0)
   (command  "layer"       "m"    "Dims"           "c"     "2"     "")
   (setvar   "dimasz"  3); arrow size
   (setvar   "dimclrd" 9); mau duong giong 
   (setvar   "dimclrt" 2); mau text kich thuoc
   (setvar   "dimclre" 9); mau duong giong ngang
   (setvar   "dimexe"  1); extend beyond dim lines
   (setvar   "dimexo"  3); offset from origin
   (setvar   "dimtad"  1)
   (setvar   "dimtih"  0)
   (setvar   "dimtofl" 1); Chon draw dim line between ext lines
   (setvar   "dimtix"  1); chon always keep text between ext lines
   (setvar   "dimtxt"  3); Text height
   (setvar   "dimdli"  10); Baseline spacing
   (setvar   "dimscale"  1); use overall scale of        
   (setvar   "dimfxlon"  1)    ; chon fixed length extension lines    
   (setvar   "dimfxl"  6); gia tri fixed length bang 6

   (command  "layer"   "s"       "dims"       "")
   (command  "style"   "romanc"  "romanc"  "0"       ""        ""        ""        ""        "")
   (command  "style"   "romans"  "romans"  "0"       ""        ""        ""        ""        "")
   (setvar     "DIMTXSTY" "romanc"); chon kieu text style
   (setvar   "dimblk"  "dotsmall")
   (setvar   "dimblk1"  ".")
   (setvar   "dimblk2"  ".")
   (command "dimstyle" "save" "Ha-D1" )

   (princ)
)

Bạn xem thế này đã được chưa nhé

(defun c:had1(/ p1 p2 kc hesocale tendim oldos)
   (setq cur_lay (getvar "clayer" ))
   (setq oldos (getvar "osmode"))
   (setvar "osmode" 15359)
   (setq p1 (getpoint "\nPick diem thu 1"))
   (setq p2 (getpoint p1 "\nPick diem thu 2"))
   (setq kc (distance p1 p2))
   (setq hesocale (/ kc 420 3))
   (setvar   "cmdecho" 0)
   ;(command  "layer" "m" "Dims" "c" "2" "")
   (if (not (tblsearch "layer" "Dims")) 
(command "-layer" "new" "Dims" "color" "1" "Dims" "")
)
   (setvar   "dimasz"  3); arrow size
   (setvar   "dimclrd" 9); mau duong giong 
   (setvar   "dimclrt" 2); mau text kich thuoc
   (setvar   "dimclre" 9); mau duong giong ngang
   (setvar   "dimexe"  1); extend beyond dim lines
   (setvar   "dimexo"  3); offset from origin
   (setvar   "dimtad"  1)
   (setvar   "dimtih"  0)
   (setvar   "dimtofl" 1); Chon draw dim line between ext lines
   (setvar   "dimtix"  1); chon always keep text between ext lines
   (setvar   "dimtxt"  3); Text height
   (setvar   "dimdli"  10); Baseline spacing
   (setvar   "dimscale"  hesocale); use overall scale of        
   (setvar   "dimfxlon"  1)    ; chon fixed length extension lines    
   (setvar   "dimfxl"  6); gia tri fixed length bang 6
   (command  "layer" "s" "dims" "")
   (command "style" "romanc" "Vnsimple.shx" 0 0.75 "" "" "" "")
   ;(command  "style"   "romanc"  "romanc"  "0"       ""        ""        ""        ""        "")
   ;(command  "style"   "romans"  "romans"  "0"       ""        ""        ""        ""        "")
   (setvar   "DIMTXSTY" "romanc"); chon kieu text style
   (setvar   "dimblk"  "dotsmall")
   (setvar   "dimblk1"  ".")
   (setvar   "dimblk2"  ".")
   (setq tendim (strcat "HA-D-" (rtos hesocale 2 2)))
   (if (not (tblsearch "dimstyle" tendim)) 
	(command "dimstyle" "s" tendim "y")
	(alert (strcat "Dim " tendim " da co"))
	)
   ;(command "dimstyle" "s" tendim "y")
   
	(setvar "osmode" oldos)
	(setvar "CMDECHO" 1)
	(setvar "clayer" cur_lay)
   (princ)
   
)

 


<<

Filename: 451810_had1.lsp
Tác giả: ngokiet
Bài viết gốc: 451891
Tên lệnh: br1
Em đang gặp phải 1 vấn đề. Mong các bác giúp đỡ. Em xin cảm ơn

Hic mấy bác cũng hay thật. Mình đọc chỉ hiểu sơ được ý chủ thớt thôi. Theo mình thì bài toán này có mấy trường hợp.

- Chiều dài được tính là theo khoảng cách hay chiều dài. (Vd như arc length hay distance khoảng cách điểm đầu điểm cuối.

- Khoảng 2 đầu được vẽ như thế nào khi chiều dài lẻ.

- Khi Pline kín mà khoảng cách lẻ thì vẽ như thế...

>>

Hic mấy bác cũng hay thật. Mình đọc chỉ hiểu sơ được ý chủ thớt thôi. Theo mình thì bài toán này có mấy trường hợp.

- Chiều dài được tính là theo khoảng cách hay chiều dài. (Vd như arc length hay distance khoảng cách điểm đầu điểm cuối.

- Khoảng 2 đầu được vẽ như thế nào khi chiều dài lẻ.

- Khi Pline kín mà khoảng cách lẻ thì vẽ như thế nào?

Theo AutoCad thì linetype nó vẽ theo chiều dài. Lypetype generation thì nó xác định theo toàn đường hay từng đoạn.

Phần 2 đầu thì nó làm phần dư. Nếu pline khép kín thì nó chuyển qua chia đều.

Mình viết thử 1 phương án khoảng cách theo length, Nhưng trim luôn 2 đầu. Không chạy được với Pline - Fit/smooth( Với đường này cần explore nó ra rồi join lại sẽ chạy được)

Các đường khác như circle,arc, elip, elip arc, spline chạy bình thường.

Lisp sử dụng command break nên chạy hơi chậm.

(defun c:br1(/ oso l1 l2 l0 n ob)
  
  (initget 0 "5x5 10x10 20x10")
  (mapcar 'set '(l1 l2)
	  (nth (vl-position (cond ((getkword " Chon :"))
				  ("5x5"))
		 '("5x5" "10x10" "20x10"))
	       '((5 10) (10 20) (20 30))))
  (setq oso (getvar 'osmode))
  (setvar 'osmode 0)
  (foreach ex (acet-ss-to-list (ssget))
    (if (/= (setq ob  (vlax-ename->vla-object ex)
		  Len (vlax-curve-getdistatparam ob (vlax-curve-getendparam ob))
		  n   (fix (/ (- len l1) l2))
		  l0  (/ (- len l1 (* n l2)) 2)) 0)
      (progn
	(command "break" (list ex (vlax-curve-getpointatdist ob (- len l0))) (vlax-curve-getendpoint ob))
	(command "break" (list ex (vlax-curve-getstartpoint ob)) (vlax-curve-getpointatdist ob l0))))
    (repeat n
      (command "break" (list ex (vlax-curve-getpointatdist ob l1)) (vlax-curve-getpointatdist ob l2))
      (setq ex (entlast)ob (vlax-ename->vla-object ex))))
  
  (setvar 'osmode oso)
  (princ))

 

 


<<

Filename: 451891_br1.lsp
Tác giả: Duong Nhat Duy
Bài viết gốc: 451929
Tên lệnh: cd
cần giúp đỡ lisp cộng dim

Của bạn đây !

(defun C:cd ( / DT I OBJ SS STR X)
  (setq dt (getreal "Nhap so muon cong/tru: "))
  (setq ss (ssget (list (cons 0 "*DIMENSION"))))
  (setq i 0)
  (repeat (sslength ss)
    (setq obj (vlax-ename->vla-object (ssname ss i)))
    (if (zerop (setq x (atof (vla-get-TextOverride obj))))
      (setq x (vla-get-Measurement obj))
      )
    (setq str (strcat (vla-get-TextPrefix obj) (rtos (+ x...
>>

Của bạn đây !

(defun C:cd ( / DT I OBJ SS STR X)
  (setq dt (getreal "Nhap so muon cong/tru: "))
  (setq ss (ssget (list (cons 0 "*DIMENSION"))))
  (setq i 0)
  (repeat (sslength ss)
    (setq obj (vlax-ename->vla-object (ssname ss i)))
    (if (zerop (setq x (atof (vla-get-TextOverride obj))))
      (setq x (vla-get-Measurement obj))
      )
    (setq str (strcat (vla-get-TextPrefix obj) (rtos (+ x dt) 2 0) (vla-get-TextSuffix obj)))
    (vla-put-TextOverride obj str)
    (setq i (1+ i))
    )
  (print)
  )
(vl-load-com)

 


<<

Filename: 451929_cd.lsp
Tác giả: gia_bach
Bài viết gốc: 429278
Tên lệnh: 333
Entsel không highlight đối tượng khi đặt giữa Undo ?

Dùng vla...

(defun C:333 ()
  (vl-load-com)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark doc)
  (entsel)
  (vla-endundomark doc)
  
  (print)  )

 


Filename: 429278_333.lsp
Tác giả: nataca
Bài viết gốc: 75110
Tên lệnh: mnh
Lisp đưa đối tượng về vị trí cũ sau khi move?

Ý của em cũng giống với ý bác Nataca đấy bác Tuệ ạ, nếu đã dùng lisp này thì phải thay lệnh Move trong cad bằng lệnh Move trong lisp của bác, vì thế em không muốn nó...
>>
Ý của em cũng giống với ý bác Nataca đấy bác Tuệ ạ, nếu đã dùng lisp này thì phải thay lệnh Move trong cad bằng lệnh Move trong lisp của bác, vì thế em không muốn nó khác đi 1 tí gì so với lệnh Move của cad :cheers:

(defun c:mnh(/ base second)
(setq ss (ssget))
(setq base (getpoint "\n Base point :"))
(setq second (ACET-SS-DRAG-MOVE ss base "\n Second point :"))
(command "move" ss "" base second)
(setq kc (distance base second))
(setq ang (angle second base))
(princ)
)

nếu cố tình dùng lisp thì tthay hàm getpoint bằng hàm ACET-SS-DRAG-MOVE là được. Ban có thể sửa tên lệnh của lisp này là lệnh Move luôn cũng được. Không sao cả. Muốn nó thành luôn lệnh của cad thì thêm câu lệnh này:

(vlax-add-cmd "Move" 'c:mnh)


<<

Filename: 75110_mnh.lsp
Tác giả: hai_1401
Bài viết gốc: 75199
Tên lệnh: mnh
Lisp đưa đối tượng về vị trí cũ sau khi move?
Rất cảm ơn Nataca.

Chào hai_1401. Bạn sử dụng Code đã chỉnh lại dưới đây xem có đúng ý không nhé.

(defun c:mnh(/ base second)
(setq ss (ssget))
(setq...
>>
Rất cảm ơn Nataca.

Chào hai_1401. Bạn sử dụng Code đã chỉnh lại dưới đây xem có đúng ý không nhé.

(defun c:mnh(/ base second)
(setq ss (ssget))
(setq base (getpoint "\n Base point :"))
(setq second (ACET-SS-DRAG-MOVE ss base "\n Second point :" 0))
(command "move" ss "" base second)
(setq kc (distance base second))
(setq ang (angle second base))
(princ)
)

Còn muốn để đối tượng trở về vị trí cũ thì sử dụng lisp tmn.

 

Chưa được bác Tuệ ạ, vẫn bị lỗi khi move theo kích thước, sai cả hướng nữa :cheers:


<<

Filename: 75199_mnh.lsp
Tác giả: Phiphi-
Bài viết gốc: 32780
Tên lệnh: xd
Viết Lisp theo yêu cầu
OK,

Đây là lisp đã cải tiến, bạn thử xem có đúng ý không:

(defun c:xd ()
 (setq sel (entsel "\nHay pick mot diem thuoc mat tien nha: "))
 (if (or (not...
>>
OK,

Đây là lisp đã cải tiến, bạn thử xem có đúng ý không:

(defun c:xd ()
 (setq sel (entsel "\nHay pick mot diem thuoc mat tien nha: "))
 (if (or (not sel)
  (/= "LINE" (cdr (assoc 0 (entget (car sel)))))
     )
   (alert
     "Ban chon khong dung\nHay pick vao mot doi tuong LINE"
   )
   (progn
     (setq
ent    (car sel)
p1     (cdr (assoc 10 (entget ent)))
phuong (trans (getpoint (cadr sel) "\nHay pick huong dat chu: ")
	      1
	      0
       )
B_     (getreal "\mB (m): ")
D_     (getstring "\mD (m): ")
p      (vlax-curve-getClosestPointTo ent (trans (cadr sel) 1 0))

     )
     (saveos)
     (changegeo p p1 phuong)
     (setq pI_	   (trans (list 0.0 4300.0 0.0) 1 0)
    pPoint (trans (list 0.0 (* -1000.0 B_) 0.0) 1 0)
     )
     (restoregeo)
     (command ".insert"
       "B-D"
       (trans pI_ 0 1)
       1.0
       1.0
       0.0
       (strcat (rtos B_ 2 1) "B")
       (strcat D_ "D")
     )
     (if xdlast
       (command ".line" xdlast pPoint "")
     )
     (setq xdlast pPoint)
     (restoreos)
   )
 )
)
(defun saveos ()
 (setq cv_oldos (getvar "osmode"))
 (setvar "osmode" 0)
)
(defun restoreos ()
 (setvar "osmode" cv_oldos)
 (setq cv_oldos nil)
)
(defun changegeo (p p1 phuong)
 (command ".ucs" "w")
 (command ".ucs" "3" p p1 phuong)
)
(defun restoregeo ()
 (command ".ucs" "p")
 (command ".ucs" "p")
)

Tuần rồi Bác Hoành đã viết cho PP đoạn LISP này, sáng hôm ấy chạy OK lắm, nhưng hốm nay bắt đầu xài thì bị trở ngại như sau:

Load LISP> OK (AutoCAD 2006)

Đánh lệnh:

Command: xd

Hay pick mot diem thuoc mat tien nha:

Hay pick huong dat chu: mB (m): 3.2

mD (m): 0.5

.ucs

Current ucs name: *WORLD*

Enter an option

<World>: w

Command: .ucs

Current ucs name: *WORLD*

Enter an option

<World>: 3

Specify new origin point <0,0,0>:

Specify point on positive portion of X-axis <-4562495.8796,-787879.7759,0.0000>:

Specify point on positive-Y portion of the UCS XY plane

<-4562497.8508,-787880.0141,0.0000>:

Command: .ucs

Current ucs name: *NO NAME*

Enter an option

<World>: p

Command: .ucs

Current ucs name: *WORLD*

Enter an option

<World>: p

Command: .insert Enter block name or : B-D Specify insertion point or

:

Enter X scale factor, specify opposite corner, or <1>:

1.000000000000000 Enter Y scale factor <use X scale factor>: 1.000000000000000

Specify rotation angle <0d>: 0.000000000000000

Đến đây thì bổng nhiên hiện lên box ENTER ATTRIBUTES PP phải nhập mB/mD lần nữa thì mới vẽ xong 1 line.

(Hôm trước thì không có cái box này)

Đây là đoạn sau:

Command: 3.2B Unknown command "3.2B". Press F1 for help.

Command: 0.5D Unknown command "0.5D". Press F1 for help.

Command: nil

Command: <Coords off>

Command: xd

Please help các Bác ơi!

Bản vẽ thử: http://www.cadviet.com/upfiles/bvdo.zip

File LISP: http://www.cadviet.com/upfiles/XD_11_9.lsp

Thanks you very nhiều


<<

Filename: 32780_xd.lsp
Tác giả: taipham
Bài viết gốc: 407323
Tên lệnh: tty
Nhờ Sửa Lỗi Lisp

Do chưa đúng điểm "G" nên mò đêm, mò ngày không ra, chứ gặp điểm "G" thì nó sẽ ra ào ào...!...

>>

Do chưa đúng điểm "G" nên mò đêm, mò ngày không ra, chứ gặp điểm "G" thì nó sẽ ra ào ào...! :D

Anh giúp em cái này với, mò hoài mấy bữa nay mà không ra.

- Em muốn khi quét chọn các đường xong, click vào block thì text att trong block luôn hướng lên cho dù xoay màn hình bất cứ góc nào (viewtwist), theo chiều như bản vẽ đính kèm. Anh sửa trực tiếp vào code này nhé (ở đoạn giữa). Cảm ơn anh!

http://www.cadviet.com/upfiles/6/146422_nho_sua_lisp_1.dwg

(defun c:TTY ()
  (command "undo" "be")
  (setq osm (getvar "osmode")
	lts (getvar "ltscale"))
  (command ".ltscale" 1000)
  (setvar "cmdecho" 0)	
  (setvar "osmode" 0)
  (while
    (setq p1 (getpoint "1"))
    (setq p2 (getpoint p1 "2"))

    (if (null (setq d195 (ssget "F" (list p1 p2) (list (cons 8 "00-D195")))))
      (progn (setq d195 0) (setq scada 0))
      (progn (setq d195 (sslength d195)) (setq scada 1)))

    (if (null (setq d130tt (ssget "F" (list p1 p2) (list (cons 8 "00-D130 TT")))))
      (setq d130tt 0)
      (setq d130tt (sslength d130tt)))

    (if (null (setq d130ht (ssget "F" (list p1 p2) (list (cons 8 "00-D130 HT")))))
      (setq d130ht 0)
      (setq d130ht (sslength d130ht)))

    (if (null (setq d65md (ssget "F" (list p1 p2) (list (cons 8 "00-D65 MD")))))
      (setq d65md "0")
      (setq d65md "n"))

    (if (null (setq vt (ssget "F" (list p1 p2) (list (cons 8 "00-VT")))))
      (setq vt "")
      (setq vt "v"))

    (setq tmc (strcat vt (itoa d195) (itoa d130tt) (itoa scada) (itoa d130ht) d65md))
    (and
      (/= tmc "00000")
      (/= tmc "v00000")
      (while
	(setq tenblock (car (entsel "\nChon block sua: ")))
	(progn
	(setq tenatt (entnext tenblock))
	(setq hamcon (entget tenatt))
	(setq hamcon (subst (cons 1 tmc) (assoc 1 hamcon) hamcon))

	(setq view (getvar "viewtwist"))
	(setq gatt (cdr (assoc 50 hamcon)))
	(repeat (fix (/ gatt (* pi 2)))
	  (setq gatt (- gatt (* pi 2))))
	(cond
	  (;mo 1
	  (and
	    (>= view 0.0)
	    (< view (/ pi 2))
	    (>= gatt (- (/ pi 2) view))
	    (< gatt (- (/ (* 3 pi) 2) view))
	    (setq gatt gatt))
	   (setq gatt (+ gatt pi))
	   );dong 1
	  
	  (;mo 4
	  (and
	    (>= view (/ (* 3 pi) 2))
	    (< view (* pi 2))
	    (>= gatt (+ (/ pi 2) (- (* pi 2) view)))
	    (< gatt (+ (/ (* 3 pi) 2) (- (* pi 2) view)))
	    (setq gatt gatt))
	   (setq gatt (+ gatt pi))
	   );dong 4

	  ;(;mo 2
	  ;(and
	    ;(>= view (/ pi 2))
	    ;(< view pi)
	    ;(>= gatt (- (* 2 pi) (- view (/ pi 2))))
	    ;(< gatt (- pi (- view (/ pi 2))))
	    ;(setq gatt gatt))
	   ;(setq gatt (+ gatt pi))
	   ;);dong 2

	  ;(;mo 3
	   ;(and
	     ;(>= view pi)
	     ;(< view (/ (* 3 pi) 2))
	     ;(>= gatt pi)
	     ;(< gatt 0)
	     ;(setq gatt gatt))
	   ;(setq gatt (+ gatt pi))	 
	   ;);dong 3	  

	  );dong cond
	(setq hamcon (subst (cons 50 gatt) (assoc 50 hamcon) hamcon))	
	(entmod hamcon)
	(entupd tenblock)
	))
      (mapcar 'set '(vt d195 d130tt d130ht d65md scada p1 p2) '(nil nil nil nil nil nil nil nil))
      );and
    );while
  (setvar "osmode" osm)
  (setvar "cmdecho" 1)
  (command ".ltscale" lts)
  (command "undo" "e")
  (princ)
  )

<<

Filename: 407323_tty.lsp
Tác giả: taipham
Bài viết gốc: 407349
Tên lệnh: tty
Nhờ Sửa Lỗi Lisp

Đây anh, em đã làm được 3 góc phần tư rồi, còn lại góc twist từ pi đến 3pi/2 thì đang mò, hehe

>>

Đây anh, em đã làm được 3 góc phần tư rồi, còn lại góc twist từ pi đến 3pi/2 thì đang mò, hehe

http://www.cadviet.com/upfiles/6/146422_twist.dwg

Anh xem giúp em chỗ hàm cond (1 2 3 4), chỗ 1, 2, 4 thì oke, còn chỗ 3 thì không biết sai chỗ nào mà nó không lật text được.

(defun c:TTY ()
  (command "undo" "be")
  (setq osm (getvar "osmode")
	lts (getvar "ltscale"))
  (command ".ltscale" 1000)
  (setvar "cmdecho" 0)	
  (setvar "osmode" 0)
  (while
    (setq p1 (getpoint "1"))
    (setq p2 (getpoint p1 "2"))

    (if (null (setq d195 (ssget "F" (list p1 p2) (list (cons 8 "00-D195")))))
      (progn (setq d195 0) (setq scada 0))
      (progn (setq d195 (sslength d195)) (setq scada 1)))

    (if (null (setq d130tt (ssget "F" (list p1 p2) (list (cons 8 "00-D130 TT")))))
      (setq d130tt 0)
      (setq d130tt (sslength d130tt)))

    (if (null (setq d130ht (ssget "F" (list p1 p2) (list (cons 8 "00-D130 HT")))))
      (setq d130ht 0)
      (setq d130ht (sslength d130ht)))

    (if (null (setq d65md (ssget "F" (list p1 p2) (list (cons 8 "00-D65 MD")))))
      (setq d65md "0")
      (setq d65md "n"))

    (if (null (setq vt (ssget "F" (list p1 p2) (list (cons 8 "00-VT")))))
      (setq vt "")
      (setq vt "v"))

    (setq tmc (strcat vt (itoa d195) (itoa d130tt) (itoa scada) (itoa d130ht) d65md))
    (and
      (/= tmc "00000")
      (/= tmc "v00000")
      (while
	(setq tenblock (car (entsel "\nChon block sua: ")))
	(progn
	(setq tenatt (entnext tenblock))
	(setq hamcon (entget tenatt))
	(setq hamcon (subst (cons 1 tmc) (assoc 1 hamcon) hamcon))

	(setq view (getvar "viewtwist"))
	(setq gatt (cdr (assoc 50 hamcon)))
	(repeat (fix (/ gatt (* pi 2)))
	  (setq gatt (- gatt (* pi 2))))

;xem chỗ này giúp em, từ đây	
        (cond 
	  (;mo 1
	  (and
	    (>= view 0.0)
	    (< view (/ pi 2))
	    (>= gatt (- (/ pi 2) view))
	    (< gatt (- (/ (* 3 pi) 2) view))
	    (setq gatt gatt))
	   (setq gatt (+ gatt pi))
	   );dong 1
	  
	  (;mo 2
	  (and
	    (>= view (/ pi 2))
	    (< view pi)
	    (>= gatt (- 0 (- view (/ pi 2))))
	    (< gatt (- pi (- view (/ pi 2))))
	    (setq gatt gatt))
	   (setq gatt (+ gatt pi))
	   );dong 2

	  (;mo 3
	   (and
	     (>= view pi)
	     (< view (/ (* 3 pi) 2))
	     (>= gatt (- (/ (* 3 pi) 2) (- view pi)))
	     (< gatt (- (/ pi 2) (- view pi)))
	     (setq gatt gatt))
	   (setq gatt (+ gatt pi))	 
	   );dong 3

	  (;mo 4
	  (and
	    (>= view (/ (* 3 pi) 2))
	    (< view (* pi 2))
	    (>= gatt (+ (/ pi 2) (- (* pi 2) view)))
	    (< gatt (+ (/ (* 3 pi) 2) (- (* pi 2) view)))
	    (setq gatt gatt))
	   (setq gatt (+ gatt pi))
	   );dong 4

	  );dong cond
; đến đây

	(setq hamcon (subst (cons 50 gatt) (assoc 50 hamcon) hamcon))	
	(entmod hamcon)
	(entupd tenblock)
	))
      (mapcar 'set '(vt d195 d130tt d130ht d65md scada p1 p2) '(nil nil nil nil nil nil nil nil))
      );and
    );while
  (setvar "osmode" osm)
  (setvar "cmdecho" 1)
  (command ".ltscale" lts)
  (command "undo" "e")
  (princ)
  )

<<

Filename: 407349_tty.lsp

Trang 316/330

316