Đến nội dung


Hình ảnh
- - - - -

[Nhờ chỉnh sửa]Đo chiều dài và ghi ra text


  • Please log in to reply
34 replies to this topic

#21 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 07 December 2011 - 01:35 PM

e đã thử trên file của bạn yêu cầu nhưng vẫn bị lỗi vậy. e gửi lại a file bị lỗi đó. a xem giúp e nhé. tại e thấy hay hay nên dùng thử, hihi http://www.mediafire...0hwf0j0dfvdsw6c thanks!

Hề hề hề,
Gửi lại bạn cái mình test trên bản vẽ bạn đưa.
http://www.cadviet.c...yeu_cau_1_1.dwg
http://www.cadviet.c...e_yeu_cau_1.zip
Bạn đã sử dụng lisp như thế nào???
Qua các bài của các bác mình mới phát hiện ra lỗi của lisp, nhưng không phải cái lỗi mà bạn nói. Mình đã sửa và bổ sung lại lisp ở bài post trước.

Bài viết đã được chỉnh sửa nội dung bởi phamthanhbinh: 07 December 2011 - 01:42 PM
Bồ sung file upload

  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#22 phuongkq

phuongkq

    biết vẽ line

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

Đã gửi 07 December 2011 - 01:46 PM

Hề hề hề,
Không biết cái này đã vừa ý bạn chưa?? Cần nhắc lại để bạn nhớ là cái yêu cầu của bạn hoàn toàn khác với yêu cầu của bạn chủ thớt nên mình không thể cải chỉnh cái lisp của bác Ketxu cho bạn mà phải cấu trúc lại lisp mới. nếu bạn không post file dwg lên thì chắc hẳn sẽ có nhiều người lầm lẫn và sẽ phải làm đi làm lại mà vẫn không thể như ý bạn được. bạn hãy rút kinh nghiệm cho các lần post bài sau nhé.
Chúc bạn vui.
Đây là code:



(defun c:btk ( / plst e p0 p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 n i obj els pa pf ps len txt fn fw ans)
(vl-load-com)
(command "undo" "be")
(setq plst (list) i 0)
(alert "\n Chon cac doan can thong ke")
(setq e (entsel "\n Chon doan can thong ke"))
(While e
(setq plst (cons e plst)
e (entsel "\n Chon doan tiep theo")
)
)
(setq plst (reverse plst))
(setq p1 (getpoint "\n Chon diem dat bang thong ke")
p2 (polar p1 0 2.5)
p3 (polar p2 0 5.5)
p4 (polar p3 0 5.5)
p5 (polar p4 0 5.5)
n (length plst)
p6 (polar p1 (* 1.5 pi) (* (1+ n) 1.5))
p7 (polar p2 (* 1.5 pi) (* (1+ n) 1.5))
p8 (polar p3 (* 1.5 pi) (* (1+ n) 1.5))
p9 (polar p4 (* 1.5 pi) (* (1+ n) 1.5))
p10 (polar p5 (* 1.5 pi) (* (1+ n) 1.5))
)
(command "line" p1 p5 p10 p6 p1 "")
(command "line" p2 p7 "")
(command "line" p3 p8 "")
(command "line" p4 p9 "")
(styleset)
(command "text" "j" "mc" (list (+ (car p1) 1.25) (- (cadr p1) 0.75)) 0.3 0 "TT ÐO\\U+1EA0N" )
(command "text" "j" "mc" (list (+ (car p2) 2.75) (- (cadr p1) 0.75)) 0.3 0 "T\\U+1EEA ÐI\\U+1EC2M" )
(command "text" "j" "mc" (list (+ (car p3) 2.75) (- (cadr p1) 0.75)) 0.3 0 "T\\U+1EDAI ÐI\\U+1EC2M" )
(command "text" "j" "mc" (list (+ (car p4) 2.75) (- (cadr p1) 0.75)) 0.3 0 "CHI\\U+1EC0U DÀI")
(command "text" "j" "mc" (list (+ (car p1) 9.5) (+ (cadr p1) 0.5 )) 0.5 0 "B\\U+1EA2NG XU\\U+1EA4T RA K\\U+1EBET QU\\U+1EA2")
(setq ans (getstring "\n Ban muon luu sang file cvs khong?? <Y or N>: "))
(if (= (strcase ans) "Y")
(progn
(setq fn (getfiled "Chon file de save" "" "csv" 1)
fw (open fn "w"))
(princ "BANG XUAT TOA DO RA FILE CSV \n" fw)
)
)
(foreach a plst
(setq i (1+ i)
obj (vlax-ename->vla-object (car a))
els (entget (car a))
p0 (polar p1 (* 1.5 pi) 1.5)
p1 p0
)
(cond
( (or (= (cdr (assoc 0 els)) "LWPOLYLINE") (= (cdr (assoc 0 els)) "POLYLINE"))
(setq pa (vlax-curve-getparamatpoint obj (vlax-curve-getclosestpointto obj (cadr a)))
pf (vlax-curve-getpointatparam obj (fix pa))
ps (vlax-curve-getpointatparam obj (1+ (fix pa)))
len (- (vlax-curve-getdistatpoint obj ps) (vlax-curve-getdistatpoint obj pf))
) )
( (= (cdr (assoc 0 els)) "LINE")
(setq pf (cdr (assoc 10 els))
ps (cdr (assoc 11 els))
len (distance pf ps)
) )
( (or (= (cdr (assoc 0 els)) "SPLINE") (= (cdr (assoc 0 els)) "ARC") )
(setq pf (vlax-curve-getstartpoint obj)
ps (vlax-curve-getendpoint obj)
len (vlax-curve-getdistatpoint obj ps)
) )
(T nil)
)
(setq txt (strcat (rtos i 2 0) "," "X=" (rtos (car pf) 2 4) " Y=" (rtos (cadr pf) 2 4) "," "X=" (rtos (car ps) 2 4) " Y=" (rtos (cadr ps) 2 4) "," (rtos len 2 4) "\n"))
(command "line" p0 (polar p0 0 19) "")
(command "text" "j" "mc" (list (+ (car p0) 1.25) (- (cadr p0) 0.75)) 0.2 0 (rtos i 2 0) )
(command "text" "j" "mc" (list (+ (car p0) 5.25) (- (cadr p1) 0.75)) 0.2 0 (strcat "X=" (rtos (car pf) 2 4) " Y=" (rtos (cadr pf) 2 4)) )
(command "text" "j" "mc" (list (+ (car p0) 10.75) (- (cadr p1) 0.75)) 0.2 0 (strcat "X=" (rtos (car ps) 2 4) " Y=" (rtos (cadr ps) 2 4)) )
(command "text" "j" "mc" (list (+ (car p0) 16.25) (- (cadr p1) 0.75)) 0.2 0 (rtos len 2 4))
(if (= (strcase ans) "Y")
(princ txt fw)
)
)
(close fw)
(command "undo" "e")
(princ)
)

