Viết Lisp theo yêu cầu

[tranchan 98]

Dễ vẽ, vẽ nhanh,....

 

Thực ra cũng nhìn là vậy thôi chứ dân kết cấu vẽ đâu fải vẽ sơ đồ không đâu còn fải triển khai chi tiết mắt nữa.. vậy tiết kiệm công đoạn nào hay đoạn ấy...Ví như khoảng chia bụng kèo >=3 m. Vuợt nhịp 50 m là fải chia ra tương ứng nữa.... Đó là chưa kể trước khi ra sơ đồ cad là fải chạy mô hình trên SAP ổn nữa chứ..?

 

 

Chưa đủ dữ liệu. Đường cong độ vồng là đường cong bậc mấy?

 

đuờng cong chỉ là cung đi qua 3 điểm thôi....

[Phiphi- 176]

Trong bản vẽ này http://www.cadviet.com/upfiles/Layers.zip , PP có vẽ 4 khung kèm theo tượng tương cho 4 images (vì gởi kẻm file hình thì dung lượng lớn quá) được vẽ chồng lên nhau và có 4 layers có tên khác nhau: Image1, Image2, Image3 & Image4. Ngoài ra còn có 4 layers dành cho mỗi nét vẽ khác nhau: Line1, Line2, Line3 & Line4.

Quả thật là vì chưa biết viết LISP nên PP phải nhờ đến các Bác giúp cho 1 việc như sau:

1. Về các layer Images:

+ Đánh lệnh I0 thì các layer Images tắt hết.

+ Đánh I1 thì chỉ layer Image1 hiện lên, các layer Images kia vẫn tắt.

+Tương tư như vậy muốn layer Image nào hiện lên thì chỉ cần đánh các lệnh như I2, I3, I4...

Note: Layer Image chỉ cho phép hiện mỗi 1 trong số những layer Images có trong bản vẽ mà thôi.

2. Về các layer Lines:

+ Đánh lệnh L0 thì layer Lines tắt hết.

+ Đánh lệnh Lall thì các layer Lines ĐỀU hiện lên.

+ Sau đó muốn layer Line nào hiện lên thì đánh lệnh như L11, tắt thì đánh lệnh L10 (L1= Line1 và chữ số sau: 1 =on, 0= off)

Note: Các layer Lines cho phép hiện nhiều ít tuỳ ý.

Hy vọng Các Bác hiểu ý trên của PP.

Xin cám ơn rất nhiều

[vndesperados 254]

Trong bản vẽ này http://www.cadviet.com/upfiles/Layers.zip , PP có vẽ 4 khung kèm theo tượng tương cho 4 images (vì gởi kẻm file hình thì dung lượng lớn quá) được vẽ chồng lên nhau và có 4 layers có tên khác nhau: Image1, Image2, Image3 & Image4. Ngoài ra còn có 4 layers dành cho mỗi nét vẽ khác nhau: Line1, Line2, Line3 & Line4.

Quả thật là vì chưa biết viết LISP nên PP phải nhờ đến các Bác giúp cho 1 việc như sau:

1. Về các layer Images:

+ Đánh lệnh I0 thì các layer Images tắt hết.

+ Đánh I1 thì chỉ layer Image1 hiện lên, các layer Images kia vẫn tắt.

+Tương tư như vậy muốn layer Image nào hiện lên thì chỉ cần đánh các lệnh như I2, I3, I4...

Note: Layer Image chỉ cho phép hiện mỗi 1 trong số những layer Images có trong bản vẽ mà thôi.

2. Về các layer Lines:

+ Đánh lệnh L0 thì layer Lines tắt hết.

+ Đánh lệnh Lall thì các layer Lines ĐỀU hiện lên.

+ Sau đó muốn layer Line nào hiện lên thì đánh lệnh như L11, tắt thì đánh lệnh L10 (L1= Line1 và chữ số sau: 1 =on, 0= off)

