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

#921 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 21 March 2010 - 12:16 PM

Tue_NV có mấy lời góp ý với Lisp của bác PhamThanhBinh :
1. Kết quả Lisp sẽ chạy sai khi chiều cao của style hiện hành khác 0 trong hộp thoại Style. Muốn Lisp chạy đúng cho mọi trường hợp thì phải thiết lập chiều cao của style hiện hành bằng 0
Cách khác hay hơn là bác thiết lập việc ghi chữ bằng hàm entmake

2. Việc sử dụng hàm (ssget "X") khiến cho toàn bộ Block trên bản vẽ mang tên bln "đi vào" bảng thống kê. Có thể bỏ chữ "X" trong hàm (ssget)

3. Thay vì "nhập đúng cái tên của block và tên layer chứa block" -> bác nên cho mã lệnh pick chọn 1 block mẫu -> ta lấy tên Block chọn theo Block mẫu này
Hơn nữa, việc dùng hàm (getstring "\n Nhap ten block: ") là chưa đúng lắm. Vì tên block có thể có khoảng trắng nhưng nếu bác dùng hàm như trên thì nhập không có khoảng trắng bác ạ.

Vài lời góp ý. Chúc bác cuối tuần vui vẻ.

-Nhìn vào hình vẽ mà bác đã upload cho bạn Ngolevietduc87 thì rõ ràng là bác đã cài đặt DWGgateway thì sao lại không mở được file của các Version CAD nhỉ?

Chào bác Tue_NV,
Rất cám ơn những sự đóng góp của bác. Mình sẽ sửa lại. Riêng việc bỏ tham số "X" của hàm ssget thì mình thấy không cần thiết do bạn Ngolevietduc87 yêu cầu là "tất cả các block trong bản vẽ" . Nếu bỏ tham số này đi thì user sẽ phải chọn các block theo các phương pháp lựa chọn của CAD.
Cái vụ DWGgateway mình cũng chả biết tại sao???Cài nó khá lâu rồi nhưng hiệu quả thì chả thấy gì. Khổ thế. Nếu bác biết thì chỉ giùm mình với.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#922 sucuph

sucuph

    biết zoom

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

Đã gửi 22 March 2010 - 02:23 PM

Em muốn nhờ các bác hộ em 1 cái lisp mà khi pick vào 1 đường pline thì sẽ hiện tất cả toạ độ các điểm lên bản vẽ, đồng thời xuất ra 1 file txt. Mong các bác giúp cho, thanks!!!
  • 0

#923 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 22 March 2010 - 03:50 PM

Sau khi tham khảo các bài hướng dẫn của bác SSG, mình thử liều viết bổ sung vào cái lisp lb1.lsp viết cho bạn Ngolevietduc87 để có thể xuất dữ liệu vào một file excel. Vì đây là thử nghiệm lần đầu tiên nên rất mong các bác xem qua và góp ý nhé. Nó đây ạ:

