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

Tháng 12 7, 2011

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 ạ

Tháng 12 7, 2011

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

Tháng 12 7, 2011

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)
)

Tháng 12 7, 2011

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ề,...

Tháng 12 12, 2011

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 !

Tháng 12 12, 2011

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 ^^

Tháng 7 24, 2013

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.

Tháng 7 24, 2013

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.com/upfiles/3/5194_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 Ð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)

(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 "" "" "" "" ""))

)

Tháng 7 25, 2013

Hề hề hề,

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

http://www.cadviet.com/upfiles/3/5194_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 Ð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)

(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.com/upfiles/3/45198_1_1.dwg

Tháng 4 30, 2015

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.

Tháng 12 20, 2016

Quick code lại :

(defun C:TL( / ss L e #h)(vl-load-com)(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))(or ans (setq ans 1))(setq    #h 200    L (strcat "L : "    (vl-princ-to-string (* (getvar "dimlfac") (apply '+   	 (mapcar 'Length1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))))))    )))    )    ans (cond ((getint (strcat "\nPhuong an nhap ket qua < " (itoa ans) " > :")))(ans))    txtObj (cond     ((= ans 1) (vlax-ename->vla-object (car (entsel "\nChon text ghi ket qua :"))))   				 (T (vla-addtext (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) L (vlax-3d-point (getpoint "\n Chon diem nhap ket qua" )) #h ))   		 ))(vla-put-TextString txtObj L)(vla-put-Height txtObj #h)(princ))

Cảm ơn bạn ! Nhưng mà sao xuất ra Text lớn thế, không chỉnh được. Bạn viết dùm hộ đi

Tháng 3 7, 2017

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 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        (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)   	))(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 "" "" "" "" "")))

Hề hề hề.

mình tìm khắp diễn đàn rồi mới thấy cái lisp này là gần với mong muốn của mình nhất, không biết có bỏ sót ko.

nếu anh rảnh thì giúp mình sửa lại cái lisp này được không.

yêu cầu của mình là lập được bảng thống kê các đoạn thẳng(là line, pline, spline, arc....), xuất ra excel được thì càng tốt.

1. cột 1: số thứ tự.

2. cột 2: tên đoạn thẳng, tên đoạn thẳng mình click vào text có sẵn trong bản vẽ hoặc có thể đánh vào dòng command. mình thích text có sẵn hơn.

3. cột 3: chiều dài đoạn thẳng.

4. cột 4,5 : từ điểm tọa độ đến điểm tọa độ. 2 cột này có càng tốt, không có cũng được.

nhờ các bác, bác nào rảnh giúp mình với.

Tháng 3 22, 2017

bác nào rảnh giúp với

Tháng 1 23, 2019

Vào lúc 7/12/2011 tại 14:11, ketxu đã nói:

Đã đăng Tháng 12 1, 2011

Bạn tìm đến đoạn

(vl-princ-to-string (* (getvar "dimlfac") (apply '+

(mapcar 'Length1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))))))

)))

rồi thêm bất kỳ gì bạn muốn vào đằng sau dấu ))). Ví dụ trường hợp của bạn là

