Đến nội dung


Hình ảnh
- - - - -

[Nhờ chỉnh sửa] Lisp xuất cao độ tại cọc


  • Please log in to reply
3 replies to this topic

#1 thanhlamct

thanhlamct

    biết lệnh offset

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

Đã gửi 11 November 2011 - 01:15 PM

Chào cả nhà, lisp này là của 1 tác giả trên diễn đàn, trước mình có yêu cầu và được tác giả đó viết.
Nói chung lisp này chạy rất tốt, mục đích của lisp XCD là xuất cao độ địa hình tại cọc (là các bock có tên là coc)
Nhưng nay mình muốn thêm tính năng xuất tọa độ (điểm chèn Block) cạnh cột cao độ.
Do trình độ hiểu biết còn hạn chế nên không sửa được, xin nhờ các cao thủ sửa dùm với.
Lisp và file địa hình download dưới đây:
file cad đia hình:
http://www.mediafire...lt24l9ai0grjp7z
lisp xcd:
http://www.mediafire...sht3v5qsyw0vzmu
  • 0

#2 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 11 November 2011 - 04:19 PM

Chào cả nhà, lisp này là của 1 tác giả trên diễn đàn, trước mình có yêu cầu và được tác giả đó viết. Nói chung lisp này chạy rất tốt, mục đích của lisp XCD là xuất cao độ địa hình tại cọc (là các bock có tên là coc) Nhưng nay mình muốn thêm tính năng xuất tọa độ (điểm chèn Block) cạnh cột cao độ. Do trình độ hiểu biết còn hạn chế nên không sửa được, xin nhờ các cao thủ sửa dùm với. Lisp và file địa hình download dưới đây: file cad đia hình: http://www.mediafire...lt24l9ai0grjp7z lisp xcd: http://www.mediafire...sht3v5qsyw0vzmu

Hề hề hề,
Bạn cần nói rõ việc xuất tọa độ này là xuất ra sao? Xuất nguyên cụm tọa độ bao gồm cả x,y,z vào một cột hay xuất thành 3 cột là cột x cột y, cột z.
Đây là cái mình thử sửa để bạn có thể xuất thành 3 cột tọa độ riêng biệt x,y,z theo đúng với tọa độ hiện hành của CAD. Nếu bạn muốn xuất thành một cột thì phải sử dụng thêm hàm ghép các text tọa độ lại với nhau. bạn hãy thử xem nhé và có gì thì post lên do mình chưa có thời gian test lại.

