Đến nội dung


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

Viết lisp theo yêu cầu [phần 2]


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

#941 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 23 March 2010 - 04:56 PM

các huynh ơi cho hỏi cái này có phải

dùng lisp viết không nhỉ,
http://www.cadviet.c.../2/dat_hang.dwg

dùng cách gì để ghi giống trong bản vẽ này?

Sử dụng lệnh DIMORDINATE
  • 0

#942 sucuph

sucuph

    biết zoom

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

Đã gửi 23 March 2010 - 05:18 PM

cái đó em biết chứ, vẫn không được mà, bác Bình chạy thử hộ em xem
  • 0

#943 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 23 March 2010 - 07:29 PM

cái đó em biết chứ, vẫn không được mà, bác Bình chạy thử hộ em xem

Hề hề hê,
Mình chạy thử rồi, nó đây nè bạn:
Kết quả chạy:
http://www.cadviet.c...files/2/lb2.jpg
Hình đã gửi
Còn đây là cái lisp đã sửa nè:

(defun c:lb2 ()
(vl-load-com)
(command "undo" "be")
(setq en (entsel "\n Chon pline ")
ob (vlax-ename->vla-object (car en))
n (vlax-curve-getEndParam ob)
i 0
li1 (list)
)
(setq pb (getpoint "\n Chon diem dat bang")
h (getreal "\n Nhap chieu cao chu: ")
k (getreal "\n Nhap do rong cot: ")
)
(entmake (list (cons 0 "TEXT") (cons 10 pb) (cons 40 h) (cons 1 "BANG KET QUA")))
(entmake
(list (cons 0 "TEXT") (cons 10 (list (car pb) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "STT")))
(entmake
(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) k) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "X")))
(entmake
(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 2 k)) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "Y")))
(entmake
(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 3 k)) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "Z")))
(while (<= i n)
(setq p (vlax-curve-getPointAtParam ob i)
li1 (append li1 (list p))
y (- (cadr pb) (* (+ 2 i) 1.5 h))
)
(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (+ (cadr p) 5))) (cons 40 1.0)
(cons 1 (strcat "X=" (rtos (car p) 2 2)))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (+ (cadr p) 2.5))) (cons 40 1.0)
(cons 1 (strcat "Y=" (rtos (cadr p) 2 2)))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (cadr p))) (cons 40 1.0)
(cons 1 (strcat "Z=" (rtos (caddr p) 2 2)))))
(entmake
(list (cons 0 "TEXT") (cons 10 (list (car pb) y)) (cons 40 h) (cons 1 (rtos (1+ i) 2 0))))
(entmake
(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) k) y)) (cons 40 h) (cons 1 (rtos (car p ) 2 2))))
(entmake
(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 2 k)) y)) (cons 40 h) (cons 1 (rtos (cadr p ) 2 2))))
(entmake
(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 3 k)) y)) (cons 40 h) (cons 1 (rtos (caddr p) 2 2))))
(setq i (1+ i))
)
(command "undo" "e")
(princ)
)


Hề hề hề, bạn xem xem có giống cái bạn đã sửa không hỉ????
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#944 sucuph

sucuph

    biết zoom

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

Đã gửi 24 March 2010 - 07:51 AM

em chạy được rồi, cảm ơn bác nha!
  • 0

#945 missyoutd01

missyoutd01

    biết pan

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

Đã gửi 24 March 2010 - 08:34 AM

Chào bạn missyoutd01
Trước hết bạn đọc các bài viết trong Topic này nhé :
http://www.cadviet.c...showtopic=15978
Và bạn hãy thực hiện các lệnh trong đó và coi thử bạn có đáp ứng yêu cầu của bạn hay không? Và có gì chưa được thì bạn hãy post vào trong topic đó luôn nhé. . Tue_NV sẽ trả lời bạn ngay chính trong topic đó. OK?

Gợi ý : Yêu cầu của bạn giải quyết bằng 3 lệnh : BEDIT, WIPEOUT và DRAWORDER
Chúc bạn thành công


Cảm ơn bạn Tue_NV mình đã làm được theo cách của bạn 1lần nữa xin cám ơn bạn rất nhiều! :D
  • 0

#946 ngocanh1929@yahoo.com

ngocanh1929@yahoo.com

    Chưa sử dụng CAD

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

Đã gửi 24 March 2010 - 11:38 AM

Sử dụng lệnh DIMORDINATE




Chào bác Tue_NV !Thấy bác ở đây e tiện hỏi. Trước đây hình như em có lần từng đọc bài viết của bác có nội dung : ...làm nổi layer mà bị layer khác đè nên...
Em tìm mấy vòng mà vẫn chưa thấy...A giúp em vụ này nhé
  • 0

