[ Yêu cầu ] Nhờ chỉnh lisp xác định lý trình - cách tim

[hoacomay70 4]

Em tìm được trên diễn đàn lisp này rất hay của bác hochoaivandot. Lisp này pick chọn Pline (là đường tim tuyến) và một điểm nằm ngoài, lisp xuất ra trên màn hình cad lý trình và cách tim của điểm đó, em làm giải phóng mặt bằng rất cần dùng. Em muốn nhờ các bác chỉnh giúp em để lisp có thể xuất ra cả tọa độ X,Y của điểm chọn nữa, và tất cả lý trình, cách tim, tọa độ X Y được xuất ra file excel được không ạ. 

Em xin cảm ơn.

http://www.cadviet.com/upfiles/3/125447_ttt.lsp

[phamthanhbinh 3146]

Em tìm được trên diễn đàn lisp này rất hay của bác hochoaivandot. Lisp này pick chọn Pline (là đường tim tuyến) và một điểm nằm ngoài, lisp xuất ra trên màn hình cad lý trình và cách tim của điểm đó, em làm giải phóng mặt bằng rất cần dùng. Em muốn nhờ các bác chỉnh giúp em để lisp có thể xuất ra cả tọa độ X,Y của điểm chọn nữa, và tất cả lý trình, cách tim, tọa độ X Y được xuất ra file excel được không ạ. 

Em xin cảm ơn.

http://www.cadviet.com/upfiles/3/125447_ttt.lsp

Hề hề hề,

Chuyện muốn xuất thì chả khó, nhưng xuất như thế nào và xuất vào đâu thì bạn phải mô tả rõ và có file ví dụ kèm theo mới được. Không có ý kiến thống nhất của bạn thì chả ai có thể viết đượic cả, nếu có chỉ là viết bừa xuất bậy mà thôi. Bạn nên tìm hiểu kỹ về quy định khi post các yêu cầu về lisp....

[hoacomay70 4]

Hề hề hề,

Chuyện muốn xuất thì chả khó, nhưng xuất như thế nào và xuất vào đâu thì bạn phải mô tả rõ và có file ví dụ kèm theo mới được. Không có ý kiến thống nhất của bạn thì chả ai có thể viết đượic cả, nếu có chỉ là viết bừa xuất bậy mà thôi. Bạn nên tìm hiểu kỹ về quy định khi post các yêu cầu về lisp....

Cảm ơn bác đã góp ý. em xin gửi theo đây bảng cel ví dụ mà em muốn xuất, bác xem qua giúp em vớihttp://www.cadviet.com/upfiles/3/125447_file.rar

[phamthanhbinh 3146]

Cảm ơn bác đã góp ý. em xin gửi theo đây bảng cel ví dụ mà em muốn xuất, bác xem qua giúp em vớihttp://www.cadviet.com/upfiles/3/125447_file.rar

Hề hề hề,

Xuất theo kiểu đó thì mình bất lực rồi.....

Tại sao lại không có thứ tự điểm???

Tại sao lý trình lại cần tới hai cột A và B ??? Như vậy phải nhúng hai cột này làm một thì kiến thức về lisp của mình chư đủ xài.

Còn các cột khác thì mình nghĩ không quá khó để làm.

[hoacomay70 4]

Hề hề hề,

Xuất theo kiểu đó thì mình bất lực rồi.....

Tại sao lại không có thứ tự điểm???

Tại sao lý trình lại cần tới hai cột A và B ??? Như vậy phải nhúng hai cột này làm một thì kiến thức về lisp của mình chư đủ xài.

Còn các cột khác thì mình nghĩ không quá khó để làm.

Khi làm GPMB em hay pick điểm lần lượt từ đầu tuyến đến cuối tuyến nên  thứ tự điểm có thể theo việc chọn điểm được không ạ?

Còn lý trình xuất 1 cột thôi bác ạ. Em xin lỗi vì file ban đầu để cho đẹp đã merge hai cột với nhau nên em không chú ý.

Bác xem giúp em với.

[hochoaivandot 111]

;; Write CSV - Lee Mac
;; Writes a matrix list of cell values to a CSV file.
;; lst - [lst] list of lists, sublist is row of cell values
;; csv - [str] filename of CSV file to write
;; Returns T if successful, else nil

(defun LM:writecsv ( lst csv / des sep )
(if (setq des (open csv "w"))
(progn
(setq sep (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (",")))
(foreach row lst (write-line (LM:lst->csv row sep) des))
(close des)
t
)
)
)

;; List -> CSV - Lee Mac
;; Concatenates a row of cell values to be written to a CSV file.
;; lst - [lst] list containing row of CSV cell values
;; sep - [str] CSV separator token

(defun LM:lst->csv ( lst sep )
(if (cdr lst)
(strcat (LM:csv-addquotes (car lst) sep) sep (LM:lst->csv (cdr lst) sep))
(LM:csv-addquotes (car lst) sep)
)
)