; Chuong trình l?y c?t m?t d?t t?i các c?c tính toán
(defun c:xcd (/ input xuly output data val)
(defun input (/ text_loc sset stt docao block sslen i entn entg dxf la p blname)
(defun text_loc (entn / p entg text jum72 jum73 i loc ketqua)
(setq p '())
(setq entg (entget entn))
(setq text (cdr (assoc 0 entg)))
(if (= text "TEXT")
(progn
(setq jum72 (cdr (assoc 72 entg)))
(setq jum73 (cdr (assoc 73 entg)))
(cond
((= jum72 1) (setq i 11))
((= jum72 2) (setq i 11))
((= jum72 4) (setq i 11))
((= jum72 3) (setq i 10))
((= jum72 5) (setq i 10))
((= jum72 0)
(progn
(if (= jum73 0)
(setq i 10)
(setq i 11)
)
)
)
)
(setq loc (cdr (assoc i entg)))
(setq p loc)
)
)
(setq ketqua p)
)
;;; ----------mainsub----------
(alert
"\nChuong trinh xuat CAO DO mat dat tai coc tinh toan.
\nBan phai dat ten Layer va Block nhu sau:
\nLayer: \"STT\" la so thu tu coc, \"Do cao\" la do cao mat dat
\nBlock: Dat ten la \"Coc\""
)
(setq sset (ssget))
(setq stt '()
docao '()
block '()
sslen (sslength sset)
i 0
)

(if sset
(progn
(repeat sslen
(setq entn (ssname sset i))
(setq entg (entget entn))
(setq dxf (cdr (assoc 0 entg)))
(cond
((= dxf "TEXT")
(progn
(setq la (strcase (cdr (assoc 8 entg))))
(cond
((= la "STT") (setq p (text_loc entn) p (subst 0 (nth 2 p) p)
stt (append stt (list (list (cdr (assoc 1 entg)) p)))
))
((= la "DO CAO") (setq p (text_loc entn) p (subst 0 (nth 2 p) p)
docao (append docao (list (list (cdr (assoc 1 entg)) p)))
))
)
))
((= dxf "INSERT")
(progn
(setq blname (strcase (cdr (assoc 2 entg))))
(if (= blname "COC")
(setq p (cdr (assoc 10 entg)) p (subst 0 (nth 2 p) p)
block (append block (list p))
)
)
))
)
(setq i (+ i 1))
)
)
)
(list stt docao block)
)
;;; -------------end input--------------
(defun xuly (data / stt docao block len i n kqbl pbl j mss line txt p d kq kqtt linett ptt linebl caodo)
(setq stt (nth 0 data)
docao (nth 1 data)
block (nth 2 data)
)
(if (and stt docao block)
(progn
(setq len (length block) i 0 n (length docao) kqbl '() )
(repeat len
(setq pbl (nth i block))
(setq j 0)
(setq mss 2000000000)
(repeat n
(setq line (nth j docao)
txt (nth 0 line)
p (nth 1 line)
d (distance pbl p)
)
(if (< d mss)
(setq mss d kq (list txt pbl) )
)
(setq j (+ j 1))
)
(setq kqbl (append kqbl (list kq)))
(setq i (+ i 1))
)
(setq len (length stt) i 0 n (length kqbl) kqtt '() )
(repeat len
(setq linett (nth i stt) tt (nth 0 linett) ptt (nth 1 linett) j 0
n (length kqbl) mss 2000000000 )
(repeat n
(setq linebl (nth j kqbl) caodo (nth 0 linebl) pbl (nth 1 linebl) j (+ j 1) d (distance ptt pbl) )
(if (< d mss)
(setq mss d kq (list tt caodo (rtos (car pbl) 2 2) (rtos (cadr pbl) 2 2) (rtos (caddr pbl) 2 2) (atof tt)) )
)
)
(setq kqtt (append kqtt (list kq)))
(setq i (+ i 1))
)
(setq kqtt (vl-sort kqtt (function (lambda (e1 e2) (< (nth 5 e1) (nth 5 e2))))))
)
)
kqtt
)
;;; -------------end xuly --------------
(defun output (val / path fn f n i line lines)
(if val
(progn
(setq path (getvar "dwgprefix"))
(setq fn
(getfiled "Select a Lisp File" path "xls;txt;dat;sl;kq;elv" 1)
)
(if fn
(progn
(setq f (open fn "w"))
(setq n (length val)
i 0
)
(repeat n
(setq line (nth i val)
lines (strcat (nth 0 line) "\t" (nth 1 line) "\t" (nth 2 line) "\t" (nth 3 line) "\t" (nth 4 line))
i (+ i 1)
)
(write-line lines f)
)
(close f)
)
)
(alert (strcat "Xem k&#213;t qu&#182; trong file: " fn))
)
)
)
;;; --------------------MAIN------------------
(setq data (input))
(setq val (xuly data))
(output val)
)
Hy vọng đúng ý bạn.
Chúc bạn vui.
  • 3
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3 thanhlamct

thanhlamct

    biết lệnh offset

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

Đã gửi 11 November 2011 - 09:14 PM

Cảm ơn bác Bình, rất đúng ý ah, xin lỗi bác vì không nói rõ.
Không biết lisp này có thể cải thiện tốc độ không bác vì nếu có 1000 cái Block thì đợi xuất ra file cũng hơi lâu bác ah.
  • 0

#4 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5450 Bài viết
Điểm đánh giá: 2625 (tuyệt vời)

Đã gửi 11 November 2011 - 10:18 PM

Hề hề hề,
Bạn cần nói rõ việc xuất tọa độ này là xuất ra sao? Xuất nguyên cụm tọa độ bao gồm cả x,y,z vào một cột hay xuất thành 3 cột là cột x cột y, cột z.
Đây là cái mình thử sửa để bạn có thể xuất thành 3 cột tọa độ riêng biệt x,y,z theo đúng với tọa độ hiện hành của CAD. Nếu bạn muốn xuất thành một cột thì phải sử dụng thêm hàm ghép các text tọa độ lại với nhau. bạn hãy thử xem nhé và có gì thì post lên do mình chưa có thời gian test lại.
...
Hy vọng đúng ý bạn.
Chúc bạn vui.

Hơi vô duyên tí. Mặc dầu tôi không chuyên ngành nhưng phải vỗ tay vì sự thịnh tình của bác 3 Hề. Nếu CAdViet mà có nhiều người như bác 3 Hề thì tuyệt quá nhỉ
  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.