(defun styleset ()
(setq stl (getvar "textstyle")
h (getvar "textsize"))
(if (/= h 0) (command "style" stl "" 0 "" "" "" "" ""))
)
Hề hề hề.

Cám ơn anh rất nhiều, Lisp này em dùng thử thấy có một số điểm đó là điểm thứ 11 tọa độ bị lỗi , nhờ anh kiểm tra giúp em với nhé. Thanks you very much

Nhưng khi bắt điểm theo thứ tự đoạn D1->D2->D3->D4->D5->D6->D7->D8->D9->D10->D11->D12->D13 thì bị lỗi đoạn thứ 11 (tức là D11 theo hình vẽ) . Còn khi bắt điểm theo thứ tự không lần lượt theo cách chọn đoạn D1->D2->D3->D9->D10->D11->D12->D13 thì cũng bị lỗi đoạn thứ 7 (cũng tức là D11 theo hình vẽ), và bảng xuất ra bị xô lệch như của bạn sumi gặp phải.

Anh có thể xem lại một chút không?
Theo em thấy hình như khi chọn đoạn gặp đường cung tròn ở chỗ này thì có vẻ tọa độ bị sai ạ.
  • 0

#23 phuongkq

phuongkq

    biết vẽ line

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

Đã gửi 07 December 2011 - 01:58 PM

Bác Bình nhiệt tình quá. Trong code bác còn cho phép tính cả với từng đoạn 1 của 1 Pline (dù việc này chính chủ topic cũng chưa nghĩ tới) Hình đã gửi Tks bác.
E cũng đóng góp thêm cách add table. Rộng - cao trong bảng do người dùng tự quyết định