Note: Các layer Lines cho phép hiện nhiều ít tuỳ ý.

Hy vọng Các Bác hiểu ý trên của PP.

Xin cám ơn rất nhiều

 

(DEFUN C:I0()
(command "layer" "off" "Image1" "")
(command "layer" "off" "Image2" "")
(command "layer" "off" "Image3" "")
(command "layer" "off" "Image4" "")
)

(DEFUN C:I1()
(command "layer" "on" "Image1" "")
(command "layer" "off" "Image2" "")
(command "layer" "off" "Image3" "")
(command "layer" "off" "Image3" "")
)

(DEFUN C:I2()
(command "layer" "off" "Image1" "")
(command "layer" "on" "Image2" "")
(command "layer" "off" "Image3" "")
(command "layer" "off" "Image4" "")
)

(DEFUN C:I3()
(command "layer" "off" "Image1" "")
(command "layer" "off" "Image2" "")
(command "layer" "on" "Image3" "")
(command "layer" "off" "Image4" "")
)

(DEFUN C:I4()
(command "layer" "off" "Image1" "")
(command "layer" "off" "Image2" "")
(command "layer" "off" "Image3" "")
(command "layer" "on" "Image4" "")
)

 

Còn lại thì Phiphi- viết tiếp nha

[Phiphi- 176]

Còn lại thì Phiphi- viết tiếp nha

Thanks you Bác nhé.

Chắc đây sẽ là LISP đầu tiên PP bắt đầu viết. Và sẽ nhờ Bác sửa hộ dài dài :)

[nataca 554]

Thực ra cũng nhìn là vậy thôi chứ dân kết cấu vẽ đâu fải vẽ sơ đồ không đâu còn fải triển khai chi tiết mắt nữa.. vậy tiết kiệm công đoạn nào hay đoạn ấy...Ví như khoảng chia bụng kèo >=3 m. Vuợt nhịp 50 m là fải chia ra tương ứng nữa.... Đó là chưa kể trước khi ra sơ đồ cad là fải chạy mô hình trên SAP ổn nữa chứ..?

đuờng cong chỉ là cung đi qua 3 điểm thôi....

Đường cong đi qua 3 điểm thì là đường bậc 2 còn gì. Tôi đã vẽ thử, dùng vài lệnh cơ bản L, ARC, device là xong mà. Nhanh không. Viết Lisp thành ra phức tạp trong các kiểu thanh dàn bố trí khác nhau.

[thangkho 0]

CHO EM XIN LISP DÙNG ĐỂ THAY BLOCK NÀY BẰNG MỘT BLOCK KHÁC (CÁC BLOCK ĐƯỢC THAY THẾ DO MÌNH CHỌN)

EM CẢM ƠN TRƯỚC

[Snowman 92]

CHO EM XIN LISP DÙNG ĐỂ THAY BLOCK NÀY BẰNG MỘT BLOCK KHÁC (CÁC BLOCK ĐƯỢC THAY THẾ DO MÌNH CHỌN)

EM CẢM ƠN TRƯỚC

Không cần đến lisp đâu bạn ạ, vì trong Express đã có sẵn lệnh blockreplace rồi. Ngoài ra có thể làm thủ công bằng cách dùng lệnh BEDIT. Việc chỉnh sửa block tương đối nhanh và đơn giản nên ko nhất thiết phải phụ thuộc vào lisp

[duy782006 1.543]

Không cần đến lisp đâu bạn ạ, vì trong Express đã có sẵn lệnh blockreplace rồi. Ngoài ra có thể làm thủ công bằng cách dùng lệnh BEDIT. Việc chỉnh sửa block tương đối nhanh và đơn giản nên ko nhất thiết phải phụ thuộc vào lisp

Theo hiểu biết của mình thì blockreplace sẽ thay toàn bộ block có tên chỉ định trong bản vẽ chứ không chỉ thay block được chọn.

 