#947 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 24 March 2010 - 11:51 AM

em chạy được rồi, cảm ơn bác nha!

Chào bạn Sucuph,
Sau một hồi lần sờ, mình mót được của bác phi-phi cái lisp xuất tọa độ ra file *.txt, *.csv, *.xls. Thế là đem về bổ ra xơi, thấy xơ nhiều nạc ít, giắt răng muốn chết. Vậy nhưng cũng gặm được một chút. Nhờ đó có cái ghép vô với cái lisp lb2.lsp mà mình đã gửi bạn để cho ra được một cô em khá kháu khỉnh.
Bạn thử xài xem nhé:

(defun c:lb2 ()
(vl-load-com)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;
(defun text-draw (txt pnt height rotation justification)
(if (null pnt)(command "_.-TEXT" "" txt)
(if (= (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))
0.0
) ;_ end of =
(progn
(if justification
(command "_.-TEXT" "_J" justification "_none" pnt height rotation txt)
(command "_.-TEXT" "_none" pnt height rotation txt)
) ;_ end of if
) ;_ end of progn
(progn
(if justification
(command "_.-TEXT" "_J" justification "_none" pnt rotation txt)
(command "_.-TEXT" "_none" pnt rotation txt)
) ;_ end of if
) ;_ end of progn
) ;_ end of if
)
(entlast)
);;;;; End of defun text-draw
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun xls ( Data-list header Colhide Name_list / *aplexcel* *books-colection* Currsep
*excell-cells* *new-book* *sheet#1* *sheet-collection* col iz_listo row cell cols)
(defun Letter (N / Res TMP)(setq Res "")(while (> N 0)(setq TMP (rem N 26)
TMP (if (zerop TMP)(setq N (1- N) TMP 26) TMP)
Res (strcat (chr (+ 64 TMP)) Res) N (/ N 26))) Res)
(if (null Name_list)(setq Name_list ""))
(setq *AplExcel* (vlax-get-or-create-object "Excel.Application"))
(if (setq *New-Book* (vlax-get-property *AplExcel* "ActiveWorkbook"))
(setq *Books-Colection* (vlax-get-property *AplExcel* "Workbooks")
*Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
*Sheet#1* (vlax-invoke-method *Sheet-Collection* "Add"))
(setq *Books-Colection* (vlax-get-property *AplExcel* "Workbooks")
*New-Book* (vlax-invoke-method *Books-Colection* "Add")
*Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
*Sheet#1* (vlax-get-property *Sheet-Collection* "Item" 1)))
(setq *excell-cells* (vlax-get-property *Sheet#1* "Cells"))
(setq Name_list (if (= Name_list "")
(vl-filename-base(getvar "DWGNAME"))
(strcat (vl-filename-base(getvar "DWGNAME")) "&" Name_list))
col 0 cols nil)
(if (> (strlen Name_list) 26)
(setq Name_list (strcat (substr Name_list 1 10) "..." (substr Name_list (- (strlen Name_list) 13) 14))))
(vlax-for sh *Sheet-Collection* (setq cols (cons (strcase(vlax-get-property sh 'Name)) cols)))
(setq row Name_list)
(while (member (strcase row) cols)(setq row (strcat Name_list " (" (itoa(setq col (1+ col)))")")))
(setq Name_list row)
(vlax-put-property *Sheet#1* 'Name Name_list)
(setq Currsep (vlax-get-property *AplExcel* "UseSystemSeparators"))
(vlax-put-property *AplExcel* "UseSystemSeparators" :vlax-false)
(vlax-put-property *AplExcel* "DecimalSeparator" ".")
(vlax-put-property *AplExcel* "ThousandsSeparator" " ")
(vla-put-visible *AplExcel* :vlax-true)(setq row 1 col 1)
(if (null header)(setq header '("X" "Y" "Z")))
(repeat (length header)(vlax-put-property *excell-cells* "Item" row col
(vl-princ-to-string (nth (1- col) header)))(setq col (1+ col)))(setq row 2 col 1)
(repeat (length Data-list)(setq iz_listo (car Data-list))(repeat (length iz_listo)
(vlax-put-property *excell-cells* "Item" row col (vl-princ-to-string (car iz_listo)))
(setq iz_listo (cdr iz_listo) col (1+ col)))(setq Data-list (cdr Data-list))(setq col 1 row (1+ row)))
(setq col (1+(length header)) row (1+ row))
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
(strcat "A1:" (letter col)(itoa row))))) ;_ end of setq
(setq cols (vlax-get-property cell 'Columns))
(vlax-invoke-method cols 'Autofit)
(vlax-release-object cols)(vlax-release-object cell)
(foreach item ColHide (if (numberp item)(setq item (letter item)))
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
(strcat item "1:" item "1"))))
(setq cols (vlax-get-property cell 'Columns))
(vlax-put-property cols 'hidden 1)
(vlax-release-object cols)(vlax-release-object cell))
(vlax-put-property *AplExcel* "UseSystemSeparators" Currsep)
(mapcar 'vlax-release-object (list *excell-cells* *Sheet#1* *Sheet-Collection* *New-Book* *Books-Colection*
*AplExcel*))(setq *AplExcel* nil)(gc)(gc)(princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(command "undo" "be")
(setq en (entsel "\n Chon pline ")
ob (vlax-ename->vla-object (car en))
n (vlax-curve-getEndParam ob)
i 0
li1 (list)
)
(setq pb (getpoint "\n Chon diem dat bang")
h (getreal "\n Nhap chieu cao chu: ")
k (getreal "\n Nhap do rong cot: ")
)
(entmake (list (cons 0 "TEXT") (cons 10 pb) (cons 40 h) (cons 1 "BANG KET QUA")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (car pb) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "STT")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car pb) k) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "X")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 2 k)) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1

"Y")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 3 k)) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1

"Z")))
(while (<= i n)
(setq p (vlax-curve-getPointAtParam ob i)
li1 (append li1 (list p))
y (- (cadr pb) (* (+ 2 i) 1.5 h))
)
(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (+ (cadr p) 5))) (cons 40 1.0)
(cons 1 (strcat "X=" (rtos (car p) 2 2)))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (+ (cadr p) 2.5))) (cons 40 1.0)
(cons 1 (strcat "Y=" (rtos (cadr p) 2 2)))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (cadr p))) (cons 40 1.0)
(cons 1 (strcat "Z=" (rtos (caddr p) 2 2)))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (car pb) y)) (cons 40 h) (cons 1 (rtos (1+ i) 2 0))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car pb) k) y)) (cons 40 h) (cons 1 (rtos (car p ) 2 2))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 2 k)) y)) (cons 40 h) (cons 1 (rtos (cadr p ) 2 2))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 3 k)) y)) (cons 40 h) (cons 1 (rtos (caddr p) 2 2))))
(setq i (1+ i))
)
(command "undo" "e")
li1
(command "undo" "be")
(if li1
(progn
(setq li1 (mapcar '(lambda(x)(trans x 0 1)) li1))
(mapcar '(lambda(x) (princ (strcat "\n" (rtos(car x)) "," (rtos(cadr x))
(if (= 3(length x)) (strcat "," (rtos(nth 2 x))) "") ;;; End of if
))) li1);;; end mapcar
(setq Npt (getint"\n Chon so bat dau danh thu tu cac diem : " ))
(initget "Ôàéë Excel Íå Text Excel Not _Text Excel Not Text Excel Not")
(setq sFlag (getkword "\n Ban muon luu toa do vao dang file [Text file/Excel/Not save] : "))
(if (null sFlag)
(setq sFlag "Text")
);;;;; End of if
(setq oFlag Npt)
(if (numberp Npt)
(foreach ln li1
(text-draw
(itoa Npt)
(polar ln (-(/ pi 2)) 2.5)
(setq h 1)
0
nil
) ;;;; End of text-draw
(setq Npt (1+ Npt))
) ;;;; End of foreach
) ;;;; End of if
(setq Npt oFlag)
(setq li1 (mapcar '(lambda(x)(mapcar 'rtos x)) li1))
(cond
(
(and
(= "Text" sFlag)
(setq filPath (getfiled "Save Coordinates to Text File" "Coordinates.txt" "txt;csv" 33))
) ;;; End of and
(setq cFile (open filPath "w"))
(foreach ln li1
(write-line
(strcat (if (numberp Npt)(strcat (itoa Npt) ",") "")(car ln)","(cadr ln) (if (= 3 (length ln)) (strcat ","(nth 2 ln))))
cFile)
(if (numberp Npt)
(setq Npt (1+ Npt))
);;; End of if
);;;; End of foreach
(close cFile)
(initget "Yes No")
(setq oFlag (getkword "\nOpen text file? [Yes/No] : " ))
(if (= oFlag "Yes") (startapp "notepad.exe" filPath))
); end condition #1
((= "Excel" sFlag)
(if (numberp Npt)
(progn
(setq li1 (mapcar '(lambda(x) (cons (1- (setq Npt (1+ Npt))) x)) li1))
(xls li1 '("N" "X" "Y" "Z") nil "COORN")
);;;; End of progn
(xls li1 nil nil "COOR")) ;;;; End of if
); end condition #2
(t nil) ;;; End of last condition
) ;;; End of cond
) ;;; End of progn
) ;;; End of if
(command "undo" "e")
(princ)
)