(defun LM:csv-addquotes ( str sep / pos )
(cond
( (wcmatch str (strcat "*[`" sep "\"]*"))
(setq pos 0)
(while (setq pos (vl-string-position 34 str pos))
(setq str (vl-string-subst "\"\"" "\"" str pos)
pos (+ pos 2)
)
)
(strcat "\"" str "\"")
)
( str )
)
)
(defun C:ttt(/ e obj pt pt1 dis lt lst)
(vl-load-com)
(setq e (car (entsel "Chon PL")))
(setq obj (vlax-ename->vla-object e))
(setq lst (list (list "Lytrinh" "Cach tim" "Toa do X" "Toa do Y")))
(while (setq pt (getpoint "\nPick diem"))
(setq pt1 (vlax-curve-getClosestPointTo obj pt))
(setq dis (distance pt pt1))
(setq lt (vlax-curve-getDistAtPoint obj pt1))
(princ (strcat "Ly trinh = " (rtos lt 2 2) "\nKhoach cach den tim = " (rtos dis 2 2)))
(setq lst (cons (list (rtos lt 2 2) (rtos dis 2 2) (rtos (car pt1) 2 3) (rtos (cadr pt1) 2 3)) lst))
)
(if (and
(setq fn (getfiled "Create Output File" "" "csv" 1))
(LM:WriteCSV (reverse lst) fn)
)
(startapp "explorer" fn)
)

)

 

 

Trong lúc chờ đợi bác Phamthanhbinh có 1 lisp chuẩn hơn. Tôi làm sơ bộ cho bạn như thế này. Có thể chữa cháy trước mắt cho yêu cầu của bạn. Hì hì

[hoacomay70 4]

;; Write CSV - Lee Mac

;; Writes a matrix list of cell values to a CSV file.

;; lst - [lst] list of lists, sublist is row of cell values

;; csv - [str] filename of CSV file to write

;; Returns T if successful, else nil

 

(defun LM:writecsv ( lst csv / des sep )

(if (setq des (open csv "w"))

(progn

(setq sep (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (",")))

(foreach row lst (write-line (LM:lst->csv row sep) des))

(close des)

t

)

)

)

 

;; List -> CSV - Lee Mac

;; Concatenates a row of cell values to be written to a CSV file.

;; lst - [lst] list containing row of CSV cell values

;; sep - [str] CSV separator token

 

(defun LM:lst->csv ( lst sep )

(if (cdr lst)

(strcat (LM:csv-addquotes (car lst) sep) sep (LM:lst->csv (cdr lst) sep))

(LM:csv-addquotes (car lst) sep)

)

)

 

(defun LM:csv-addquotes ( str sep / pos )

(cond

( (wcmatch str (strcat "*[`" sep "\"]*"))

(setq pos 0)

(while (setq pos (vl-string-position 34 str pos))

(setq str (vl-string-subst "\"\"" "\"" str pos)

pos (+ pos 2)

)

)

(strcat "\"" str "\"")

)

( str )

)

)

(defun C:ttt(/ e obj pt pt1 dis lt lst)

(vl-load-com)

(setq e (car (entsel "Chon PL")))

(setq obj (vlax-ename->vla-object e))

(setq lst (list (list "Lytrinh" "Cach tim" "Toa do X" "Toa do Y")))

(while (setq pt (getpoint "\nPick diem"))

(setq pt1 (vlax-curve-getClosestPointTo obj pt))

(setq dis (distance pt pt1))

(setq lt (vlax-curve-getDistAtPoint obj pt1))

(princ (strcat "Ly trinh = " (rtos lt 2 2) "\nKhoach cach den tim = " (rtos dis 2 2)))

(setq lst (cons (list (rtos lt 2 2) (rtos dis 2 2) (rtos (car pt1) 2 3) (rtos (cadr pt1) 2 3)) lst))

)

(if (and

(setq fn (getfiled "Create Output File" "" "csv" 1))

(LM:WriteCSV (reverse lst) fn)

)

(startapp "explorer" fn)

)

 

)

 

 

Trong lúc chờ đợi bác Phamthanhbinh có 1 lisp chuẩn hơn. Tôi làm sơ bộ cho bạn như thế này. Có thể chữa cháy trước mắt cho yêu cầu của bạn. Hì hì

Tuyệt quá, lisp chạy hết đúng ý em luôn :D. Cảm ơn bác nhiều lắm lắm, có cái này em làm đỡ tốn thời gian hơn rất nhiều.

[vetgo 17]

Cũng với nhu cầu tương tự trên em có bài toán thế này mong các bác có thể giúp:

 

Thay vì phải Pick từng điểm chọn rồi xuất ra file *.csv, các bác có thể cho lựa chọn selec object (các Point hoặc Block, hoặc ID các đỉnh của Polyline) sau đó mới xuất ra file *.csv với Format như Lisp trên không.

[tan_xdct7 0]

Cảm ơn bác hoacomay70 nhiều ạ, cái này rất hay.

[vetgo 17]

Trong lúc chờ đợi bác Phamthanhbinh có 1 lisp chuẩn hơn. Tôi làm sơ bộ cho bạn như thế này. Có thể chữa cháy trước mắt cho yêu cầu của bạn. Hì hì

Em test thử thì nó không ra X, Y của điểm được chọn mà là ra tọa độ của điểm tim Polyline vuông góc với đểm được chọn, bác kiểm tra lại xem!

[hochoaivandot 111]

Em test thử thì nó không ra X, Y của điểm được chọn mà là ra tọa độ của điểm tim Polyline vuông góc với đểm được chọn, bác kiểm tra lại xem!

 

Yêu cầu của chủ topic này là lấy tọa độ gióng vuông góc trên đường tim PLine mà bạn.