Chuyển đến nội dung
Diễn đàn CADViet
draftsman38751

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

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

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 ạ

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

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

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

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

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

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 !

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

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

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

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.

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

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 "" "" "" "" ""))
)                  
  • Vote tăng 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

 

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

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

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

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

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

  • Vote giảm 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

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.

  • Vote giảm 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

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay


×