(defun c:lb1 ()
(vl-load-com)
(defun GetExcel (ExcelFile$ SheetName$ MaxRange$ / Column# ColumnRow@ Data@ ExcelRange^
ExcelValue ExcelValue ExcelVariant^ MaxColumn# MaxRow# Range$ Row# Worksheet)
(if (= (type ExcelFile$) 'STR)
(if (not (findfile ExcelFile$))
(progn
(alert (strcat "Excel file " ExcelFile$ " not found."))
(exit)
);progn
);if
(progn
(alert "Excel file not specified.")
(exit)
);progn
);if
(gc)
(if (setq *ExcelApp% (vlax-get-object "Excel.Application"))
(progn
(alert "Close all Excel spreadsheets to continue!")
(vlax-release-object *ExcelApp%)(gc)
);progn
);if
(setq *ExcelApp% (vlax-get-or-create-object "Excel.Application"))
(vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Open ExcelFile$)
(if SheetName$
(vlax-for Worksheet (vlax-get-property *ExcelApp% "Sheets")
(if (= (vlax-get-property Worksheet "Name") SheetName$)
(vlax-invoke-method Worksheet "Activate")
);if
);vlax-for
);if
(setq ColumnRow@ (ColumnRow MaxRange$))
(setq MaxColumn# (nth 0 ColumnRow@))
(setq MaxRow# (nth 1 ColumnRow@))
(setq *ExcelData@ nil)
(setq Row# 1)
(repeat MaxRow#
(setq Data@ nil)
(setq Column# 1)
(repeat MaxColumn#
(setq Range$ (strcat (Number2Alpha Column#)(itoa Row#)))
(setq ExcelRange^ (vlax-get-property *ExcelApp% "Range" Range$))
(setq ExcelVariant^ (vlax-get-property ExcelRange^ 'Value))
(setq ExcelValue (vlax-variant-value ExcelVariant^))
(setq ExcelValue
(cond
((= (type ExcelValue) 'INT) (itoa ExcelValue))
((= (type ExcelValue) 'REAL) (rtosr ExcelValue))
((= (type ExcelValue) 'STR) (vl-string-trim " " ExcelValue))
((/= (type ExcelValue) 'STR) "")
);cond
);setq
(setq Data@ (append Data@ (list ExcelValue)))
(setq Column# (1+ Column#))
);repeat
(setq *ExcelData@ (append *ExcelData@ (list Data@)))
(setq Row# (1+ Row#))
);repeat
(vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook") 'Close :vlax-False)
(vlax-invoke-method *ExcelApp% 'Quit)
(vlax-release-object *ExcelApp%)(gc)
(setq *ExcelApp% nil)
*ExcelData@
);defun GetExcel
;-------------------------------------------------------------------------------
; GetCell - Returns the cell value from the *ExcelData@ list
; Arguments: 1
; Cell$ = Cell ID
; Syntax example: (GetCell "E19") = value of cell E19
;-------------------------------------------------------------------------------
(defun GetCell (Cell$ / Column# ColumnRow@ Return Row#)
(setq ColumnRow@ (ColumnRow Cell$))
(setq Column# (1- (nth 0 ColumnRow@)))
(setq Row# (1- (nth 1 ColumnRow@)))
(setq Return "")
(if *ExcelData@
(if (and (>= (length *ExcelData@) Row#)(>= (length (nth 0 *ExcelData@)) Column#))
(setq Return (nth Column# (nth Row# *ExcelData@)))
);if
);if
Return
);defun GetCell
;-------------------------------------------------------------------------------
; OpenExcel - Opens an Excel spreadsheet
; Arguments: 3
; ExcelFile$ = Excel filename or nil for new spreadsheet
; SheetName$ = Sheet name or nil for not specified
; Visible = t for visible or nil for hidden
; Syntax examples:
; (OpenExcel "C:\\Temp\\Temp.xls" "Sheet2" t) = Opens C:\Temp\Temp.xls on Sheet2 as visible session
; (OpenExcel "C:\\Temp\\Temp.xls" nil nil) = Opens C:\Temp\Temp.xls on current sheet as hidden session
; (OpenExcel nil "Parts List" nil) = Opens a new spreadsheet and creates a Part List sheet as hidden

session
;-------------------------------------------------------------------------------
(defun OpenExcel (ExcelFile$ SheetName$ Visible / Sheet$ Sheets@ Worksheet)
(if (= (type ExcelFile$) 'STR)
(if (findfile ExcelFile$)
(setq *ExcelFile$ ExcelFile$)
(progn
(alert (strcat "Excel file " ExcelFile$ " not found."))
(exit)
);progn
);if
(setq *ExcelFile$ "")
);if
(gc)
(if (setq *ExcelApp% (vlax-get-object "Excel.Application"))
(progn
(alert "Close all Excel spreadsheets to continue!")
(vlax-release-object *ExcelApp%)(gc)
);progn
);if
(setq *ExcelApp% (vlax-get-or-create-object "Excel.Application"))
(if ExcelFile$
(if (findfile ExcelFile$)
(vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Open ExcelFile$)
(vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Add)
);if
(vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Add)
);if
(if Visible
(vla-put-visible *ExcelApp% :vlax-true)
);if
(if (= (type SheetName$) 'STR)
(progn
(vlax-for Sheet$ (vlax-get-property *ExcelApp% "Sheets")
(setq Sheets@ (append Sheets@ (list (vlax-get-property Sheet$ "Name"))))
);vlax-for
(if (member SheetName$ Sheets@)
(vlax-for Worksheet (vlax-get-property *ExcelApp% "Sheets")
(if (= (vlax-get-property Worksheet "Name") SheetName$)
(vlax-invoke-method Worksheet "Activate")
);if
);vlax-for
(vlax-put-property (vlax-invoke-method (vlax-get-property *ExcelApp% "Sheets") "Add") "Name" SheetName$)
);if
);progn
);if
(princ)
);defun OpenExcel
;-------------------------------------------------------------------------------
; PutCell - Put values into Excel cells
; Arguments: 2
; StartCell$ = Starting Cell ID
; Data@ = Value or list of values
; Syntax examples:
; (PutCell "A1" "PART NUMBER") = Puts PART NUMBER in cell A1
; (PutCell "B3" '("Dim" 7.5 "9.75")) = Starting with cell B3 put Dim, 7.5, and 9.75 across
;-------------------------------------------------------------------------------
(defun PutCell (StartCell$ Data@ / Cell$ Column# ExcelRange Row#)
(if (= (type Data@) 'STR)
(setq Data@ (list Data@))
)
(setq ExcelRange (vlax-get-property *ExcelApp% "Cells"))
(if (Cell-p StartCell$)
(setq Column# (car (ColumnRow StartCell$))
Row# (cadr (ColumnRow StartCell$))
);setq
(if (vl-catch-all-error-p
(setq Cell$ (vl-catch-all-apply 'vlax-get-property
(list (vlax-get-property *ExcelApp% "ActiveSheet") "Range" StartCell$))
);setq
);vl-catch-all-error-p
(alert (strcat "The cell ID \"" StartCell$ "\" is invalid."))
(setq Column# (vlax-get-property Cell$ "Column")
Row# (vlax-get-property Cell$ "Row")
);setq
);if
);if
(if (and Column# Row#)
(foreach Item Data@
(vlax-put-property ExcelRange "Item" Row# Column# (vl-princ-to-string Item))
(setq Column# (1+ Column#))
);foreach
);if
(princ)
);defun PutCell
;-------------------------------------------------------------------------------
; CloseExcel - Closes Excel spreadsheet
; Arguments: 1
; ExcelFile$ = Excel saveas filename or nil to close without saving
; Syntax examples:
; (CloseExcel "C:\\Temp\\Temp.xls") = Saveas C:\Temp\Temp.xls and close
; (CloseExcel nil) = Close without saving
;-------------------------------------------------------------------------------
(defun CloseExcel (ExcelFile$ / Saveas)
(if ExcelFile$
(if (= (strcase ExcelFile$) (strcase *ExcelFile$))
(if (findfile ExcelFile$)
(vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook") "Save")
(setq Saveas t)
);if
(if (findfile ExcelFile$)
(progn
(vl-file-delete (findfile ExcelFile$))
(setq Saveas t)
);progn
(setq Saveas t)
);if
);if
);if
(if Saveas
(vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook")
"SaveAs" ExcelFile$ -4143 "" "" :vlax-false :vlax-false nil
);vlax-invoke-method
);if
(vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook") 'Close :vlax-False)
(vlax-invoke-method *ExcelApp% 'Quit)
(vlax-release-object *ExcelApp%)(gc)
(setq *ExcelApp% nil *ExcelFile$ nil)
(princ)
);defun CloseExcel
;-------------------------------------------------------------------------------
; ColumnRow - Returns a list of the Column and Row number
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
; Cell$ = Cell ID
; Syntax example: (ColumnRow "ABC987") = '(731 987)
;-------------------------------------------------------------------------------
(defun ColumnRow (Cell$ / Column$ Char$ Row#)
(setq Column$ "")
(while (< 64 (ascii (setq Char$ (strcase (substr Cell$ 1 1)))) 91)
(setq Column$ (strcat Column$ Char$)
Cell$ (substr Cell$ 2)
);setq
);while
(if (and (/= Column$ "") (numberp (setq Row# (read Cell$))))
(list (Alpha2Number Column$) Row#)
'(1 1);default to "A1" if there's a problem
);if
);defun ColumnRow
;-------------------------------------------------------------------------------
; Alpha2Number - Converts Alpha string into Number
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
; Str$ = String to convert
; Syntax example: (Alpha2Number "ABC") = 731
;-------------------------------------------------------------------------------
(defun Alpha2Number (Str$ / Num#)
(if (= 0 (setq Num# (strlen Str$)))
0
(+ (* (- (ascii (strcase (substr Str$ 1 1))) 64) (expt 26 (1- Num#)))
(Alpha2Number (substr Str$ 2))
);+
);if
);defun Alpha2Number
;-------------------------------------------------------------------------------
; Number2Alpha - Converts Number into Alpha string
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
; Num# = Number to convert
; Syntax example: (Number2Alpha 731) = "ABC"
;-------------------------------------------------------------------------------
(defun Number2Alpha (Num# / Val#)
(if (< Num# 27)
(chr (+ 64 Num#))
(if (= 0 (setq Val# (rem Num# 26)))
(strcat (Number2Alpha (1- (/ Num# 26))) "Z")
(strcat (Number2Alpha (/ Num# 26)) (chr (+ 64 Val#)))
);if
);if
);defun Number2Alpha
;-------------------------------------------------------------------------------
; Cell-p - Evaluates if the argument Cell$ is a valid cell ID
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
; Cell$ = String of the cell ID to evaluate
; Syntax examples: (Cell-p "B12") = t, (Cell-p "BT") = nil
;-------------------------------------------------------------------------------
(defun Cell-p (Cell$)
(and (= (type Cell$) 'STR)
(or (= (strcase Cell$) "A1")
(not (equal (ColumnRow Cell$) '(1 1)))
);or
);and
);defun Cell-p
;-------------------------------------------------------------------------------
; Row+n - Returns the cell ID located a number of rows from cell
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 2
; Cell$ = Starting cell ID
; Num# = Number of rows from cell
; Syntax examples: (Row+n "B12" 3) = "B15", (Row+n "B12" -3) = "B9"
;-------------------------------------------------------------------------------
(defun Row+n (Cell$ Num#)
(setq Cell$ (ColumnRow Cell$))
(strcat (Number2Alpha (car Cell$)) (itoa (max 1 (+ (cadr Cell$) Num#))))
);defun Row+n
;-------------------------------------------------------------------------------
; Column+n - Returns the cell ID located a number of columns from cell
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 2
; Cell$ = Starting cell ID
; Num# = Number of columns from cell
; Syntax examples: (Column+n "B12" 3) = "E12", (Column+n "B12" -1) = "A12"
;-------------------------------------------------------------------------------
(defun Column+n (Cell$ Num#)
(setq Cell$ (ColumnRow Cell$))
(strcat (Number2Alpha (max 1 (+ (car Cell$) Num#))) (itoa (cadr Cell$)))
);defun Column+n
;-------------------------------------------------------------------------------
; rtosr - Used to change a real number into a short real number string
; stripping off all trailing 0's.
; Arguments: 1
; RealNum~ = Real number to convert to a short string real number
; Returns: ShortReal$ the short string real number value of the real number.
;-------------------------------------------------------------------------------
(defun rtosr (RealNum~ / DimZin# ShortReal$)
(setq DimZin# (getvar "DIMZIN"))
(setvar "DIMZIN" 8)
(setq ShortReal$ (rtos RealNum~ 2 8))
(setvar "DIMZIN" DimZin#)
ShortReal$
);defun rtosr
;-------------------------------------------------------------------------------
(princ);End of GetExcel.lsp
;--------------------------------------------------------------------------------
(command "undo" "be")
(setq li1 (list)
blk (entsel "\n Hay chon block mau")
bln (cdr (assoc 2 (entget (car blk))))
lan (cdr (assoc 8 (entget (car blk))))
ss (ssget "x" (list ( cons 0 "INSERT") (cons 2 bln) (cons 8 lan)))
n (sslength ss)
i 0
)
(if (/= n nil)
(progn
(while (< i n)
(setq li1 (append li1 (list (cdr (assoc 10 (entget (ssname ss i))))))
i (1+ i))
)
)
)
li1
(setq en (car (entsel "\n Chon duong chuan"))
li2 (list)
ob (vlax-ename->vla-object en)
)
(foreach p li1
(setq p0 (vlax-curve-getClosestPointTo ob p acExtendNone)
d (distance p p0)
li2 (append li2 (list d))
)
)
(setq pb (getpoint "\n Chon diem nhap bang ket qua")
h (getreal "\n Nhap chieu cao chu: ")
k (getreal "\ Nhap do rong cot: ")
)
(entmake (list (cons 0 "TEXT") (cons 10 pb) (cons 40 h) (cons 1 "BANG KET QUA")))
;;;;(command "text" pb h 0 "BANG KET QUA")
(entmake (list (cons 0 "TEXT") (cons 10 (list (car pb) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "STT")))
;;;(command "text" (list (car pb) (- (cadr pb) (* 1.5 h))) h 0 "STT")
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car pb) k) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "X")))
;;;(command "text" (list (+ (car pb) k) (- (cadr pb) (* 1.5 h))) h 0 "X")
(entmake
(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 2 k)) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "Y")))
;;;(command "text" (list (+ (car pb) (* 2 k)) (- (cadr pb) (* 1.5 h))) h 0 "Y")
(entmake
(list
(cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 3 k)) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "Khoang cach")))
;;;(command "text" (list (+ (car pb) (* 3 k)) (- (cadr pb) (* 1.5 h))) h 0 "Khoang cach")
(setq fn (getfiled "Select Excel File" "" "xls" 0))
(openexcel fn nil T)
(putcell "A1" (list "BANG KET QUA"))
(putcell "A2" (list "STT" "X" "Y" "Khoang cach"))
(setq a 0)
(while (< a n)
(setq b (nth a li1)
y (- (cadr pb) (* (+ 2 a) 1.5 h))
)
(entmake (list (cons 0 "TEXT") (cons 10 (list (car pb) y)) (cons 40 h) (cons 1 (rtos (1+ a) 2 0))))
;;;(command "text" (list (car pb) y) h 0 (rtos (1+ a) 2 0))
(entmake
(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) k) y)) (cons 40 h) (cons 1 (rtos (car b ) 2 2))))
;;;(command "text" (list (+ (car pb) k) y) h 0 (rtos (car b ) 2 2))
(entmake
(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 2 k)) y)) (cons 40 h) (cons 1 (rtos (cadr b ) 2 2))))
;;;(command "text" (list (+ (car pb) (* 2 k)) y) h 0 (rtos (cadr b ) 2 2))
(entmake
(list
(cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 3 k)) y)) (cons 40 h) (cons 1 (rtos (nth a li2) 2 2))))
;;;(command "text" (list (+ (car pb) (* 3 k)) y) h 0 (rtos (nth a li2) 2 2))
(putcell (strcat "A" (rtos (+ 3 a) 2 0))
(list (rtos (1+ a) 2 0) (rtos (car b ) 2 2) (rtos (cadr b ) 2 2) (rtos (nth a li2) 2 2)))
(setq a (1+ a))
)
(command "undo" "e")
(princ)
)


Lưu ý khi sử dụng: Phải tạo trước một file excel trống với tên tùy ý rồi thoát khỏi Excel. Khi chạy lisp sẽ hiển thị bảng lựa chọn file để mở, browse dến tên file vừa lập và clickOk
Lisp sẽ tự động lập bảng kết quả cả trên bản vẽ và cả trên sheet hiện hành của file excel.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#924 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 22 March 2010 - 04:10 PM

Em muốn nhờ các bác hộ em 1 cái lisp mà khi pick vào 1 đường pline thì sẽ hiện tất cả toạ độ các điểm lên bản vẽ, đồng thời xuất ra 1 file txt. Mong các bác giúp cho, thanks!!!

Hề hề hề, chào bạn sucuph,
Bạn phải cho biết rõ cái pline của bạn là "LWPOLYLINE" hay "POLYLINE" thì mới viết lisp được bạn nhé.
Bởi vì mỗi loại đối tượng sẽ có một phương pháp riêng để lấy tọa độ các đỉnh bạn ạ.
Hề hề hề, hoặc là bạn gửi một cái bản vẽ mẫu thể hiện các yêu cầu của bạn. Nhớ gửi bản vẽ ở dạng CAD2000 hay CAD2004 bạn nhé.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#925 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 22 March 2010 - 05:24 PM

Em muốn nhờ các bác hộ em 1 cái lisp mà khi pick vào 1 đường pline thì sẽ hiện tất cả toạ độ các điểm lên bản vẽ, đồng thời xuất ra 1 file txt. Mong các bác giúp cho, thanks!!!

Chào bạn Sucuph,
Bạn xài thử lisp này xem sao nhé. Mình chạy thử với LWPOLYLINE thì Ok, nhưng chưa thử với POLYLINE.

(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 (rtos (car p) 2 2) " " (rtos (cadr p) 2 2) " " (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)
)


Nếu có gì chưa ổn hãy post lên nhé. Hề hề 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.

#926 sucuph

sucuph

    biết zoom

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

Đã gửi 22 March 2010 - 07:30 PM

Cảm ơn bác Bình rất nhiều, em đã chạy thử lisp bác viết cho, chạy ổn cả, nhưng vẫn chưa đúng mục đích của em lắm. Mục đích của em là khi pick vào đường PL đó thì sẽ in được toạ độ x=.., y=..., z=... lên bản vẽ tại chính vị trí point đó và đồng thời xuất dữ liệu ra file txt. Em nhờ các bác giúp cho, em đang rất cần. Em đang có một đường PL khoảng 600 point mà không có các bác giúp chắc em chết!!! Thanks các bác nhiều!!!
  • 0

#927 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 22 March 2010 - 09:05 PM

Cảm ơn bác Bình rất nhiều, em đã chạy thử lisp bác viết cho, chạy ổn cả, nhưng vẫn chưa đúng mục đích của em lắm. Mục đích của em là khi pick vào đường PL đó thì sẽ in được toạ độ x=.., y=..., z=... lên bản vẽ tại chính vị trí point đó và đồng thời xuất dữ liệu ra file txt. Em nhờ các bác giúp cho, em đang rất cần. Em đang có một đường PL khoảng 600 point mà không có các bác giúp chắc em chết!!! Thanks các bác nhiều!!!

Chào sucuph
Có thể rằng sucuph đang rất cần Code Lisp trên nhưng sucuph không có quyền được post 1 chủ đề của sucuph
ở 2 nơi như thế. Ở bên này, sucuph đã mở ra topic với nội dung trên và bạn hoaletrang đã viết bài trả lời cho sucuph
http://www.cadviet.c...amp;#entry90218

CẢNH CÁO THÀNH VIÊN

Nếu ai cũng tuỳ tiện như vậy, tính tổ chức của diễn đàn sẽ bị phá vỡ. Khi ai đó muốn tìm hiểu về một vấn đề nào đó, cũng như các vấn đề khác có liên quan sẽ không thuận tiện vì chúng nằm rải rác khắp nơi. Trong khi các quản trị viên cố gắng sắp xếp, thu gom các bài viết có nội dung tương tự nhau về cùng một topic thì bạn làm ngược lại!

Bạn đừng nghĩ rằng post lung tung ở nhiều nơi sẽ có nhiều người quan tâm giúp bạn. Đúng là có nhiều người quan tâm thật, nhưng những người "quan tâm đặc biệt" chính các admin và mod! Thật tình chúng tôi không muốn, nhưng buộc phải làm cái việc bất đắc dĩ là del tất cả các bài của bạn có trùng nội dung như đã nói trên.

Bạn hãy cân nhắc kỹ, vấn đề bạn nêu nên ở chỗ nào là hợp lý nhất và có thể post lại, nhưng chỉ duy nhất ở chỗ ấy thôi. Nếu lâu quá không thấy reply, bạn có thể nhắc lại ngay trong topic đó. Tuyệt đối không được mở thêm topic mới cho cùng vấn đề trên. Ngoài ra, cũng xin lưu ý với bạn rằng, nêu vấn đề là quyền của bạn, nhưng có nhận được reply hay không là quyền của nhiều members khác. Lý do có thể rất nhiều: vấn đề khó quá, vấn đề không phổ biến đối với đa số, vấn đề đã được đề cập và giải quyết rồi, người ta đang bận v.v... và cũng có thể là do chính bạn diễn đạt chưa rõ ràng.


Cảm ơn bạn Tue_Vn và bạn Thanhbinh, bạn Tue đã làm đúng theo ý mình rồi, vậy bạn có thể chỉ cho mình cách nào để làm được như thế không? còn theo cách của Thanhbinh thì mình đã thử rồi ( mình dùng Draw Order rồi nhưng vẫn không được. Xin các cao thủ chỉ giáo giúp. Thanks

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

#928 hoanganhqa

hoanganhqa

    Chưa sử dụng CAD

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

Đã gửi 22 March 2010 - 09:57 PM

Chào mọi người hôm nay đọc mấy cái líp của các bạn thấy hấp dẫn ghê,nhưng tôi chưa biết cách sử dụng các bạn có thể chỉ giùm không
Cảm ơn nhiều!
  • 0

#929 svba1608

svba1608

    Tưởng Thị Tú Khuyên

  • Moderator
  • PipPipPipPipPipPipPip
  • 601 Bài viết
Điểm đánh giá: 620 (tốt)

Đã gửi 22 March 2010 - 10:37 PM

Chào mọi người hôm nay đọc mấy cái líp của các bạn thấy hấp dẫn ghê,nhưng tôi chưa biết cách sử dụng các bạn có thể chỉ giùm không
Cảm ơn nhiều!

Hướng dẫn sử dụng mã Lisp
  • 0
http://khuyen.space

#930 bosstuyentn

bosstuyentn

    biết vẽ line

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

Đã gửi 23 March 2010 - 09:19 AM

Em cần các huynh viết hộ cái lisp như trong hình. Làm sao khi em muốn vẽ các hình dạng ống, em chỉ cần vẽ đuờng line truớc làm trục tâm ống, rùi nhập bán kính hình tròn trong hình tròn ngoài rùi tự động nó uốn theo đuờng line em vẽ lúc đầu. Đối với ống dạng đa giác cũng tuơng tự, sau khi vẽ đuờng line hay pline làm tâm. Nhập chiều các cạnh hình trong, rùi hình ngoài, kết quả là nó uốn theo đuờng tâm line lúc đầu. MOng các bác giúp em với. Em làm thủ công vừa tay to vừa lâu
Hình đã gửi
  • 0
Tiền không phải là tất cả nhưng ko có tiền chả làm được cái gì hết...

WinPower -Thiết bị ngành điện, trạm điện, an ninh, PCCC
Hình đã gửi

#931 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 23 March 2010 - 09:23 AM

Cảm ơn anh Thiệp và anh Tue_NV! Nhờ sự giúp đỡ của các anh, em đã hoàn thành được rồi.
Nay em lại có một việc khác muốn nhờ.

Hình đã gửi

Như trên hình minh hoạ, em cần đánh dấu chiều chảy vào các ống của các lưu vực.
Ví dụ như ô số 23 và 32, cần vẽ các mũi tên hướng từ tâm ra phía đường ống cho toàn bộ các ô trong bản vẽ (để thể hiện chiều chảy của nước).
Nhờ các anh giúp đỡ! Em xin chân thành cảm ơn!
File minh hoạ
http://www.cadviet.c...files/2/d_1.dwg

Chào svba1608, Lisp này sẽ giúp cho svba1608 thêm mũi tên tạo dốc nước chảy. Tuy nhiên để cho lisp chạy 1 cách đầy đủ không bỏ sót thì các đường bao "ranh thửa" phải là đường kín (closed). Để biết 1 pline có closed hay không hãy pick chúng và xem cửa sổ property tại mục closed nó báo YES hay NO nếu NO thì chỉnh lại YES. Ngoài ra, vì chiễu mũi tên sẽ hướng từ điểm dóng của text ra đến điểm gần nhất của pline đường bao, nên các text A, B, C, D.. phải nằm gần đường ống hơn.
;| Lisp tao leader arrow tu text trong
LWPOLYLINE ra bien LWPOLYLINE
Yeu cau: - LWPOLYLINE phai kin(closed)
- Express tools phai duoc cai dat
Copyright by thiep 03/2010|;
;;;======================
(defun dxf (code ent)
(cdr (assoc code (entget ent)))
)
;;;;;;;;;;;;;;;;;;;;;;;;;
(defun SAVE_MODE ()
(setq OLD_OSMODE (getvar "OSMODE")
OLD_ORTHOMODE (getvar "ORTHOMODE")
)
(setvar "cmdecho" 0)
(setvar "OSMODE" 0)
)
(defun RESTORE ()
(setvar "osmode" OLD_OSMODE)
(setvar "ORTHOMODE" OLD_ORTHOMODE)
)
(defun leader (pt1 pt2 tsi / el entle )
(setq el
(list
(cons 0 "LEADER")
(cons 100 "AcDbEntity")
(cons 100 "AcDbLeader")
(cons 10 pt1)
(cons 10 pt2)
) ;_ list
) ;_ setq
(entmake el)
(setq entle (entlast)
objle (vlax-ename->vla-object entle)
)
(vla-put-ArrowheadType objle acArrowOpen30)
(vla-put-ArrowheadSize objle tsi)
)

;;;------------------
(defun zoomObj (OBcur / lop upp)
(vla-getboundingbox OBcur 'minp 'maxp)
(setq lop (vlax-safearray->list minp)
upp (vlax-safearray->list maxp)
)
(vla-zoomwindow (vlax-get-acad-object) minp maxp)
)
;|===========================================================
MAIN LISP
===========================================================|;
(defun c:sva (/ lstent lsttextt tsi lstent lstpoCP
lstenttext p1 p2 p3 p4 objLwp
objle entle ss lstLWP2 po ang dis
strso lstpo en n
)
(or ActDoc
(setq ActDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(or *Model* (setq *Model* (vla-get-ModelSpace ActDoc)))
(vla-StartUndoMark ActDoc)
(SAVE_MODE)
(setq ss (ssget '((0 . "LWPOLYLINE")
(8 . "vh")
)
)
lstent (acet-ss-to-list ss)
)
;;;---------------------------------------------
(foreach entlwp lstent
(setq objlwp (vlax-ename->vla-object entlwp)
lstpoCP (ACET-LIST-REMOVE-DUPLICATES
(ACET-GEOM-VERTEX-LIST entlwp)
0
)
)
(zoomObj objlwp)
(if (or (vlax-curve-isClosed entlwp)
(< (distance (car lstpoCP) (last lstpoCP)) 0.1)
)
(progn
(setq ss (ssget "CP"
lstpoCP
'((0 . "TEXT") (8 . "sttkhu"))
)
)
(if ss
(progn
(setq lstenttext (acet-ss-to-list ss))
(foreach ent lstenttext
(or tsi (setq tsi (dxf 40 ent)))
(if (null (distof (dxf 1 ent)))
(progn
(setq p1 (vlax-get (vlax-ename->vla-object ent) 'TextAlignmentPoint)
p2 (vlax-curve-getClosestPointTo entlwp p1)
ang (angle p1 p2)
p3 (polar p1 ang (* tsi 1.2))
dis (distance p2 p3)

)
(if (>= dis (* 2 tsi))
(progn
(leader p2 p3 tsi)
)
(progn
(setq p3 (polar p2 (- ang pi) (* tsi 2.1)))
(leader p2 p3 tsi)
(setq entle (entlast)
ss (acet-list-to-ss (list entle))
)
(setq
p4 (acet-ss-drag-move
ss
p2
"\nMove Arrow to : "
1
)
)
(vla-move objle
(vlax-3d-point p2)
(vlax-3d-point p4)
)
)
)
)
)
)
)
(alert "khong co text nao!!!")
)
)
); end if
)
(RESTORE)
(vla-EndUndoMark ActDoc)
(princ "\nThank you for use my lisp: svb_Arrow.lsp!")
(princ)
)

  • 1

#932 aliosa

aliosa

    biết vẽ polygon

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

Đã gửi 23 March 2010 - 11:07 AM

Sau khi tham khảo các bài hướng dẫn của bác SSG, mình thử liều viết bổ sung vào cái lisp lb1.lsp viết cho bạn Ngolevietduc87 để có thể xuất dữ liệu vào một file excel. Vì đây là thử nghiệm lần đầu tiên nên rất mong các bác xem qua và góp ý nhé. Nó đây ạ:
Lưu ý khi sử dụng: Phải tạo trước một file excel trống với tên tùy ý rồi thoát khỏi Excel. Khi chạy lisp sẽ hiển thị bảng lựa chọn file để mở, browse dến tên file vừa lập và clickOk
Lisp sẽ tự động lập bảng kết quả cả trên bản vẽ và cả trên sheet hiện hành của file excel.


Bạn "PhamthanhBinh" viết lisp này rất hay rùi. Thực chất đây có lẽ là bài cắm cọc GPMB hoặc cắm Mốc lộ giới của tuyến đường.
Việc chuyển số liệu sang file excel theo mình nghĩ đơn giảm hơn chỉ cần ghi ra file dang .CSV là ổn rồi, như thế mình sẽ không phải khai báo file excel trước. Xuất ngay sang Excel cũng tốt nhưng hơi phức tạp một chút.
Xin nhờ các bạn giúp bổ sung thêm bài toán một chút nũa cho bài toán được hoàn chỉnh:
- Cho điểm đầu của polyline một giá trị (Lý trình đầu) bằng cách hỏi lý trình ở dòng lệnh
- Xác định lý trình tương ứng của các cọc giải phóng mặt bằng và ghi bổ sung thêm một lý trình sau cột stt.
Ví dụ:
- Cho điểm đầu tiên của polyline giá trị 100
- Lý trình của cọc đầu tiên là 123.75 (=100+23.75)
File minh họa: http://www.cadviet.c...es/2/vidu_3.dwg
Cảm ơn các bạn về bài toán!
  • 0

#933 svba1608

svba1608

    Tưởng Thị Tú Khuyên

  • Moderator
  • PipPipPipPipPipPipPip
  • 601 Bài viết
Điểm đánh giá: 620 (tốt)

Đã gửi 23 March 2010 - 11:21 AM

Chào svba1608, Lisp này sẽ giúp cho svba1608 thêm mũi tên tạo dốc nước chảy. Tuy nhiên để cho lisp chạy 1 cách đầy đủ không bỏ sót thì các đường bao "ranh thửa" phải là đường kín (closed). Để biết 1 pline có closed hay không hãy pick chúng và xem cửa sổ property tại mục closed nó báo YES hay NO nếu NO thì chỉnh lại YES. Ngoài ra, vì chiễu mũi tên sẽ hướng từ điểm dóng của text ra đến điểm gần nhất của pline đường bao, nên các text A, B, C, D.. phải nằm gần đường ống hơn.

Cảm ơn anh Thiệp và anh Tuệ nhiều! (Anh Tue_NV cũng viết giùm em một lisp nhưng không hiểu vì sao chưa thấy post lên để cho em được cảm ơn :D )
Em đã dùng lisp anh Thiệp viết cho em thì thấy lisp chạy tốt, tuy nhiên thỉnh thoảng nó lại hỏi: "Move arrow to", em không hiểu vì sao.
Về yêu cầu các text phải nằm gần đường ống hơn thì em không thực hiện được vì em phải viết các thông số khác trên đường ống, bao gồm 6 thông số: chiều dài, lưu lượng, đường kính, độ dốc, vận tốc, tổn thất. 3 thông số bên trên và 3 thông số bên dưới, nếu để các text gần đường ống sẽ che mất các thông số cần viết.
Chào anh! Cảm ơn anh rất nhiều!
  • 0
http://khuyen.space

#934 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

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

Cảm ơn bác Bình rất nhiều, em đã chạy thử lisp bác viết cho, chạy ổn cả, nhưng vẫn chưa đúng mục đích của em lắm. Mục đích của em là khi pick vào đường PL đó thì sẽ in được toạ độ x=.., y=..., z=... lên bản vẽ tại chính vị trí point đó và đồng thời xuất dữ liệu ra file txt. Em nhờ các bác giúp cho, em đang rất cần. Em đang có một đường PL khoảng 600 point mà không có các bác giúp chắc em chết!!! Thanks các bác nhiều!!!

Hề hề hề, chào bạn sucuph,
Việc này không khó chỉ cần bạn thêm vào đoạn code:
(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (+ (cadr p) 5))) (cons 40 1.0)
(cons 1 (strcat (rtos (car p) 2 2) " " (rtos (cadr p) 2 2) " " (rtos (caddr p) 2 2)))))
các mã như sau:
"X=" phía trước (rtos (car p) 2 2)
"Y=" phía trước (rtos (cadr p) 2 2)
"Z=" phía trước (rtos (caddr p) 2 2)
và các dấu "," vào trong các khoảng trắng
để thành:
(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) ", " "Y=" (rtos (cadr p) 2 2) ", " "Z=" (rtos (caddr p) 2 2)))))
là Ok thôi mà.
Bạn hãy thử xem nhé. Hề hề hề........
Còn việc xuất dữ liệu ra file text mình chưa hiểu rõ ý bạn lắm, bạn có thể đưa ra cái nội dung file text của bạn muốn có được không???? File text bạn muốn là ở dạng file gì??? txt, doc, csv.....???
Cái bảng kết quả nếu bạn thấy không cần thiết có thể vô hiệu hóa các dòng code tạo bảng đi bằng các đưa vào phía trước nó các dấu ";" bạn ạ.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#935 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 23 March 2010 - 12:26 PM

Cảm ơn anh Thiệp và anh Tuệ nhiều! (Anh Tue_NV cũng viết giùm em một lisp nhưng không hiểu vì sao chưa thấy post lên để cho em được cảm ơn :cheers: )
Em đã dùng lisp anh Thiệp viết cho em thì thấy lisp chạy tốt, tuy nhiên thỉnh thoảng nó lại hỏi: "Move arrow to", em không hiểu vì sao.
Về yêu cầu các text phải nằm gần đường ống hơn thì em không thực hiện được vì em phải viết các thông số khác trên đường ống, bao gồm 6 thông số: chiều dài, lưu lượng, đường kính, độ dốc, vận tốc, tổn thất. 3 thông số bên trên và 3 thông số bên dưới, nếu để các text gần đường ống sẽ che mất các thông số cần viết.
Chào anh! Cảm ơn anh rất nhiều!

Chào svba,
- "Move arrow to" là vì có những chỗ vị trí từ tâm của text đến đường bao quá ngắn nên lisp yêu cầu người dùng di dời mũi tên đến chỗ nào khác ấy mà! Máy tính nó cũng thông minh đấy chứ!.
- Nếu không dịch text vào ra 1 chút gần đường ống thì mũi tên đôi khi nó chỉ sang hướng khác mất!. Đôi khi máy tính nó cũng ngu ghê! :D
  • 2

#936 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 - 03:35 PM

cảm ơn bác Bình lần nữa nha, em chạy ổn cả rồi, còn việc xuất ra file text nhờ bác hộ em cho ra file txt hoặc xls với 4 cột như bác đã làm, STT, X, Y, Z. Em về lisp thì mù tịt nên mong các bác thông cảm rồi dần dần em sẽ học hỏi thêm. À nhân tiện nhờ bác chỉnh hộ em toạ độ tại mỗi point thành 3 dòng text x=..., y=..., z=... cho nó đẹp.
  • 0

#937 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

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

cảm ơn bác Bình lần nữa nha, em chạy ổn cả rồi, còn việc xuất ra file text nhờ bác hộ em cho ra file txt hoặc xls với 4 cột như bác đã làm, STT, X, Y, Z. Em về lisp thì mù tịt nên mong các bác thông cảm rồi dần dần em sẽ học hỏi thêm. À nhân tiện nhờ bác chỉnh hộ em toạ độ tại mỗi point thành 3 dòng text x=..., y=..., z=... cho nó đẹp.

Chào bạn Sucuph,
Để chuyển thành "3 dòng text cho nó đẹp bạn hãy làm như sau:
Thay thế đoạn code:
(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) ", " "Y=" (rtos (cadr p) 2 2) ", " "Z=" (rtos (caddr p) 2 2)))))
Bằng 3 đoạn code sau:
(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)))))
Vậy là OK bạn ạ.
Còn việc xuất các kết quả này ra file *.txt hay file *.xls bạn phải chờ một chút vì mình vẫn chưa thành thục lắm bạn ạ. Mới đang thử lần mò thôi, phải vừa làm vừa dò nên không nhanh được, Mong bạn thông cảm.
Chúc bạn vui.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#938 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 - 04:25 PM

sao em thử không được bác Bình ơi, kết quả vẫn như lisp trước

(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 (rtos (car p) 2 2) " " (rtos (cadr p) 2 2) " " (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))
)
(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)))))
(command "undo" "e")
(princ)
)
  • 0

#939 thanhliemvqh

thanhliemvqh

    biết pan

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

Đã gửi 23 March 2010 - 04:42 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?
  • 0

#940 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

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

sao em thử không được bác Bình ơi, kết quả vẫn như lisp trước

(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 (rtos (car p) 2 2) " " (rtos (cadr p) 2 2) " " (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))
)
(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)))))
(command "undo" "e")
(princ)
)

Hề hề hề,
Tại bạn quên cái mình hướng dẫn đấy mà. Mình bảo thay thế đoạn code ..... bằng 3 đoạn code sau, chứ có phải là thêm nó vào dưới đâu. Hề hề hề....
Việc bạn thêm nó vào cuối chỉ có tác dụng cho cái điểm cuối cùng thôi vì lúc này vòng lặp While đã thoát lisp chỉ còn nhớ mỗi điểm p cuối cùng mà thôi. Hề hề hề.
Bạn làm lại đi nha.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.