(defun c:btk ( / cao rong iText vla_table 2t e i length1 lstCol lst lstAll fw fn)
(defun Length1(e) (* (getvar "dimlfac")(vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))))
(vl-load-com)
(command "undo" "be")
(setq cao 1.2 rong 5.5 iText (lambda(x y)(vla-settext vla_table i x y)) hText (/ cao 6)
vla_table (vla-addtable (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point (getpoint "\nChon diem dat BTK :")) 2 4 cao rong)
2t (lambda(x)(rtos x 2 4))
i 1 lstAll ""
lstCol '(0 1 2 3))
(vla-SetTextHeight vla_table acDataRow hText)
(vla-SetTextHeight vla_table acTitleRow (* 1.2 hText))
(vla-settext vla_table 0 0 "BANG THONG KE")
(mapcar 'iText lstCol '("TT" "FROM" "TO" "LENGTH"))
(prompt "\nChon doan can thong ke")
(while (setq e (ssget "_+.:E:S" (list (cons 0 "LINE,*PLINE,ARC,*POLYLINE"))))
(setq
e (vlax-ename->vla-object (ssname e 0))
lst
(append
(list (itoa i))
(list (strcat "X = " (2t (car (setq st (vlax-curve-getStartPoint e)))) " Y = " (2t (cadr st))))
(list (strcat "X = " (2t (car (setq st (vlax-curve-getEndPoint e)))) " Y = " (2t (cadr st))))
(list (2t (length1 e)))
)
lstAll (strcat lstAll (vl-string-right-trim "," (apply 'strcat (mapcar '(lambda(x)(strcat x ",")) lst))) "\n")
)
(vla-InsertRows vla_table (setq i (1+ i)) cao 1)
(mapcar '(lambda(x)(vla-SetCellAlignment vla_table i x acMiddleCenter ))lstCol)
(mapcar 'iText lstCol lst)
)
(if (= (strcase (getstring "\n Ban muon luu sang file cvs khong?? <Y or N>: ")) "Y")
(progn
(setq fn (getfiled "Chon file de save" "" "csv" 1)
fw (open fn "w"))
(princ "BANG XUAT TOA DO RA FILE CSV \n" fw)
(princ lstAll fw)
(close fw)
)
)
(command "undo" "end")
(princ)
)

Cám ơn bạn ketxu nữa, Hôm trước bạn nói bận mà vẫn để tâm giúp mình! Lisp của bạn xuất ra kết quả rất nhanh chóng, nhưng khi bắt điểm theo thứ tự đoạn D1->D2->D3->D4->D5->D6->D7->D8->D9->D10->D11->D12->D13 thì cũng bị lỗi đoạn thứ 11 (tức là D11 theo hình vẽ) như của bác Pham Thanh Binh ( không biết bác ấy có phải tên chính xác là Phạm Thanh Bình không?). còn khi bắt điểm theo thứ tự không lần lượt theo cách chọn đoạn D1->D2->D3->D9->D10->D11->D12->D13 thì cũng bị lỗi đoạn thứ 7 (cũng tức là D11 theo hình vẽ) Bạn có thể xem lại một chút không?
  • 0

#24 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 07 December 2011 - 02:11 PM

Lỗi khi bắt điểm là lỗi gì nhỉ ???
Nếu so với tọa độ trong yêu cầu của bạn thì nó ngược lại (from <-> to).
Nhưng cái này thì bạn phải tự trách mình thôi.Bạn yêu cầu Lisp lấy tọa độ đầu - cuối của 1 đoạn, và lisp sẽ lấy tọa độ theo quá trình bạn vẽ. Như với đoạn 11, bạn vẽ từ điểm (40.8 35.48) đến điểm (41.3 33.14) thì đương nhiên kết quả thu về sẽ là như thế (đầu - cuối). Còn trong ý niệm của bạn, bạn lại muốn ngược lại, mà cái này thì Máy móc không thể hiểu được ý niệm đó (vì các đoạn của bạn ở đây là hoàn toàn riêng rẽ).
Trừ khi bạn gán cho cuối đoạn 10 là đầu đoạn 11, như vậy, yêu cầu hoàn toàn khác với đề bài ban đầu, hoặc giả trong trường hợp tổng quát, nó không phù hợp (ví dụ đoạn từ D8 -> D9)
  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#25 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 07 December 2011 - 02:21 PM

Bác Bình bổ sung thêm bật-tắt bắt điểm là OK.

bác vẫn chuộng đồ cổ !
- cái thằng vla_table này đã-đang-và (có thể là) sẽ không xài được trên Cad2004 đâu.
Cám ơn Ket về 1 Ý tưởng hay.
Một chút góp ý :
1- để chắc chắn đối tuợng có start-end point, thay (entsel "...") bằng
+ (ssget "_:S" (list (cons 0 "*LINE,ARC")))
+ hay (ssget "_+.:E:S" (list (cons 0 "*LINE,ARC")))

2- thay vl-princ-to-string bằng rtos để hiển thị đúng số số lẻ
3- bổ sung vla-setTextHeight cho phù hợp với k/t bảng

(hình như Ket copy phần ghi ra file của bác Bình nên cùng có lỗi khi user chọn không ghi ra file : (close fw) )

Hề hề hề,
cám ơn sự chỉ dẫn của bác giabach,
Đúng là mình chưa test khi user trả lời no, Khi đó làm gì co fw mà đóng nó. Bởi vậy nên bị lỗi và mình đã bổ sung thành (if fw (close fw)) chắc là ổn bác nhể.
Cái thằng osnap này lắm lúc cũng phiền với nó ra phết bác nhể. Mình sẽ rút kinh nghiệm để lần sau đỡ mắc lỗi hơn.
Chúc bác khỏe và 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.

#26 phuongkq

phuongkq

    biết vẽ line

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

Đã gửi 07 December 2011 - 02:23 PM

Lỗi khi bắt điểm là lỗi gì nhỉ ???
Nếu so với tọa độ trong yêu cầu của bạn thì nó ngược lại (from <-> to).
Nhưng cái này thì bạn phải tự trách mình thôi.Bạn yêu cầu Lisp lấy tọa độ đầu - cuối của 1 đoạn, và lisp sẽ lấy tọa độ theo quá trình bạn vẽ. Như với đoạn 11, bạn vẽ từ điểm (40.8 35.48) đến điểm (41.3 33.14) thì đương nhiên kết quả thu về sẽ là như thế (đầu - cuối). Còn trong ý niệm của bạn, bạn lại muốn ngược lại, mà cái này thì Máy móc không thể hiểu được ý niệm đó (vì các đoạn của bạn ở đây là hoàn toàn riêng rẽ).
Trừ khi bạn gán cho cuối đoạn 10 là đầu đoạn 11, như vậy, yêu cầu hoàn toàn khác với đề bài ban đầu, hoặc giả trong trường hợp tổng quát, nó không phù hợp (ví dụ đoạn từ D8 -> D9)

Cám ơn bạn, mình hiểu rồi. theo ý bạn máy sẽ đi từ điểm có tọa độ bên trái ( sẽ là From) sang tọa độ bên phải ( là To) đối với một đoạn đúng không ạ
  • 0

#27 phuongkq

phuongkq

    biết vẽ line

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

Đã gửi 07 December 2011 - 02:49 PM

Anh Bình update rất chuẩn rồi đấy ạ
  • 0

#28 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 07 December 2011 - 03:09 PM

Cám ơn bạn, mình hiểu rồi. theo ý bạn máy sẽ đi từ điểm có tọa độ bên trái ( sẽ là From) sang tọa độ bên phải ( là To) đối với một đoạn đúng không ạ

Mình nói rõ bên trên rồi, mà bạn lại nói khác đi. Máy hiểu điểm đầu - cuối theo thứ tự khi bạn vẽ ra đối tượng, tức thứ tự bạn click chuột lúc Pick ra cái hình đó ấy.
Bây giờ bạn phải quy định cho Lisp biết cách nhận biết đâu là đầu, đâu là cuối - THEO Ý BẠN (quy luật)
Ở đây mình viết 1 cái cho phép khi xuất đỉnh sẽ xác định xem có đỉnh nào trùng với đỉnh của Đoạn trước không, nếu có thì coi như đoạn bắt đầu từ đó

(defun c:btk ( / cao rong iText vla_table 2t e i length1 lsttmp lstCol lst lstAll fw fn p1 p2)
(defun Length1(e) (* (getvar "dimlfac")(vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))))
(defun ReLst (pt lstPt fuzz)
(if (vl-member-if '(lambda(x)(equal pt x fuzz)) lstPt)
(list pt (car (vl-remove pt lstPt)))
lstPt))
(vl-load-com)
(command "undo" "be")
(setq cao 1.2 rong 5.5 iText (lambda(x y)(vla-settext vla_table i x y)) hText (/ cao 6)
vla_table (vla-addtable (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point (getpoint "\nChon diem dat BTK :")) 2 4 cao rong)
2t (lambda(x)(rtos x 2 4))
i 1 lstAll ""
lstCol '(0 1 2 3))
(vla-SetTextHeight vla_table acDataRow hText)
(vla-SetTextHeight vla_table acTitleRow (* 1.2 hText))
(vla-settext vla_table 0 0 "BANG THONG KE")
(mapcar 'iText lstCol '("TT" "FROM" "TO" "LENGTH"))
(prompt "\nChon doan can thong ke")
(while (setq e (ssget "_+.:E:S" (list (cons 0 "LINE,*PLINE,ARC,*POLYLINE"))))
(setq
e (vlax-ename->vla-object (ssname e 0))
lsttmp (list (vlax-curve-getStartPoint e)(vlax-curve-getEndPoint e))
lsttmp (ReLst p2 lsttmp 0.1)
lsttmp (ReLst p1 lsttmp 0.1)
lst
(append
(list (itoa i))
(list (strcat "X = " (2t (caar lstTmp)) " Y = " (2t (cadar lsttmp))))
(list (strcat "X = " (2t (caadr lstTmp)) " Y = " (2t (cadadr lstTmp))))
(list (2t (length1 e)))
)
p1 (last lstTmp)
p2 (car lstTmp)
lstAll (strcat lstAll (vl-string-right-trim "," (apply 'strcat (mapcar '(lambda(x)(strcat x ",")) lst))) "\n")
)
(vla-InsertRows vla_table (setq i (1+ i)) cao 1)
(mapcar '(lambda(x)(vla-SetCellAlignment vla_table i x acMiddleCenter ))lstCol)
(mapcar 'iText lstCol lst)
)
(if (= (strcase (getstring "\n Ban muon luu sang file cvs khong?? <Y or N>: ")) "Y")
(progn
(setq fn (getfiled "Chon file de save" "" "csv" 1)
fw (open fn "w"))
(princ "BANG XUAT TOA DO RA FILE CSV \n" fw)
(princ lstAll fw)
(close fw)
)
)
(command "undo" "end")
(princ)
)

  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#29 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 07 December 2011 - 03:49 PM

Anh Bình update rất chuẩn rồi đấy ạ

Hề hề hề, thực ra thì mình khi viết cứ nhè theo cái bảng bạn đã post mà viết, đến khi thấy được thì mừng húm post lên chứ chưa check cẩn thận. May nhờ các bác nhắc nhở nên mới biết lỗi mà chỉnh lại. Nếu nó đã đạt yêu cầu bạn cần thì là quá mừng, còn chưa đạt thì lại chỉnh tiếp vì mình cũng chỉ đang đi mót ấy mà.
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.

#30 phuongkq

phuongkq

    biết vẽ line

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

Đã gửi 12 December 2011 - 08:38 AM

Mình nói rõ bên trên rồi, mà bạn lại nói khác đi. Máy hiểu điểm đầu - cuối theo thứ tự khi bạn vẽ ra đối tượng, tức thứ tự bạn click chuột lúc Pick ra cái hình đó ấy.
Bây giờ bạn phải quy định cho Lisp biết cách nhận biết đâu là đầu, đâu là cuối - THEO Ý BẠN (quy luật)
Ở đây mình viết 1 cái cho phép khi xuất đỉnh sẽ xác định xem có đỉnh nào trùng với đỉnh của Đoạn trước không, nếu có thì coi như đoạn bắt đầu từ đó


(defun c:btk ( / cao rong iText vla_table 2t e i length1 lsttmp lstCol lst lstAll fw fn p1 p2)
(defun Length1(e) (* (getvar "dimlfac")(vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))))
(defun ReLst (pt lstPt fuzz)
(if (vl-member-if '(lambda(x)(equal pt x fuzz)) lstPt)
(list pt (car (vl-remove pt lstPt)))
lstPt))
(vl-load-com)
(command "undo" "be")
(setq cao 1.2 rong 5.5 iText (lambda(x y)(vla-settext vla_table i x y)) hText (/ cao 6)
vla_table (vla-addtable (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point (getpoint "\nChon diem dat BTK :")) 2 4 cao rong)
2t (lambda(x)(rtos x 2 4))
i 1 lstAll ""
lstCol '(0 1 2 3))
(vla-SetTextHeight vla_table acDataRow hText)
(vla-SetTextHeight vla_table acTitleRow (* 1.2 hText))
(vla-settext vla_table 0 0 "BANG THONG KE")
(mapcar 'iText lstCol '("TT" "FROM" "TO" "LENGTH"))
(prompt "\nChon doan can thong ke")
(while (setq e (ssget "_+.:E:S" (list (cons 0 "LINE,*PLINE,ARC,*POLYLINE"))))
(setq
e (vlax-ename->vla-object (ssname e 0))
lsttmp (list (vlax-curve-getStartPoint e)(vlax-curve-getEndPoint e))
lsttmp (ReLst p2 lsttmp 0.1)
lsttmp (ReLst p1 lsttmp 0.1)
lst
(append
(list (itoa i))
(list (strcat "X = " (2t (caar lstTmp)) " Y = " (2t (cadar lsttmp))))
(list (strcat "X = " (2t (caadr lstTmp)) " Y = " (2t (cadadr lstTmp))))
(list (2t (length1 e)))
)
p1 (last lstTmp)
p2 (car lstTmp)
lstAll (strcat lstAll (vl-string-right-trim "," (apply 'strcat (mapcar '(lambda(x)(strcat x ",")) lst))) "\n")
)
(vla-InsertRows vla_table (setq i (1+ i)) cao 1)
(mapcar '(lambda(x)(vla-SetCellAlignment vla_table i x acMiddleCenter ))lstCol)
(mapcar 'iText lstCol lst)
)
(if (= (strcase (getstring "\n Ban muon luu sang file cvs khong?? <Y or N>: ")) "Y")
(progn
(setq fn (getfiled "Chon file de save" "" "csv" 1)
fw (open fn "w"))
(princ "BANG XUAT TOA DO RA FILE CSV \n" fw)
(princ lstAll fw)
(close fw)
)
)
(command "undo" "end")
(princ)
)

Nếu được vậy thì quá tốt. Thanks bạn nhiều !
  • 0

#31 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 12 December 2011 - 09:11 AM

Nếu được vậy thì quá tốt. Thanks bạn nhiều !


Ủa, cái đó mình viết từ hôm đó và up luôn theo bài viết rồi, còn "Nếu" gì nữa ^^
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#32 HUNGENG

HUNGENG

    biết pan

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

Đã gửi 24 July 2013 - 11:07 AM

Hề hề hề,
cám ơn sự chỉ dẫn của bác giabach,
Đúng là mình chưa test khi user trả lời no, Khi đó làm gì co fw mà đóng nó. Bởi vậy nên bị lỗi và mình đã bổ sung thành (if fw (close fw)) chắc là ổn bác nhể.
Cái thằng osnap này lắm lúc cũng phiền với nó ra phết bác nhể. Mình sẽ rút kinh nghiệm để lần sau đỡ mắc lỗi hơn.
Chúc bác khỏe và vui.

 

Bác Bình có thể chỉnh lại cái lisp của bác một chút như sau được không:

+Bác thêm tính năng khi mình pick vào một đoạn thẳng trên dòng command line báo 1 found. Chọn đoạn tiếp theo nó báo: 1found, 2 total như các lệnh trong cad ấy để mình biết đã chon được bao nhiêu đoạn rồi.

+Khi xuất ra excel bác cho xuất cả tiêu đề của bảng nữa: TT diem-Tu diem-Den diem...

 

Cảm ơn bác nhiều.


  • 0

#33 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 July 2013 - 03:20 PM

Bác Bình có thể chỉnh lại cái lisp của bác một chút như sau được không:

+Bác thêm tính năng khi mình pick vào một đoạn thẳng trên dòng command line báo 1 found. Chọn đoạn tiếp theo nó báo: 1found, 2 total như các lệnh trong cad ấy để mình biết đã chon được bao nhiêu đoạn rồi.

+Khi xuất ra excel bác cho xuất cả tiêu đề của bảng nữa: TT diem-Tu diem-Den diem...

 

Cảm ơn bác nhiều.

Hề hề hề,

Phải chăng bạn cần cái ni:

http://www.cadviet.c...194_sualisp.lsp

(defun c:btk ( / plst e p0 p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 n i obj els pa pf ps len txt fn fw ans)
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq plst (list)  i 0)
(alert "\n Chon cac doan can thong ke")
(setq e  (entsel "\n Chon doan can thong ke"))
(While e
        (princ (strcat " 1 found. " (rtos (1+ i) 2 0) "total"))
        (setq plst (cons e plst)
                  e (entsel "\n Chon doan tiep theo")
                  i (1+ i)
        )
)
(setq plst (reverse plst))
(setq p1 (getpoint "\n Chon diem dat bang thong ke")
          p2 (polar p1 0 2.5)
          p3 (polar p2 0 5.5)
          p4 (polar p3 0 5.5)
          p5 (polar p4 0 5.5)
          n (length plst)
          p6 (polar p1 (* 1.5 pi) (* (1+ n) 1.5))
          p7 (polar p2 (* 1.5 pi) (* (1+ n) 1.5))
          p8 (polar p3 (* 1.5 pi) (* (1+ n) 1.5))
          p9 (polar p4 (* 1.5 pi) (* (1+ n) 1.5))
          p10 (polar p5 (* 1.5 pi) (* (1+ n) 1.5))
)
(command "line" p1 p5 p10 p6 p1 "")
(command "line" p2 p7 "")
(command "line" p3 p8 "")
(command "line" p4 p9 "")
(styleset)
(command "text" "j" "mc" (list (+ (car p1) 1.25) (- (cadr p1) 0.75)) 0.3 0 "TT  &#208;O\\U+1EA0N" )
(command "text" "j" "mc" (list (+ (car p2) 2.75) (- (cadr p1) 0.75)) 0.3 0 "T\\U+1EEA  &#208;I\\U+1EC2M" )
(command "text" "j" "mc" (list (+ (car p3) 2.75) (- (cadr p1) 0.75)) 0.3 0 "T\\U+1EDAI  &#208;I\\U+1EC2M" )
(command "text" "j" "mc" (list (+ (car p4) 2.75) (- (cadr p1) 0.75)) 0.3 0 "CHI\\U+1EC0U  D&#192;I")
(command "text" "j" "mc" (list (+ (car p1) 9.5) (+ (cadr p1) 0.5 )) 0.5 0 "B\\U+1EA2NG XU\\U+1EA4T RA K\\U+1EBET QU\\U
 
+1EA2")
(setq ans (getstring "\n Ban muon luu sang file cvs khong?? <Y or N>: "))
(if (= (strcase ans) "Y")
    (progn
            (setq fn (getfiled "Chon file de save" "" "csv" 1)
          fw (open fn "w"))
        (princ  "BANG XUAT TOA DO RA FILE CSV \n" fw)
                  (princ " TT doan , Tu diem , Toi diem , Chieu dai \n" fw)
   )
)
(setq i 0)
(foreach a plst
    (setq i (1+ i)
                obj (vlax-ename->vla-object (car a))
                els (entget (car a))
                p0 (polar p1 (* 1.5 pi) 1.5)
                p1 p0
    )
    (cond
          ( (or (= (cdr (assoc 0 els)) "LWPOLYLINE") (= (cdr (assoc 0 els)) "POLYLINE"))
                  (setq pa (vlax-curve-getparamatpoint obj (vlax-curve-getclosestpointto obj (cadr a)))
                            pf (vlax-curve-getpointatparam obj (fix pa))
                            ps (vlax-curve-getpointatparam obj (1+ (fix pa)))
                            len (- (vlax-curve-getdistatpoint obj ps) (vlax-curve-getdistatpoint obj pf))                          
                  ) )
          ( (= (cdr (assoc 0 els)) "LINE")
                  (setq pf (cdr (assoc 10 els))
                        ps (cdr (assoc 11 els))
                        len (distance pf ps)
                  ) )
          ( (or (= (cdr (assoc 0 els)) "SPLINE") (=  (cdr (assoc 0 els)) "ARC") )
                  (setq pf (vlax-curve-getstartpoint obj)
                        ps (vlax-curve-getendpoint obj)
                        len (vlax-curve-getdistatpoint obj ps)
                  ) )
          (T nil)
    )
    (setq txt (strcat (rtos i 2 0) "," "X=" (rtos (car pf) 2 4) "  Y=" (rtos (cadr pf) 2 4) "," "X=" (rtos (car ps) 2 4) "  Y=" (rtos 
 
(cadr ps) 2 4) "," (rtos len 2 4) "\n"))
    (command "line" p0 (polar p0 0 19) "")
    (command "text" "j" "mc" (list (+ (car p0) 1.25) (- (cadr p0) 0.75)) 0.2 0 (rtos i 2 0) )
    (command "text" "j" "mc" (list (+ (car p0) 5.25) (- (cadr p1) 0.75)) 0.2 0 (strcat "X=" (rtos (car pf) 2 4) "  Y=" (rtos 
 
(cadr pf) 2 4)) )
    (command "text" "j" "mc" (list (+ (car p0) 10.75) (- (cadr p1) 0.75)) 0.2 0 (strcat "X=" (rtos (car ps) 2 4) "  Y=" (rtos 
 
(cadr ps) 2 4)) )
    (command "text" "j" "mc" (list (+ (car p0) 16.25) (- (cadr p1) 0.75)) 0.2 0 (rtos len 2 4))
    (if (= (strcase ans) "Y")
        (princ txt fw)
    )
)
(if fw
   (close fw)
)
(setvar "osmode" oldos)
(command "undo" "e")
(princ)
)
 
(defun styleset ()
(setq stl (getvar "textstyle")
      h (getvar "textsize"))
(if (/= h 0) (command "style" stl "" 0 "" "" "" "" ""))
)                  

  • 2
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#34 HUNGENG

HUNGENG

    biết pan

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

Đã gửi 25 July 2013 - 11:27 AM

Hề hề hề,

Phải chăng bạn cần cái ni:

http://www.cadviet.c...194_sualisp.lsp

(defun c:btk ( / plst e p0 p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 n i obj els pa pf ps len txt fn fw ans)
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq plst (list)  i 0)
(alert "\n Chon cac doan can thong ke")
(setq e  (entsel "\n Chon doan can thong ke"))
(While e
        (princ (strcat " 1 found. " (rtos (1+ i) 2 0) "total"))
        (setq plst (cons e plst)
                  e (entsel "\n Chon doan tiep theo")
                  i (1+ i)
        )
)
(setq plst (reverse plst))
(setq p1 (getpoint "\n Chon diem dat bang thong ke")
          p2 (polar p1 0 2.5)
          p3 (polar p2 0 5.5)
          p4 (polar p3 0 5.5)
          p5 (polar p4 0 5.5)
          n (length plst)
          p6 (polar p1 (* 1.5 pi) (* (1+ n) 1.5))
          p7 (polar p2 (* 1.5 pi) (* (1+ n) 1.5))
          p8 (polar p3 (* 1.5 pi) (* (1+ n) 1.5))
          p9 (polar p4 (* 1.5 pi) (* (1+ n) 1.5))
          p10 (polar p5 (* 1.5 pi) (* (1+ n) 1.5))
)
(command "line" p1 p5 p10 p6 p1 "")
(command "line" p2 p7 "")
(command "line" p3 p8 "")
(command "line" p4 p9 "")
(styleset)
(command "text" "j" "mc" (list (+ (car p1) 1.25) (- (cadr p1) 0.75)) 0.3 0 "TT  &#208;O\\U+1EA0N" )
(command "text" "j" "mc" (list (+ (car p2) 2.75) (- (cadr p1) 0.75)) 0.3 0 "T\\U+1EEA  &#208;I\\U+1EC2M" )
(command "text" "j" "mc" (list (+ (car p3) 2.75) (- (cadr p1) 0.75)) 0.3 0 "T\\U+1EDAI  &#208;I\\U+1EC2M" )
(command "text" "j" "mc" (list (+ (car p4) 2.75) (- (cadr p1) 0.75)) 0.3 0 "CHI\\U+1EC0U  D&#192;I")
(command "text" "j" "mc" (list (+ (car p1) 9.5) (+ (cadr p1) 0.5 )) 0.5 0 "B\\U+1EA2NG XU\\U+1EA4T RA K\\U+1EBET QU\\U
 
+1EA2")
(setq ans (getstring "\n Ban muon luu sang file cvs khong?? <Y or N>: "))
(if (= (strcase ans) "Y")
    (progn
            (setq fn (getfiled "Chon file de save" "" "csv" 1)
          fw (open fn "w"))
        (princ  "BANG XUAT TOA DO RA FILE CSV \n" fw)
                  (princ " TT doan , Tu diem , Toi diem , Chieu dai \n" fw)
   )
)
(setq i 0)
(foreach a plst
    (setq i (1+ i)
                obj (vlax-ename->vla-object (car a))
                els (entget (car a))
                p0 (polar p1 (* 1.5 pi) 1.5)
                p1 p0
    )
    (cond
          ( (or (= (cdr (assoc 0 els)) "LWPOLYLINE") (= (cdr (assoc 0 els)) "POLYLINE"))
                  (setq pa (vlax-curve-getparamatpoint obj (vlax-curve-getclosestpointto obj (cadr a)))
                            pf (vlax-curve-getpointatparam obj (fix pa))
                            ps (vlax-curve-getpointatparam obj (1+ (fix pa)))
                            len (- (vlax-curve-getdistatpoint obj ps) (vlax-curve-getdistatpoint obj pf))                          
                  ) )
          ( (= (cdr (assoc 0 els)) "LINE")
                  (setq pf (cdr (assoc 10 els))
                        ps (cdr (assoc 11 els))
                        len (distance pf ps)
                  ) )
          ( (or (= (cdr (assoc 0 els)) "SPLINE") (=  (cdr (assoc 0 els)) "ARC") )
                  (setq pf (vlax-curve-getstartpoint obj)
                        ps (vlax-curve-getendpoint obj)
                        len (vlax-curve-getdistatpoint obj ps)
                  ) )
          (T nil)
    )
    (setq txt (strcat (rtos i 2 0) "," "X=" (rtos (car pf) 2 4) "  Y=" (rtos (cadr pf) 2 4) "," "X=" (rtos (car ps) 2 4) "  Y=" (rtos 
 
(cadr ps) 2 4) "," (rtos len 2 4) "\n"))
    (command "line" p0 (polar p0 0 19) "")
    (command "text" "j" "mc" (list (+ (car p0) 1.25) (- (cadr p0) 0.75)) 0.2 0 (rtos i 2 0) )
    (command "text" "j" "mc" (list (+ (car p0) 5.25) (- (cadr p1) 0.75)) 0.2 0 (strcat "X=" (rtos (car pf) 2 4) "  Y=" (rtos 
 
(cadr pf) 2 4)) )
    (command "text" "j" "mc" (list (+ (car p0) 10.75) (- (cadr p1) 0.75)) 0.2 0 (strcat "X=" (rtos (car ps) 2 4) "  Y=" (rtos 
 
(cadr ps) 2 4)) )
    (command "text" "j" "mc" (list (+ (car p0) 16.25) (- (cadr p1) 0.75)) 0.2 0 (rtos len 2 4))
    (if (= (strcase ans) "Y")
        (princ txt fw)
    )
)
(if fw
   (close fw)
)
(setvar "osmode" oldos)
(command "undo" "e")
(princ)
)
 
(defun styleset ()
(setq stl (getvar "textstyle")
      h (getvar "textsize"))
(if (/= h 0) (command "style" stl "" 0 "" "" "" "" ""))
)                  

 

Được rồi bạn ah. Cảm ơn bạn rất nhiều. Bạn có thể giúp tôi viết một lisp tương tự như trong file đính kèm được không:

1-Chọn tên (No-01), chon lần lượt các đường (line, polyline, arc, spline nua thi rất tốt), chọn đến đâu gán luôn chữ cái vào đường đến đó (A,B,C...). Sau đó chọn các góc đã được đo sẵn

2-Chọn điểm để xuất ra bảng kết quả giống như trong bv kèm theo

3-Hỏi có xuất bang ra Excel hay không.

 

Thanks a lot

http://www.cadviet.c...3/45198_1_1.dwg


  • 0

#35 ghost256

ghost256

    Chưa sử dụng CAD

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

Đã gửi 30 April 2015 - 08:19 AM

Em search được trên CV thấy có lisp dùng để đo chiều dài và ghi ra text.Nhờ các bác chỉnh sửa lại giúp e tí cho phù hợp cv.Khi chạy lisp yêu cầu chọn phương án nhập kết quả:
1-Chọn điểm để nhập kết quả thì e muốn text ra là Style hiện hành, chiều cao là 200 và text ghi ra sẽ có dạng L= ???
2-Chọn text để gán kết quả thì cũng có dạng như trên
Két thúc lệnh.
Thanhks các Pro nhiều!!

Lisp đó đây ạh!

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=9681
(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
;;;--------------------------------------------------------------------
(defun C:TL( / ss L e)
(setq
ss (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))
L 0.0
k (getvar "dimlfac")
)
(vl-load-com)
(while (setq e (ssname ss 0))
(setq L (* k (length1 e)))
(setq ans (getstring "\n Ban hay chon phuong an nhap ket qua "))
(if (= ans "1")
(progn
(setq te (entget(car(entsel "\n Chon Text de gan ket qua :")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te)
)
(progn
(setq p (getpoint "\n Chon diem nhap ket qua" ))
(setq h (getreal "\n Nhap chieu cao text ket qua "))
(command "text" p h "0" (rtos L 2 2))
)
)
(ssdel e ss)
)
(princ)
)
;;;--------------------------------------------------------------------
 

 Các bác giúp em với. Em đang cần một lip tương tự thế này. Em cần đo một đoạn thẳng rồi thay thế text đã có sẵn là được. chứ không phải đánh lệnh "tl" rồi seclet opjec... để chọn cả một đoạn thẳng. Đoạn thẳng hay Plyline của em gồm nhiều đoạn nhỏ khác. Em muốn đo các đoạn nhỏ đó. Nói dài dòng vì không biết diễn tả thế nào.
Nghĩa là em có một PL giao với các đoạn thẳng khác tại các điểm a,b,c,d,e..... Giờ em muốn đánh lệnh tl xong => pick vào điểm a => b => c => d.....enter => chọn text cần thay thế độ dài đoạn ab, bc, cd... là xong. Không cần phương án 1 , 2 gì cả.
Trong hình em muốn đánh lệnh xong pick vào các điểm khoanh tròn màu xanh. và thay thế lần lượt số 6.52, 1.38, 1.60, 6.03...
Cảm ơn các bác rất nhiều.141814_untitled.jpg


  • 0