Cô em này tuy vậy nhưng với mình là khá khó trị, bác nào có nhã hứng thử tìm cách trị cho được theo ý muốn của mình đi nhé.
Cái vụ tự dưng đổi tên cái "Sheet1" thành "VD2-1&Coorn" mình vẫn chưa thể mò ra do cái hàm (xls......) nó rậm rì rắc rối và sâu hun hút, chả biết đâu mà mò. Thôi thì cứ biết khoái đến đó đã vậy.
Cái việc sau khi chạy lisp xong xuất hiện các text đánh số thứ tự của các điểm trên bản vẽ, lúc đầu mình định cắt béng nó đi, nhưng sau nghĩ lại thấy rằng âu cũng là việc cần vì đôi khi có người lại muốn đánh số thứ tự từ .... trên giời thì sao. Nếu không thích ta chỉ việc vô hiệu hóa cái hàm (text-draw .....) là ok.
Cái vụ lisp cứ tự động tắt file *.txt, *.csv sau khi ghi file rồ sau đó lại hỏi có cần mở không thực ra mình cũng thấy hơi nghịch mắt, xong cứ tôn trọng người đã viết ra nó vì có thể có cái lý ông sự ở đó. Tuy nhiên nếu không muốn quá loằng ngoằng như vậy thì các bạn có thể vô hiệu hóa cái đoạn code từ (close cFile) cho tới trước cái ngoặc (;;; end of condition #1)kết thúc điều kiện thứ nhất của hàm (cond .....).
Khi lisp chạy dừng lại để bạn chọn tên file *.txt sẽ lưu dữ liệu, mặc định là file Coordinates.txt nhưng bạn có thể đổi thành file *.txt hay *.csv thoải mái.
Túm lại ở cô em này còn nhiều điều đáng để khám phá. Tuy nhiên phải tùy vào khả năng của mỗi chiến sĩ nhà ta mà cái sự khám phá này cũng như cái sự khoái nó được nhiều hay ít. Với mình thế này là đã khoái rồi dù mới chỉ sơ sơ được một tý bên ngoài. Muốn khoái nữa chắc còn phải tích cóp ít công lực về lisp nữa mới ăn thua các bác ạ.
Chúc cả nhà vui vẻ, hề hề hề ......
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#948 nguyentam1109

nguyentam1109

    biết vẽ circle

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

Đã gửi 24 March 2010 - 06:06 PM

LSP SƯU TẦM.
http://www.cadviet.c...sp_tong_hop.lsp
HƯƠNG DẪN
http://www.cadviet.c.../2/lisp_cad.doc
  • 0

#949 sucuph

sucuph

    biết zoom

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

Đã gửi 25 March 2010 - 07:59 AM

Chào bạn Sucuph,
Sau một hồi lần sờ, mình mót được của bác phi-phi cái lisp xuất tọa độ ra file *.txt, *.csv, *.xls. Thế là đem về bổ ra xơi, thấy xơ nhiều nạc ít, giắt răng muốn chết. Vậy nhưng cũng gặm được một chút. Nhờ đó có cái ghép vô với cái lisp lb2.lsp mà mình đã gửi bạn để cho ra được một cô em khá kháu khỉnh.
Bạn thử xài xem nhé:


(defun c:lb2 ()
(vl-load-com)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;




;;;;;;;;;;;;;;;;;
(defun text-draw (txt pnt height rotation justification)
(if (null pnt)(command "_.-TEXT" "" txt)
(if (= (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))
0.0
) ;_ end of =
(progn
(if justification
(command "_.-TEXT" "_J" justification "_none" pnt height rotation txt)
(command "_.-TEXT" "_none" pnt height rotation txt)
) ;_ end of if
) ;_ end of progn
(progn
(if justification
(command "_.-TEXT" "_J" justification "_none" pnt rotation txt)
(command "_.-TEXT" "_none" pnt rotation txt)
) ;_ end of if
) ;_ end of progn
) ;_ end of if
)
(entlast)
);;;;; End of defun text-draw
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun xls ( Data-list header Colhide Name_list / *aplexcel* *books-colection* Currsep
*excell-cells* *new-book* *sheet#1* *sheet-collection* col iz_listo row cell cols)
(defun Letter (N / Res TMP)(setq Res "")(while (> N 0)(setq TMP (rem N 26)
TMP (if (zerop TMP)(setq N (1- N) TMP 26) TMP)
Res (strcat (chr (+ 64 TMP)) Res) N (/ N 26))) Res)
(if (null Name_list)(setq Name_list ""))
(setq *AplExcel* (vlax-get-or-create-object "Excel.Application"))
(if (setq *New-Book* (vlax-get-property *AplExcel* "ActiveWorkbook"))
(setq *Books-Colection* (vlax-get-property *AplExcel* "Workbooks")
*Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
*Sheet#1* (vlax-invoke-method *Sheet-Collection* "Add"))
(setq *Books-Colection* (vlax-get-property *AplExcel* "Workbooks")
*New-Book* (vlax-invoke-method *Books-Colection* "Add")
*Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
*Sheet#1* (vlax-get-property *Sheet-Collection* "Item" 1)))
(setq *excell-cells* (vlax-get-property *Sheet#1* "Cells"))
(setq Name_list (if (= Name_list "")
(vl-filename-base(getvar "DWGNAME"))
(strcat (vl-filename-base(getvar "DWGNAME")) "&" Name_list))
col 0 cols nil)
(if (> (strlen Name_list) 26)
(setq Name_list (strcat (substr Name_list 1 10) "..."
(substr Name_list (- (strlen Name_list) 13) 14))))
(vlax-for sh *Sheet-Collection* (setq cols (cons (strcase(vlax-get-property sh 'Name)) cols)))
(setq row Name_list)
(while (member (strcase row) cols)(setq row (strcat Name_list " (" (itoa(setq col (1+ col)))")")))
(setq Name_list row)
(vlax-put-property *Sheet#1* 'Name Name_list)
(setq Currsep (vlax-get-property *AplExcel* "UseSystemSeparators"))
(vlax-put-property *AplExcel* "UseSystemSeparators" :vlax-false)
(vlax-put-property *AplExcel* "DecimalSeparator" ".")
(vlax-put-property *AplExcel* "ThousandsSeparator" " ")
(vla-put-visible *AplExcel* :vlax-true)(setq row 1 col 1)
(if (null header)(setq header '("X" "Y" "Z")))
(repeat (length header)(vlax-put-property *excell-cells* "Item" row col
(vl-princ-to-string (nth (1- col) header)))(setq col (1+ col)))(setq row 2 col 1)
(repeat (length Data-list)(setq iz_listo (car Data-list))(repeat (length iz_listo)
(vlax-put-property *excell-cells* "Item" row col (vl-princ-to-string (car iz_listo)))
(setq iz_listo (cdr iz_listo) col (1+ col)))(setq Data-list (cdr Data-list))(setq col 1 row (1+ row)))
(setq col (1+(length header)) row (1+ row))
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
(strcat "A1:" (letter col)(itoa row))))) ;_ end of setq
(setq cols (vlax-get-property cell 'Columns))
(vlax-invoke-method cols 'Autofit)
(vlax-release-object cols)(vlax-release-object cell)
(foreach item ColHide (if (numberp item)(setq item (letter item)))
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
(strcat item "1:" item "1"))))
(setq cols (vlax-get-property cell 'Columns))
(vlax-put-property cols 'hidden 1)
(vlax-release-object cols)(vlax-release-object cell))
(vlax-put-property *AplExcel* "UseSystemSeparators" Currsep)
(mapcar 'vlax-release-object (list *excell-cells* *Sheet#1* *Sheet-Collection*
*New-Book* *Books-Colection**AplExcel*))(setq *AplExcel* nil)(gc)(gc)(princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(command "undo" "be")
(setq en (entsel "\n Chon pline ")
ob (vlax-ename->vla-object (car en))
n (vlax-curve-getEndParam ob)
i 0
li1 (list)
)
(setq pb (getpoint "\n Chon diem dat bang")
h (getreal "\n Nhap chieu cao chu: ")
k (getreal "\n Nhap do rong cot: ")
)
(entmake (list (cons 0 "TEXT") (cons 10 pb) (cons 40 h) (cons 1 "BANG KET QUA")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (car pb) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "STT")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car pb) k) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "X")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 2 k)) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1

"Y")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 3 k)) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1

"Z")))
(while (<= i n)
(setq p (vlax-curve-getPointAtParam ob i)
li1 (append li1 (list p))
y (- (cadr pb) (* (+ 2 i) 1.5 h))
)
(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (+ (cadr p) 5))) (cons 40 1.0)
(cons 1 (strcat "X=" (rtos (car p) 2 2)))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (+ (cadr p) 2.5))) (cons 40 1.0)
(cons 1 (strcat "Y=" (rtos (cadr p) 2 2)))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (cadr p))) (cons 40 1.0)
(cons 1 (strcat "Z=" (rtos (caddr p) 2 2)))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (car pb) y)) (cons 40 h) (cons 1 (rtos (1+ i) 2 0))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car pb) k) y)) (cons 40 h) (cons 1 (rtos (car p ) 2 2))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 2 k)) y)) (cons 40 h) (cons 1 (rtos (cadr p ) 2 2))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 3 k)) y)) (cons 40 h) (cons 1 (rtos (caddr p) 2 2))))
(setq i (1+ i))
)
(command "undo" "e")
li1
(command "undo" "be")
(if li1
(progn
(setq li1 (mapcar '(lambda(x)(trans x 0 1)) li1))
(mapcar '(lambda(x) (princ (strcat "\n" (rtos(car x)) "," (rtos(cadr x))
(if (= 3(length x)) (strcat "," (rtos(nth 2 x))) "") ;;; End of if
))) li1);;; end mapcar
(setq Npt (getint"\n Chon so bat dau danh thu tu cac diem : " ))
(initget "Ôàéë Excel Íå Text Excel Not _Text Excel Not Text Excel Not")
(setq sFlag (getkword "\n Ban muon luu toa do vao dang file [Text file/Excel/Not save] : "))
(if (null sFlag)
(setq sFlag "Text")
);;;;; End of if
(setq oFlag Npt)
(if (numberp Npt)
(foreach ln li1
(text-draw
(itoa Npt)
(polar ln (-(/ pi 2)) 2.5)
(setq h 1)
0
nil
) ;;;; End of text-draw
(setq Npt (1+ Npt))
) ;;;; End of foreach
) ;;;; End of if
(setq Npt oFlag)
(setq li1 (mapcar '(lambda(x)(mapcar 'rtos x)) li1))
(cond
(
(and
(= "Text" sFlag)
(setq filPath (getfiled "Save Coordinates to Text File" "Coordinates.txt" "txt;csv" 33))
) ;;; End of and
(setq cFile (open filPath "w"))
(foreach ln li1
(write-line
(strcat (if (numberp Npt)(strcat (itoa Npt) ",") "")(car ln)","(cadr ln) (if (= 3 (length ln))
(strcat ","(nth 2 ln)))) cFile)
(if (numberp Npt)
(setq Npt (1+ Npt))
);;; End of if
);;;; End of foreach
(close cFile)
(initget "Yes No")
(setq oFlag (getkword "\nOpen text file? [Yes/No] : " ))
(if (= oFlag "Yes") (startapp "notepad.exe" filPath))
); end condition #1
((= "Excel" sFlag)
(if (numberp Npt)
(progn
(setq li1 (mapcar '(lambda(x) (cons (1- (setq Npt (1+ Npt))) x)) li1))
(xls li1 '("N" "X" "Y" "Z") nil "COORN")
);;;; End of progn
(xls li1 nil nil "COOR")) ;;;; End of if
); end condition #2
(t nil) ;;; End of last condition
) ;;; End of cond
) ;;; End of progn
) ;;; End of if
(command "undo" "e")
(princ)
)