(vl-princ-to-string (* (getvar "dimlfac") (apply '+

(mapcar 'Length1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))))))

))) " mm"

Bác ketxu giúp e chuyển sang đơn vị là mét (m) nhưng được làm tròn sau dấu phẩy 2 chữ số được kg ?

Lisp hiển thị kết quả 13.0341===> e mốn hiển thị 13.03

Tháng 1 23, 2019

8 phút trước, dinhnhat đã nói:

Bác ketxu giúp e chuyển sang đơn vị là mét (m) nhưng được làm tròn sau dấu phẩy 2 chữ số được kg ?

Lisp hiển thị kết quả 13.0341===> e mốn hiển thị 13.03

Đọc bài sau: https://www.cadviet.com/forum/topic/166577-nhờ-các-anh-chỉnh-sửa-giúp-em-lisp-sau/

Tháng 10 19, 2020

Vào lúc 30/11/2011 tại 20:43, ketxu đã nói:

Quick code lại :

tl.lsp
[✎]


(defun C:TL( / ss L e #h)
(vl-load-com)
(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
(or ans (setq ans 1))
(setq
   #h 200
   L (strcat "L : "
   (vl-princ-to-string (* (getvar "dimlfac") (apply '+
  	 (mapcar 'Length1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))))))
   )))
   )
   ans (cond ((getint (strcat "\nPhuong an nhap ket qua < " (itoa ans) " > :")))(ans))
   txtObj (cond     ((= ans 1) (vlax-ename->vla-object (car (entsel "\nChon text ghi ket qua :"))))
  				 (T (vla-addtext (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) L (vlax-3d-point (getpoint "\n Chon diem nhap ket qua" )) #h ))
  		 )
)
(vla-put-TextString txtObj L)
(vla-put-Height txtObj #h)
(princ)
)

bác ơi bác edit giúp e 1 lip tính tổng chiều dài các đoạn rồi thay vào text có sẵn được không ạ, như lips pick khối lượng cắt ngang ý bác. Tks bác ạ

Tháng 5 28, 2021

Có cách nào điều chỉnh text chỉ hiện sau dấu . 1 đơn vị hoặc không hiện không nhỉ, các tiền bối xin chỉ giáo

Tháng 5 29, 2021

8 giờ trước, Khai Huynh Trung đã nói:

Có cách nào điều chỉnh text chỉ hiện sau dấu . 1 đơn vị hoặc không hiện không nhỉ, các tiền bối xin chỉ giáo

(rtos chữ loại_units số_sau thập phân)

(rtos 5.222 2 1 ) -> "5.2"

Tháng 5 29, 2021

Vào lúc 7/3/2017 tại 09:24, tuongdaphoipha đã nói:

mình tìm khắp diễn đàn rồi mới thấy cái lisp này là gần với mong muốn của mình nhất, không biết có bỏ sót ko.

nếu anh rảnh thì giúp mình sửa lại cái lisp này được không.

yêu cầu của mình là lập được bảng thống kê các đoạn thẳng(là line, pline, spline, arc....), xuất ra excel được thì càng tốt.

1. cột 1: số thứ tự.

2. cột 2: tên đoạn thẳng, tên đoạn thẳng mình click vào text có sẵn trong bản vẽ hoặc có thể đánh vào dòng command. mình thích text có sẵn hơn.

3. cột 3: chiều dài đoạn thẳng.

4. cột 4,5 : từ điểm tọa độ đến điểm tọa độ. 2 cột này có càng tốt, không có cũng được.

nhờ các bác, bác nào rảnh giúp mình với.

Em cũng đang tìm lisp thực hiện được như yêu cầu của bác,

Bác nào có thể giúp e chỉnh lại lisp btk của bác Ketxu để được như yêu cầu trên đk ko ak?

Tháng 5 29, 2021

Bạn mở lisp, find "rtos" , sửa theo ý muốn. Hy vọng có ích cho bạn.

Tháng 3 27, 2022

Em chào cách anh ạ. Em đang học sửa một số dòng nhỏ của autolisp trên và gặp vấn đề:

Với dòng code này - thì hàm không sử dụng được:

Quote

(or #h (setq #h 200))
(or TL (setq TL 0.001))
(setq
#h (cond ((getreal (strcat "\nText height output < " (itoa #h) " > :")))(#h))
TL (cond ((getreal (strcat "\nCurrent Scale < " (itoa TL) " > :")))(TL))

Với dòng code này - thì hàm lại sử dụng bình thường

Quote

(or #h (setq #h 200))
(or TL (setq TL 1000))
(setq
#h (cond ((getreal (strcat "\nText height output < " (itoa #h) " > :")))(#h))
TL (cond ((getreal (strcat "\nCurrent Scale < " (itoa TL) " > :")))(TL))

Đoạn lisp em đang sử dụng đây ạ:

Quote

;; free lisp from cadviet.com
;;; this lisp was downloaded from https://www.cadviet.com/forum/topic/60478-nhờ-chỉnh-sửađo-chiều-dài-và-ghi-ra-text/
(defun C:Tcd2( / ss L e #h TL)
(vl-load-com)
(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
(or ans (setq ans 2))
(or #h (setq #h 200))
(or TL (setq TL 1000))
(setq
   #h (cond ((getreal (strcat "\nText height output < " (itoa #h) " > :")))(#h))
   TL (cond ((getreal (strcat "\nCurrent Scale < " (itoa TL) " > :")))(TL))
   L (strcat "Total Length (md) = "
   (vl-princ-to-string (* (* (getvar "dimlfac") TL) (apply '+(mapcar 'Length1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))))))))))
    ans (cond ((getint (strcat "\nResult: Type: Select Text - 1 /Pick Point - 2 < " (itoa ans) " > :")))(ans))
   txtObj (cond    ((= ans 1) (vlax-ename->vla-object (car (entsel "\nSelect text to print the result :"))))
       (T (vla-addtext (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) L (vlax-3d-point (getpoint "\n Chon diem nhap ket qua" )) #h ))))
(vla-put-TextString txtObj L)
(vla-put-Height txtObj #h)
(princ)
)

Nhờ các anh dạy cho em sự khác biệt của 2 đoạn code trên ạ. Em cảm ơn mọi người

Tháng 3 27, 2022

TL ở trên là 0.001, là số thực nên (itoa TL) lỗi

TL ở dưới là 1000, là số nguyên nên (itoa) OK.

Hàm itoa chỉ dùng cho số nguyên

Tháng 3 27, 2022

Em cảm ơn anh. Em đã chuyển sang dùng hàm "rtos" và nhập được số "0.001" rồi ạ. Nhân đây anh Hà cho em hỏi thêm là:

- Lúc đầu chương trình đang mặc định "1000" cho biến "TL" khi em nhập vào

- Em nhập vào giá trị khác số 1000 (ví dụ: 0.001)

- Mong muốn lần sử dụng tiếp theo khi em chưa thoát chương trình (Em đánh lệnh "tcd2") thì giá trị mặc định cho biến "TL" lại chuyển sang gợi ý là "0.001" ạ

Tháng 3 28, 2022

Delete chữ TL ở dòng defun để nó trở thành biến toàn cục thì dùng được cho lần sau.
Mấy thứ này là kiến thức cơ bản, phải học trước chứ hỏi thì khó tiến bộ.

Tháng 3 28, 2022

42 phút trước, Doan Van Ha đã nói:

Delete chữ TL ở dòng defun để nó trở thành biến toàn cục thì dùng được cho lần sau.
Mấy thứ này là kiến thức cơ bản, phải học trước chứ hỏi thì khó tiến bộ.

Em cảm ơn anh

Đăng nhập

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

Các bài được khuyến nghị

phuongkq 0

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

phuongkq 0

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ketxu 2.984

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

phamthanhbinh 3.146

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

phuongkq 0

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ketxu 2.984

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

HUNGENG 0

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

phamthanhbinh 3.146

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

HUNGENG 0

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ghost256 0

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

lephuocly 7

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

tuongdaphoipha 2

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

tuongdaphoipha 2

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

dinhnhat 2

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Danh Cong 422

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

MeoUbn 1

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Khai Huynh Trung 1

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

cuongtk2 336

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

nakahp 0

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

cuongtk2 336