Đây là lisp chọn block mẫu sau đó chọn các block muốn thay thành block mẫu. lệnh là MABT

 

 

(defun c:mabt ()

 

(setq ddd (entsel "\nChon Block mau"))

(while

(or

(null ddd)

(/= "INSERT" (cdr (assoc 0 (entget (car ddd)))))

)

(princ "\nDoi tuong khong phai la Block! Chon lai")

(setq ddd (entsel "\nChon Block mau"))

)

 

(setq DT (car ddd))

(setq DTM (entget DT))

(setq TENKHOI (cdr (assoc 2 DTM)))

 

(Princ "\nChon BLOCK muon chinh :")

(setq xx (ssget '((0 . "insert"))))

(setq L 0)

(setq M (sslength XX))

(while (< L M)

(setq DTs (ssname XX L))

(setq DTMs (entget DTs))

(setq TENKHOIM TENKHOI)

(setq DTMs (subst (cons 2 TENKHOIM) (assoc 2 DTMs) DTMs))

(entmod DTMs)

 

(setq L (1+ L))

)

 

(setvar "MODEMACRO" "**CHUC BAN LAM VIEC HIEU QUA** PHAM QUOC DUY - BINH SON - QUANG NGAI")

(Princ))

[vndesperados 254]

Mọi người chú trọng đến thao tác mà ít chú ý đến mục đích của yêu cầu

 

CHO EM XIN LISP DÙNG ĐỂ THAY BLOCK NÀY BẰNG MỘT BLOCK KHÁC (CÁC BLOCK ĐƯỢC THAY THẾ DO MÌNH CHỌN)

EM CẢM ƠN TRƯỚC

 

 

Bạn muốn thay thế một 'block X' được chọn trên bản vẽ bằng 'block Y' hay thay thế tòan bộ 'block X' có trên bản vẽ bằng 'block Y'

[nataca 554]

Theo hiểu biết của mình thì blockreplace sẽ thay toàn bộ block có tên chỉ định trong bản vẽ chứ không chỉ thay block được chọn.

 

Đây là lisp chọn block mẫu sau đó chọn các block muốn thay thành block mẫu. lệnh là MABT

 

 

(defun c:mabt ()

 

(setq ddd (entsel "\nChon Block mau"))

(while

(or

(null ddd)

(/= "INSERT" (cdr (assoc 0 (entget (car ddd)))))

)

(princ "\nDoi tuong khong phai la Block! Chon lai")

(setq ddd (entsel "\nChon Block mau"))

)

 

(setq DT (car ddd))

(setq DTM (entget DT))

(setq TENKHOI (cdr (assoc 2 DTM)))

 

(Princ "\nChon BLOCK muon chinh :")

(setq xx (ssget '((0 . "insert"))))

(setq L 0)

(setq M (sslength XX))

(while (< L M)

(setq DTs (ssname XX L))

(setq DTMs (entget DTs))

(setq TENKHOIM TENKHOI)

(setq DTMs (subst (cons 2 TENKHOIM) (assoc 2 DTMs) DTMs))

(entmod DTMs)

 

(setq L (1+ L))

)

 

(setvar "MODEMACRO" "**CHUC BAN LAM VIEC HIEU QUA** PHAM QUOC DUY - BINH SON - QUANG NGAI")

(Princ))

Bác để màu chữ này khó nhìn quá. Hoa hết cả mắt

[duy782006 1.543]

Bác để màu chữ này khó nhìn quá. Hoa hết cả mắt

Thì bạn copy về nhìn cho dể. Mình thích màu cam mà và cả màu xanh lá nửa. :)

[ungdaive 0]

Em cũng mới tìm hiểu về listcad. Là dân cấp thoát nước nên cung tự chế ra được cai list để vạch mạng lưới này. Nhưng cảm thấy như thế vẫn lâu quá. Em muốn nhờ các bác viết cho cái list nào sẽ tạo hiện lên toàn bộ chiều dài của các đường LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE tại trung điểm của các đường đó khi ta quét các đối tượng này. Thanks các bác trước nhé!

 

(defun C:VM (/ tot_len ss e_name e_record e_type)

(princ "\nchon doan ong")

(setq tot_len 0.0)

(setq ss (ssget))

(if (null ss)

(exit)

)

(while (> (sslength ss) 0)

(setq e_name (ssname ss 0))

(setq e_record (entget e_name))

(setq e_type (cdr (assoc '0 e_record)))

(cond ((wcmatch e_type "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")

(command "lengthen" e_name "")

(setq tot_len (+ tot_len (getvar "PERIMETER")))

(ssdel e_name ss)

)

((wcmatch e_type "MLINE") (add_mline))

(e_type (ssdel e_name ss))

)

)

(setq pp (strcat "\ndn50-l" (rtos tot_len 2 1)))

(princ pp)

 

(entmake

(list

(cons 0 "TEXT")

(cons 10

(setq tmp (getpoint "\nVao diem chen text ket qua: "))

)

(cons 40 2)

(cons 50

(setq D (getangle "\nVao goc quay: "))

)

(cons 1 pp)

)

)

(princ)

)

(princ "\nVM - la cau lenh cua list ")

(princ)

[ssg 1.102]

Em cũng mới tìm hiểu về listcad. Là dân cấp thoát nước nên cung tự chế ra được cai list để vạch mạng lưới này. Nhưng cảm thấy như thế vẫn lâu quá. Em muốn nhờ các bác viết cho cái list nào sẽ tạo hiện lên toàn bộ chiều dài của các đường LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE tại trung điểm của các đường đó khi ta quét các đối tượng này. Thanks các bác trước nhé!

1- Góp với ý bạn, đã tìm hiểu về Lisp, trước hết phải chuẩn ngay từ tên gọi:

+ LISP - viết tắt của LISt Processing programming language - ngôn ngữ lập trình dựa trên cơ sở xử lý danh sách

+ AutoLISP - Lisp của hãng AutoDesk

 

Không chỉ đơn thuần là cái tên để phân biệt thằng Tí hay thằng Tèo, tên gọi của LISP nói lên cái bản chất, cái "hồn" của ngôn ngữ. Là LIST PROCESSING cho nên kiểu dữ liệu quan trọng nhất của ngôn ngữ này chính là LIST DATA TYPE. Bạn muốn lập được các chuơng trình Lisp đơn giản nhưng hiệu quả, hãy học kỹ về LIST và các kỹ thuật thao tác với chúng...

 

2- Cái sườn như bạn mô tả là đây, thêm "mắm muối" vào tuỳ ý bạn:

 

;;;-------------------------------------------------------------------------------
(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 Measure1(e / L p)
(vl-load-com)
(setq
L (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))
p (vlax-curve-getPointAtDist e (/ L 2)) 
)
(wtxt (strcat "L= " (rtos L)) p)
)
;;;-------------------------------------------------------------------------------
(defun C:VD( / ss e)
(setq ss (ssget '((0 . "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE"))))
(while (setq e (ssname ss 0))
(measure1 e)
(ssdel e ss)
)
)
;;;-------------------------------------------------------------------------------

[thangkho 0]

Mọi người chú trọng đến thao tác mà ít chú ý đến mục đích của yêu cầu

 

 

 

 

Bạn muốn thay thế một 'block X' được chọn trên bản vẽ bằng 'block Y' hay thay thế tòan bộ 'block X' có trên bản vẽ bằng 'block Y'

Em muốn thay thế một block X được chọn trên bản vẽ thành block Y

Cho em hỏi thêm có lisp nào dùng để mirror theo một đường dẩn (đường dẩn là đường cong) cho trước ko?

[Phiphi- 176]

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 [New/Move/orthoGraphic/Prev/Restore/Save/Del/Apply/?/World]

<World>: w

Command: .ucs

Current ucs name: *WORLD*

Enter an option [New/Move/orthoGraphic/Prev/Restore/Save/Del/Apply/?/World]

<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 [New/Move/orthoGraphic/Prev/Restore/Save/Del/Apply/?/World]

<World>: p

Command: .ucs

Current ucs name: *WORLD*

Enter an option [New/Move/orthoGraphic/Prev/Restore/Save/Del/Apply/?/World]

<World>: p

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

[basepoint/Scale/X/Y/Z/Rotate/PScale/PX/PY/PZ/PRotate]:

Enter X scale factor, specify opposite corner, or [Corner/XYZ] <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

[Nguyen Hoanh 4.663]

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:

Đế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)

Bạn gõ ATTDIA rồi nhập vào 0.

Cái này phải làm duy nhất 1 lần với mỗi file.

[vndesperados 254]

Em muốn thay thế một block X được chọn trên bản vẽ thành block Y

Cho em hỏi thêm có lisp nào dùng để mirror theo một đường dẩn (đường dẩn là đường cong) cho trước ko?

 

 

 

 

(Nhầm một tí, "Place" trên giao diện phải là "Replace")

 

Giao diện như thế này được chưa bạn?

 

Nếu OK ngày mai tôi sẽ cho bạn code hòan thiện

[Phiphi- 176]

Bạn gõ ATTDIA rồi nhập vào 0.

Cái này phải làm duy nhất 1 lần với mỗi file.

Tuyệt quá Bác Hoành, vậy mình có thể insert lệnh này vào LISP luôn đuợc không Bác, máy chạy nhanh thì chắc không ảnh hưởng gì? Cám ơn Bác nhé

[thuphong 18]

Bạn dùng lệnh SBTD, chọn các block rồi nhập vào tỷ lệ 1.

(defun c:sbtd()
 (defun s1(ent)
   (setq tt (entget ent)
  ctl (cdr (assoc 41 tt))
  ctl (abs (/ tl ctl))
  p (cdr (assoc 10 tt))
   )
   (command ".scale" ent "" p ctl)
 )  
 (setq ss (ssget '((0 . "INSERT")))
tl (getreal "\nTy le: "))
 (luuos)
 (setvar "osmode" 0)
 (sudung s1 ss)
 (traos)  
)
(defun luuos ()
 (setq
   HOANH_OSMODE   (getvar "OSMODE")
   HOANH_AUTOSNAP (getvar "AUTOSNAP")
 )
)
(defun traos ()
 (if HOANH_OSMODE
   (setvar "OSMODE" HOANH_OSMODE)
 )
 (if HOANH_AUTOSNAP
   (setvar "AUTOSNAP" HOANH_AUTOSNAP)
 )
)

 

 

Bác Hoành ơi , đoạn Code này sao khi chạy nó báo thiếu hàm SUDUNG, Bác giúp giùm Em với. Thanks Bác nhiều

[ngochoang8681 1]

Bạn có thể post yêu cầu về autolisp ở topic này.

Nhờ các bác chút xíu :

hôm trước có hỏi các bác về vấn đề xuất tọa độ các đỉnh của các đường đồng mức ra file text, trong file text đó thể hiện 4 cột : cột số thứ tự, cột tọa độ X, cột tọa độ y, cột tọa độ Z (cao độ đường đồng mức), mình đã nhận được khá nhiều câu trả lời và các bác cũng đã đưa ra các Lisp, tuy nhiên khi file text xuất ra thì có hiện tượng các tọa độ nằm không đúng vị trí cột của nó, hôm nay mình đưa lên đây 2 file, một là file Lisp mà mình sử dụng để xuất ra file Text, hai là file Text xuất ra (file này bị lỗi như mình trình bày ở trên), mong các bác sửa giúp lỗi này, chứ ngồi nhấn phím TAB hoài chán quá, mấy chục nghìn điểm chứ ít đâu.

link file Text : http://www.cadviet.com/upfiles/XUAT_SO_LIEU.txt

link file Lisp : http://www.cadviet.com/upfiles/Xuat_toa_do_va_cao_do_DDM.lsp

Chân thành cảm ơn mọi người đã quan tâm giúp đỡ.

[tranhoanpvpe 0]

Tôi muốn đánh dấu cao trình cho các cơ trên một mái đào, có cách nào chỉ cần click vào đó là có được cao trình tại vị trí cần đánh dấu đó không?

Rất mong sự giúp đỡ!!!!

[Snowman 92]

Nhờ các bác chút xíu :

hôm trước có hỏi các bác về vấn đề xuất tọa độ các đỉnh của các đường đồng mức ra file text, trong file text đó thể hiện 4 cột : cột số thứ tự, cột tọa độ X, cột tọa độ y, cột tọa độ Z (cao độ đường đồng mức), mình đã nhận được khá nhiều câu trả lời và các bác cũng đã đưa ra các Lisp, tuy nhiên khi file text xuất ra thì có hiện tượng các tọa độ nằm không đúng vị trí cột của nó, hôm nay mình đưa lên đây 2 file, một là file Lisp mà mình sử dụng để xuất ra file Text, hai là file Text xuất ra (file này bị lỗi như mình trình bày ở trên), mong các bác sửa giúp lỗi này, chứ ngồi nhấn phím TAB hoài chán quá, mấy chục nghìn điểm chứ ít đâu.

link file Text : http://www.cadviet.com/upfiles/XUAT_SO_LIEU.txt

link file Lisp : http://www.cadviet.com/upfiles/Xuat_toa_do_va_cao_do_DDM.lsp

Chân thành cảm ơn mọi người đã quan tâm giúp đỡ.

Trùi ạ bạn mất công mất sức nhấn Tab làm gì, file text xuất ra đã có định dạng hàng cột cho bạn rồi đấy thôi (File txt ko thể căn thẳng cột giống như excel đuợc, các text đó đã được định dạng theo cột nhưng chiều dài text ko giống nhau nên bị lệch thôi. Bạn chỉ cần open nó bằng excel thì sẽ thấy hàng cột ngay ngắn mà (file txt trên của bạn đã bị bạn sửa làm hỏng định dạng roài :) Chạy lại đi thôi)

Tôi post luôn lên đây đoạn lisp mới, file xuất ra sẽ có dạng "giả lập excel" :) . Nếu bạn muốn save về file txt thì đổi đuôi về .txt là được. (Tôi sợ bạn dùng làm file số liệu nên trước đây đã để file xuất ra là txt)

;;;=======================================================
;;; Ham nhan list dinh tu Polyline bao gom ca cao do
;;;
(defun Getvpl1 (ename stn / Elist rep e1 dp c)
(setq rep "C"
Elist '()
c stn
)
(setq ename (entnext ename))
(while (/= rep "SEQEND")
(setq e1 (entget ename))
(setq rep (cdr (assoc 0 e1)))
(if (/= rep "VERTEX")
(princ)
(progn
(setq dp (cdr (assoc 42 e1)))
(setq
elist (cons (cons c
(cdr (assoc 10 e1)

)
)
elist
)
)
)
)
;;end if
(setq ename (entnext ename)
c (1+ c)
)
)
;;end while
(setq elist (reverse elist))
;;kthuc
)
;;;=============================================================================

=======
;;; Ham nhan list dinh tu LWPolyline bao gom ca cao do
(defun Getvlw1 (ename stn / di i e1 elist dp c evl)
(setq e1 (entget ename))
(setq elist '()
c 1
c1 stn
evl (cdr (assoc 38 e1))
)
(while e1
(setq di (car e1))
(if (/= 10 (car di))
(princ)
(progn
(setq vlap 1
dp nil
)
(while (and e1 (/= vlap 42))
;;never null
(setq i (car e1))
(setq vlap (car i))
(if (/= vlap 42)
(setq e1 (cdr e1))
(setq dp (cdr i))
)
)
;;end while
(if (null dp)
(alert "Error bulge in the LWPOLYLINE")
;;nerver appear
(setq elist (cons (cons c1 (append (cdr di) (list evl))) elist)
c1 (1+ c1)
)
)
;;end if
)
)
;;end if
(setq e1 (cdr e1)
c (1+ c)
)
)
;;end while
(setq elist (reverse elist))
)

(Defun Intro ()
(prompt "\nCopyright by Nguyen Gia Dat - 0915169886")
)

;;;==================================================================
(defun C:Expl (/ sspl txtfile stt cter count txtline polist pltype)
(command "undo" "begin")
(setvar "cmdecho" 0)
(intro)
(setq sspl (ssget '((-4 . "<OR")
(0 . "Polyline")
(0 . "LWpolyline")
(-4 . "OR>")
)
)
cter 0
stt 1
txtfile '()
)
(while (< cter (sslength sspl))
(setq objpl (ssname sspl cter)
entpl (entget objpl)
pltype (cdr (assoc 0 entpl))
cter (1+ cter)
)
(cond
((= pltype "POLYLINE")
(setq
polist (getvpl1 objpl stt)
stt (+ stt (length polist))
)
)
((= pltype "LWPOLYLINE")
(setq polist (getvlw1 objpl stt)
stt (+ stt (length polist))
)
)

)
(setq txtfile (append txtfile polist))

)



;;; Chon file luu so lieu
(Setq FileDir (getfiled "File luu so lieu:" "" "xls" 1)
)

(setq count1 1
FileID (open FileDir "w")
)
(write-line "B¶ng sè liÖu" FileID)
(write-line
"Stt\tTo¹ ®é X\tTo¹ ®é Y\tTo¹ ®é Z"
FileID
)
(while (<= count1 (length txtfile))
(setq Xid (car (cdr (assoc count1 Txtfile)))
Yid (cadr (cdr (assoc count1 Txtfile)))
Zid (cadr (cdr (cdr (assoc count1 Txtfile))))
Txtline (strcat (itoa count1)
"\t"
(rtos Xid)
"\t"
(rtos Yid)
"\t"
(rtos Zid)
)
count1 (1+ count1)
)
(write-line Txtline FileID)
)
; (write-line Cpright FileID)


(close FileID)


(command "undo" "end")
(setvar "cmdecho" 1)
(princ)
)

[ngochoang8681 1]

Trùi ạ bạn mất công mất sức nhấn Tab làm gì, file text xuất ra đã có định dạng hàng cột cho bạn rồi đấy thôi (File txt ko thể căn thẳng cột giống như excel đuợc, các text đó đã được định dạng theo cột nhưng chiều dài text ko giống nhau nên bị lệch thôi. Bạn chỉ cần open nó bằng excel thì sẽ thấy hàng cột ngay ngắn mà (file txt trên của bạn đã bị bạn sửa làm hỏng định dạng roài :) Chạy lại đi thôi)

Tôi post luôn lên đây đoạn lisp mới, file xuất ra sẽ có dạng "giả lập excel" :) . Nếu bạn muốn save về file txt thì đổi đuôi về .txt là được. (Tôi sợ bạn dùng làm file số liệu nên trước đây đã để file xuất ra là txt)

;;;=======================================================
;;; Ham nhan list dinh tu Polyline bao gom ca cao do
;;;
(defun Getvpl1 (ename stn / Elist rep e1 dp c)
(setq rep "C"
Elist '()
c stn
)
(setq ename (entnext ename))
(while (/= rep "SEQEND")
(setq e1 (entget ename))
(setq rep (cdr (assoc 0 e1)))
(if (/= rep "VERTEX")
(princ)
(progn
(setq dp (cdr (assoc 42 e1)))
(setq
elist (cons (cons c
(cdr (assoc 10 e1)

)
)
elist
)
)
)
)
;;end if
(setq ename (entnext ename)
c (1+ c)
)
)
;;end while
(setq elist (reverse elist))
;;kthuc
)
;;;=============================================================================

=======
;;; Ham nhan list dinh tu LWPolyline bao gom ca cao do
(defun Getvlw1 (ename stn / di i e1 elist dp c evl)
(setq e1 (entget ename))
(setq elist '()
c 1
c1 stn
evl (cdr (assoc 38 e1))
)
(while e1
(setq di (car e1))
(if (/= 10 (car di))
(princ)
(progn
(setq vlap 1
dp nil
)
(while (and e1 (/= vlap 42))
;;never null
(setq i (car e1))
(setq vlap (car i))
(if (/= vlap 42)
(setq e1 (cdr e1))
(setq dp (cdr i))
)
)
;;end while
(if (null dp)
(alert "Error bulge in the LWPOLYLINE")
;;nerver appear
(setq elist (cons (cons c1 (append (cdr di) (list evl))) elist)
c1 (1+ c1)
)
)
;;end if
)
)
;;end if
(setq e1 (cdr e1)
c (1+ c)
)
)
;;end while
(setq elist (reverse elist))
)

(Defun Intro ()
(prompt "\nCopyright by Nguyen Gia Dat - 0915169886")
)

;;;==================================================================
(defun C:Expl (/ sspl txtfile stt cter count txtline polist pltype)
(command "undo" "begin")
(setvar "cmdecho" 0)
(intro)
(setq sspl (ssget '((-4 . "<OR")
(0 . "Polyline")
(0 . "LWpolyline")
(-4 . "OR>")
)
)
cter 0
stt 1
txtfile '()
)
(while (< cter (sslength sspl))
(setq objpl (ssname sspl cter)
entpl (entget objpl)
pltype (cdr (assoc 0 entpl))
cter (1+ cter)
)
(cond
((= pltype "POLYLINE")
(setq
polist (getvpl1 objpl stt)
stt (+ stt (length polist))
)
)
((= pltype "LWPOLYLINE")
(setq polist (getvlw1 objpl stt)
stt (+ stt (length polist))
)
)

)
(setq txtfile (append txtfile polist))

)



;;; Chon file luu so lieu
(Setq FileDir (getfiled "File luu so lieu:" "" "xls" 1)
)

(setq count1 1
FileID (open FileDir "w")
)
(write-line "B¶ng sè liÖu" FileID)
(write-line
"Stt\tTo¹ ®é X\tTo¹ ®é Y\tTo¹ ®é Z"
FileID
)
(while (<= count1 (length txtfile))
(setq Xid (car (cdr (assoc count1 Txtfile)))
Yid (cadr (cdr (assoc count1 Txtfile)))
Zid (cadr (cdr (cdr (assoc count1 Txtfile))))
Txtline (strcat (itoa count1)
"\t"
(rtos Xid)
"\t"
(rtos Yid)
"\t"
(rtos Zid)
)
count1 (1+ count1)
)
(write-line Txtline FileID)
)
; (write-line Cpright FileID)


(close FileID)


(command "undo" "end")
(setvar "cmdecho" 1)
(princ)
)

cám ơn bạn Snowman

nhiều, mình đã làm được như bạn nói, chào bạn.

[dvdcad 1]

Tôi có 1 khó khăn này nhờ bạn giúp.

 

Tôi có 1 bản vẽ trên đó có vẽ 6 hình. Nhờ bác viết cho 1 lisp chọn các hình sau đó ghi số thứ tự lên từng hình và tính tổng số hình ghi ở dưới dòng Command

 

File mẫu:

 

 

 

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

[ph168xd 313]

Tôi đang cần tìm lish vẽ nét cắt thang tầng 2

Tức là 2 nét cắt song song nhau và trim toàn bộ những đối tg nằm giữa chúng

Thanks mọi ng.