Cô em này tuy vậy nhưng với mình là khá khó trị, bác nào có nhã hứng thử tìm cách trị cho được theo ý muốn của mình đi nhé.
Cái vụ tự dưng đổi tên cái "Sheet1" thành "VD2-1&Coorn" mình vẫn chưa thể mò ra do cái hàm (xls......) nó rậm rì rắc rối và sâu hun hút, chả biết đâu mà mò. Thôi thì cứ biết khoái đến đó đã vậy.
Cái việc sau khi chạy lisp xong xuất hiện các text đánh số thứ tự của các điểm trên bản vẽ, lúc đầu mình định cắt béng nó đi, nhưng sau nghĩ lại thấy rằng âu cũng là việc cần vì đôi khi có người lại muốn đánh số thứ tự từ .... trên giời thì sao. Nếu không thích ta chỉ việc vô hiệu hóa cái hàm (text-draw .....) là ok.
Cái vụ lisp cứ tự động tắt file *.txt, *.csv sau khi ghi file rồ sau đó lại hỏi có cần mở không thực ra mình cũng thấy hơi nghịch mắt, xong cứ tôn trọng người đã viết ra nó vì có thể có cái lý ông sự ở đó. Tuy nhiên nếu không muốn quá loằng ngoằng như vậy thì các bạn có thể vô hiệu hóa cái đoạn code từ (close cFile) cho tới trước cái ngoặc (;;; end of condition #1)kết thúc điều kiện thứ nhất của hàm (cond .....).
Khi lisp chạy dừng lại để bạn chọn tên file *.txt sẽ lưu dữ liệu, mặc định là file Coordinates.txt nhưng bạn có thể đổi thành file *.txt hay *.csv thoải mái.
Túm lại ở cô em này còn nhiều điều đáng để khám phá. Tuy nhiên phải tùy vào khả năng của mỗi chiến sĩ nhà ta mà cái sự khám phá này cũng như cái sự khoái nó được nhiều hay ít. Với mình thế này là đã khoái rồi dù mới chỉ sơ sơ được một tý bên ngoài. Muốn khoái nữa chắc còn phải tích cóp ít công lực về lisp nữa mới ăn thua các bác ạ.
Chúc cả nhà vui vẻ, hề hề hề ......

Oài, cái này phức tạp ghê, bác ghép cho em vào cái lisp lb2 đi, em nhìn vào mù tịt chả biết gì, hihi
  • 0

#950 foudremars

foudremars

    biết vẽ arc

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

Đã gửi 25 March 2010 - 10:27 AM

Em đang san nền bằng Lisp ô lưới. Mình phải đo cao độ tự nhiên tại các nút của ô lưới bằng lệnh CDTN trong Nova. Sau đó lấy cao độ đo được nhập tay vào 1 Text đã có sẵn ở gần nút lưới. Các bác có Lisp nào hoặc viết hộ em 1 Lisp mà sau khi đo CDTN, Pick vào 1 Text thì nó sẽ thay nội dung của Text đó bằng cao độ vừa đo được. (Nó gần giống như Lisp đo diện tích). Cảm ơn các bác rất nhiều!
  • 0

#951 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 25 March 2010 - 10:31 AM

Oài, cái này phức tạp ghê, bác ghép cho em vào cái lisp lb2 đi, em nhìn vào mù tịt chả biết gì, hihi

Chào bạn Sucuph,
Cái lisp mình gửi là đã ghép rồi đấy mà. Bạn cứ việc xài thử thôi. Lệnh vẫn giữ nguyên là lb2 thôi mà.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#952 huyhoa255

huyhoa255

    biết zoom

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

Đã gửi 25 March 2010 - 10:47 AM

Đây là phần tiếp theo của topic Viết lisp theo yêu cầu, mời các bạn tiếp tục thảo luận.

Chào các bác ! ,các bác có thể viết cho em 1 cái lisp để edit như thế này ko a ? e có 1 bản vẽ cốt thép bị lỗi như sau : 1 loại thép số hiệu 10 phi 32a200 , nhưng cũng với thép số hiệu là 10 nhưng có chỗ là phi20a200 hoặc phi 32a150 . Bây giờ e muốn sửa tất cả thép số hiệu 10 là phi32a200 , mong bác cứu e với !

Bài viết đã được chỉnh sửa nội dung bởi huyhoa255: 25 March 2010 - 10:49 AM

  • 0

#953 sucuph

sucuph

    biết zoom

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

Đã gửi 25 March 2010 - 11:15 AM

Chào bạn Sucuph,
Cái lisp mình gửi là đã ghép rồi đấy mà. Bạn cứ việc xài thử thôi. Lệnh vẫn giữ nguyên là lb2 thôi mà.

em load lisp thì báo bị lỗi, bác kiểm tra lại rồi post lại lên hộ em nha! thanks bác!
  • 0

#954 sucuph

sucuph

    biết zoom

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

Đã gửi 25 March 2010 - 11:16 AM

Chào các bác ! ,các bác có thể viết cho em 1 cái lisp để edit như thế này ko a ? e có 1 bản vẽ cốt thép bị lỗi như sau : 1 loại thép số hiệu 10 phi 32a200 , nhưng cũng với thép số hiệu là 10 nhưng có chỗ là phi20a200 hoặc phi 32a150 . Bây giờ e muốn sửa tất cả thép số hiệu 10 là phi32a200 , mong bác cứu e với !

Cái này mình nghĩ dùng lệnh Find để Replace được mà!!
  • 0

#955 huyhoa255

huyhoa255

    biết zoom

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

Đã gửi 25 March 2010 - 11:30 AM

Cái này mình nghĩ dùng lệnh Find để Replace được mà!!

nhưng e chỉ muốn thay đổi chỉ với thép có số hiệu là 10 thôi , làm như thế nó sẽ đổi tất cả . Mong các bác giúp e !
  • 0

#956 hoaletrang

hoaletrang

    biết vẽ line

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

Đã gửi 25 March 2010 - 12:42 PM

Bạn nên nói rõ hoặc gửi file lên vì không biết bạn chú thích thép như thế nào, giữa ký hiệu thép và chú thích thép có mối quan hệ gì với nhau. Nếu ký hiệu thép và chú thích thép là 1 đối tượng thì có thể giải quyết tự động được.
Cũng có thể làm thủ công bằng cách sử dụng lệnh Replace sau đó chọn các đối tượng cần thay thế.
  • 0

#957 huyhoa255

huyhoa255

    biết zoom

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

Đã gửi 25 March 2010 - 01:06 PM

Bạn nên nói rõ hoặc gửi file lên vì không biết bạn chú thích thép như thế nào, giữa ký hiệu thép và chú thích thép có mối quan hệ gì với nhau. Nếu ký hiệu thép và chú thích thép là 1 đối tượng thì có thể giải quyết tự động được.
Cũng có thể làm thủ công bằng cách sử dụng lệnh Replace sau đó chọn các đối tượng cần thay thế.

Cám ơn bạn đã chỉ dẫn giúp mình . Số hiệu thép , đường kính thép và khoảng cách là 3 đối tượng riêng biệt . Mình có dùng lệnh quick select thì mới chỉ tìm được vị trí chú thích loại thép có số hiệu là 10 , nhưng ko biết làm thế nào có thể edit nhanh đường kính và khoảng cách thép đó được . Đây là file của mình .
http://www.cadviet.c...cau_ra_thap.rar
  • 0

#958 hoaletrang

hoaletrang

    biết vẽ line

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

Đã gửi 25 March 2010 - 01:27 PM

Không download được file của bạn nhưng tôi có thể gợi ý thế này:
Tìm tất cả các đối tượng (Text, MText, khối có thuộc tính) thể hiện số hiệu thép (tùy theo đối tượng định nghĩa) có giá trị là 10, tìm điểm chèn của đối tượng đó, khoanh vùng giới hạn thể hiện đường kính và khoảng cách tương ứng, tìm các đối tượng thể hiện đường kính và khoảng cách nằm trong vùng xác định rồi tiến hành hiệu chỉnh.
Cụ tỉ thì không thể nói được vì bạn trình bày chưa cụ tỉ và cái file của bạn lại không download được.
Đã download được rồi nhưng hơi ngán.
Bạn bê cả hồ sơ Up lên đây, bắt mọi người nghiên cứu thì không nên, hãy trích 1 phần bản vẽ up lên để tiết kiệm thời gian và dung lượng lưu trữ cũng như chi phí Net.
Vấn đề bạn đạt ra hoàn toàn có thể giải quyết được như đã nói ở trên, vấn đề là thời gian.
Nói thêm với bạn: Không biết bản vẽ này do bạn vẽ hay copy về, nhưng thể hiện như thế sẽ rất khó quản lý.
  • 0

#959 huyhoa255

huyhoa255

    biết zoom

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

Đã gửi 25 March 2010 - 01:40 PM

Không download được file của bạn nhưng tôi có thể gợi ý thế này:
Tìm tất cả các đối tượng (Text, MText, khối có thuộc tính) thể hiện số hiệu thép (tùy theo đối tượng định nghĩa) có giá trị là 10, tìm điểm chèn của đối tượng đó, khoanh vùng giới hạn thể hiện đường kính và khoảng cách tương ứng, tìm các đối tượng thể hiện đường kính và khoảng cách nằm trong vùng xác định rồi tiến hành hiệu chỉnh.
Cụ tỉ thì không thể nói được vì bạn trình bày chưa cụ tỉ và cái file của bạn lại không download được.

Thanks bạn đã giúp mình ! cách này mình cũng đã dùng nhưng như thế vẫn làm lâu quá bạn ạ , bạn có biết cái lisp nào thay thế giúp mình với . mình up lại cái file của mình .
http://www.cadviet.c...u_ra_thap_1.rar
  • 0

#960 hoaletrang

hoaletrang

    biết vẽ line

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

Đã gửi 25 March 2010 - 02:01 PM

Chắc là không có lisp nào ăn ngay được đâu bạn ạ, vì còn tùy thuộc vào từng trường hợp và yêu cầu cụ thể nữa.
  • 0