Đến nội dung


Hình ảnh
* * * - - 2 Bình chọn

Viết Lisp theo yêu cầu


  • Chủ đề bị khóa Chủ đề bị khóa
2780 replies to this topic

#1081 thangkho

thangkho

    biết vẽ line

  • Members
  • PipPip
  • 26 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 10 September 2008 - 05:20 PM

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
  • 0

#1082 Snowman

Snowman

    biết lệnh mirror

  • Members
  • PipPipPip
  • 155 Bài viết
Điểm đánh giá: 90 (tàm tạm)

Đã gửi 10 September 2008 - 06:17 PM

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
  • 0

. - ' * ' - .. - ... "Sống trong đời sống cần có một tấm lòng..." . - ' * ' - .. -
-----------------------------------------------------------------------------------

Hình đã gửi Hình đã gửi


#1083 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1359 (rất tốt)

Đã gửi 11 September 2008 - 10:30 AM

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

  • 1

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#1084 vndesperados

vndesperados

    biết lệnh xref

  • Members
  • PipPipPipPipPipPipPip
  • 547 Bài viết
Điểm đánh giá: 253 (khá)

Đã gửi 11 September 2008 - 10:39 AM

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'
  • 0

#1085 nataca

nataca

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 712 Bài viết
Điểm đánh giá: 553 (tốt)

Đã gửi 11 September 2008 - 10:59 AM

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
  • 0

#1086 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1359 (rất tốt)

Đã gửi 11 September 2008 - 11:03 AM

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. :)
  • 0

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#1087 ungdaive

ungdaive

    Chưa sử dụng CAD

  • Members
  • Pip
  • 1 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 11 September 2008 - 10:31 PM

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)
  • 0

#1088 ssg

ssg

    biết lệnh adcenter

  • Vip
  • PipPipPipPipPipPipPip
  • 1228 Bài viết
Điểm đánh giá: 1087 (rất tốt)

Đã gửi 12 September 2008 - 10:59 AM

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)
)
)
;;;-------------------------------------------------------------------------------

  • 0

#1089 thangkho

thangkho

    biết vẽ line

  • Members
  • PipPip
  • 26 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 12 September 2008 - 11:42 AM

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?
  • 0

#1090 Phiphi-

Phiphi-

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 434 Bài viết
Điểm đánh giá: 175 (tàm tạm)

Đã gửi 12 September 2008 - 11:50 AM

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.c...pfiles/bvdo.zip
File LISP: http://www.cadviet.c...les/XD_11_9.lsp
Thanks you very nhiều
  • 0

#1091 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 4106 Bài viết
Điểm đánh giá: 4495 (đỉnh cao)

Đã gửi 12 September 2008 - 12:59 PM

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.
  • 1

#1092 vndesperados

vndesperados

    biết lệnh xref

  • Members
  • PipPipPipPipPipPipPip
  • 547 Bài viết
Điểm đánh giá: 253 (khá)

Đã gửi 12 September 2008 - 01:08 PM

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?



Hình đã gửi


(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
  • 0

#1093 Phiphi-

Phiphi-

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 434 Bài viết
Điểm đánh giá: 175 (tàm tạm)

Đã gửi 12 September 2008 - 01:35 PM

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é
  • 0

#1094 thuphong

thuphong

    biết vẽ circle

  • Members
  • PipPip
  • 34 Bài viết
Điểm đánh giá: 18 (tàm tạm)

Đã gửi 12 September 2008 - 04:22 PM

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
  • 0

#1095 ngochoang8681

ngochoang8681

    Chưa sử dụng CAD

  • Members
  • Pip
  • 4 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 12 September 2008 - 05:09 PM

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.c...UAT_SO_LIEU.txt
link file Lisp : http://www.cadviet.c..._cao_do_DDM.lsp
Chân thành cảm ơn mọi người đã quan tâm giúp đỡ.
  • 0

#1096 tranhoanpvpe

tranhoanpvpe

    Chưa sử dụng CAD

  • Members
  • Pip
  • 2 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 12 September 2008 - 05:27 PM

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 đỡ!!!!
  • 0

#1097 Snowman

Snowman

    biết lệnh mirror

  • Members
  • PipPipPip
  • 155 Bài viết
Điểm đánh giá: 90 (tàm tạm)

Đã gửi 12 September 2008 - 06:27 PM

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.c...UAT_SO_LIEU.txt
link file Lisp : http://www.cadviet.c..._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)
)

  • 0

. - ' * ' - .. - ... "Sống trong đời sống cần có một tấm lòng..." . - ' * ' - .. -
-----------------------------------------------------------------------------------

Hình đã gửi Hình đã gửi


#1098 ngochoang8681

ngochoang8681

    Chưa sử dụng CAD

  • Members
  • Pip
  • 4 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 13 September 2008 - 10:06 AM

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.
  • 0

#1099 dvdcad

dvdcad

    biết vẽ arc

  • Members
  • PipPip
  • 44 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 15 September 2008 - 03:30 AM

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.c...Drawing1_12.dwg
  • 0

#1100 ph168xd

ph168xd

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 779 Bài viết
Điểm đánh giá: 309 (khá)

Đã gửi 15 September 2008 - 06:17 PM

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.
  • 0