Đến nội dung


Hình ảnh
5 stars - based on 24598 reviews
- - - - -

[Yêu cầu] Nhờ viết lisp dim kích thước các pline và xuất ra file cel


  • Please log in to reply
23 replies to this topic

#21 trungputin2003

trungputin2003

    biết vẽ line

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

Đã gửi 25 January 2015 - 07:21 PM

Bác PhamThanhBinh ơi, em có đường 1 pline gồm n đoạn em muốn tick vào pline thì sẽ xuất chiều dài của n đoạn đó sang Exel được không ạ? Nhờ Bác viết giúp cho cái lisp nhé. Cảm ơn Bác.


  • 0

#22 trinhhoanghieu090

trinhhoanghieu090

    Edu level: li8

  • Members
  • PipPipPipPipPip
  • 309 Bài viết
Điểm đánh giá: 29 (tàm tạm)

Đã gửi 26 January 2015 - 09:05 AM

Bác PhamThanhBinh ơi, em có đường 1 pline gồm n đoạn em muốn tick vào pline thì sẽ xuất chiều dài của n đoạn đó sang Exel được không ạ? Nhờ Bác viết giúp cho cái lisp nhé. Cảm ơn Bác.

 Tặng bạn. Lệnh xcd, line hay pline đều ok.

(defun c:xcd ( / tapchon fn dt m )
	(setq	tapchon (ssget '((-4 . "<OR")
                         (0 . "LINE")
						 (-4 . "<AND") (0 . "LWPOLYLINE") (70 . 0)(-4 . "AND>")
						 (-4 . "OR>")))
			fn	(getfiled "Chon Noi Luu File" (getvar "dwgprefix") "csv" 1)
			fn	(open fn "w")
	)
	(repeat (sslength tapchon)
			(setq	dt (ssname tapchon 0)
					tapchon (ssdel dt tapchon)
					dt	(entget dt)
					dt	(vl-remove-if-not
										'(lambda (x) (or (= (car x) 10) (= (car x) 11) ) ) dt
						)
					m	0
			)
			(repeat	(1- (length dt) )
					(setq	chieudai (distance (cdr (nth m dt)) (cdr (nth (+ m 1) dt)))
							m	(1+ m)
					)
					(write-line (rtos chieudai 2 3) fn)			
			)
	)
	(close fn)
	(princ)	
)

  • 0

#23 tanhung112003

tanhung112003

    biết zoom

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

Đã gửi 30 June 2015 - 06:09 PM

 

 Tặng bạn. Lệnh xcd, line hay pline đều ok.

(defun c:xcd ( / tapchon fn dt m )
	(setq	tapchon (ssget '((-4 . "<OR")
                         (0 . "LINE")
						 (-4 . "<AND") (0 . "LWPOLYLINE") (70 . 0)(-4 . "AND>")
						 (-4 . "OR>")))
			fn	(getfiled "Chon Noi Luu File" (getvar "dwgprefix") "csv" 1)
			fn	(open fn "w")
	)
	(repeat (sslength tapchon)
			(setq	dt (ssname tapchon 0)
					tapchon (ssdel dt tapchon)
					dt	(entget dt)
					dt	(vl-remove-if-not
										'(lambda (x) (or (= (car x) 10) (= (car x) 11) ) ) dt
						)
					m	0
			)
			(repeat	(1- (length dt) )
					(setq	chieudai (distance (cdr (nth m dt)) (cdr (nth (+ m 1) dt)))
							m	(1+ m)
					)
					(write-line (rtos chieudai 2 3) fn)			
			)
	)
	(close fn)
	(princ)	
)

Giup em sua lai cho nay la chieu dai day cung di bac,em xuat no ra khoang cach điểm đầu và điểm cuối của cung bác ạ.


  • 0

#24 luanpq86

luanpq86

    Chưa sử dụng CAD

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

Đã gửi 14 March 2017 - 04:53 PM

 

Nhờ các bác viết dùm lisp như này:
- Lisp 1: ghi kích thước theo dimstyle hiện hành
Có các thanh thép là các đường pline, line như trong file đính kèm (phần "ban đầu"), em muốn đo các kích thước của các thanh thép đó như phần "Dùng lisp" có cả kích thước chiều dài cung tròn, kích thước bán kính cung tròn, góc nghiêng.
Chú ý là thanh X3 đo kích thước cung tròn bằng lệnh 'dar' thì không đẹp, các bác có thể viết lisp thay thế bằng lệnh đo góc 'dan' mà giá trị ghi vẫn là chiều dài cung đó được ko.
- Lisp 2: Tính chiều dài và điền vào text, xuất sang cel
Cụ thể là pick vào từng thanh một sẽ tính chiều dài thanh đó (có thể là line hoặc pline) rồi pick vào từng text sẽ điền giá trị chiều dài thanh đó vào phần cuối của text.
VD: pick vào hình vẽ thanh X1 sẽ hiện lên command "điền giá trị vào text" rồi pick vào text "x1-d25, l=" sẽ thành "x1-d25, l=4545", sau đó hiện lên command "chọn thanh tiếp theo" pick vào thanh x2 rồi pick vào text "x2-d16, l=" v.v.....
Kết thúc bằng lệnh enter sẽ xuất chiều dài các thanh vừa pick sang file excel với giá trị chiều dài các thanh nằm trên 1 cột như file đính kèm
 
http://www.cadviet.c...8_cotthep_1.rar
Mong các bác giúp đỡ, em xin cám ơn trước.
 
P/S: Em cũng tìm mấy hôm trên diễn đàn về lisp tính chiều dài pline và xuất sang excel thì chưa tìm được lisp đúng ý.
Lisp này thì tính chiều dài từng phần trong pline mà ko tính tổng, lại ko tính liên tục các pline được, nhờ các bác sửa giúp em

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=43033
(defun c:p2E(/ i ent ss lstV pt_lst nb)
; Polyline Vertex Length to Excel
; @ gia_bach
  (vl-load-com)
  (if (setq ss (ssget (list (cons 0 "*POLYLINE"))))
    (progn
    (repeat (setq i (sslength ss))
	(setq ent (ssname ss (setq i (1- i))) 
		  nb (strcat "Pline " (rtos (- (sslength ss) i) 2 0)) 
		  lstV (append (list(list nb))(pll ent)))
	(foreach pt lstV
	  (setq pt_lst (append pt_lst (list pt)))
	))	  
      (if (vlax-get-or-create-object "Excel.Application")
	(WriteToExcel pt_lst)
	(WriteToCSV pt_lst) )))
  (princ))

(defun WriteToExcel (lst_data / col row x xlApp xlCells)
  (setq xlApp (vlax-get-or-create-object "Excel.Application")
	xlCells (vlax-get-property
		  (vlax-get-property
		    (vlax-get-property
		      (vlax-invoke-method
			(vlax-get-property xlApp "Workbooks")
			"Add")
		      "Sheets")
		    "Item" 1)
		  "Cells"))
  (setq row 3)
  (foreach pt lst_data
    (setq col 3)
    (foreach coor pt
      (vlax-put-property xlCells 'Item row col coor)
      (setq col (1+ col)))
    (setq row (1+ row)) )
  (vla-put-visible xlApp :vlax-true)
  (mapcar
    (function (lambda (x)
		(vl-catch-all-apply (function (lambda ()(if x (vlax-release-object x)))))))
    (list xlCells xlApp))
  (gc) (gc) )

(defun WriteToCSV (lst_data / fl)  
  (if (setq fl (getfiled "Output File" "" "csv" 1))
    (if (setq fl (open fl "w"))
      (progn
	(foreach pt lst_data 
	  (write-line (strcat (rtos (car pt)) "," (rtos (cadr pt)) "," (rtos (caddr pt))) fl) )
	(close fl) ) ) )
  (princ))
  
  
  
  (defun pll ( e / j)         
  (setq j (1- (vlax-curve-getStartParam e)) lst '())
  (while (<= (setq j (1+ j)) (vlax-curve-getEndParam e))
    (setq lst
        (cons 
          (list (- (vlax-curve-getDistatParam e j)
             (if (zerop j) 0
             (vlax-curve-getDistatParam e (1- j)))))
		lst
		)
	)
  )
	(setq lst (cdr (reverse lst)))
	lst
)

 
Hoặc lisp này thì lại chỉ tính được line:

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

 

 

Nhờ các bác viết dùm lisp như này:
- Lisp 1: ghi kích thước theo dimstyle hiện hành
Có các thanh thép là các đường pline, line như trong file đính kèm (phần "ban đầu"), em muốn đo các kích thước của các thanh thép đó như phần "Dùng lisp" có cả kích thước chiều dài cung tròn, kích thước bán kính cung tròn, góc nghiêng.
Chú ý là thanh X3 đo kích thước cung tròn bằng lệnh 'dar' thì không đẹp, các bác có thể viết lisp thay thế bằng lệnh đo góc 'dan' mà giá trị ghi vẫn là chiều dài cung đó được ko.
- Lisp 2: Tính chiều dài và điền vào text, xuất sang cel
Cụ thể là pick vào từng thanh một sẽ tính chiều dài thanh đó (có thể là line hoặc pline) rồi pick vào từng text sẽ điền giá trị chiều dài thanh đó vào phần cuối của text.
VD: pick vào hình vẽ thanh X1 sẽ hiện lên command "điền giá trị vào text" rồi pick vào text "x1-d25, l=" sẽ thành "x1-d25, l=4545", sau đó hiện lên command "chọn thanh tiếp theo" pick vào thanh x2 rồi pick vào text "x2-d16, l=" v.v.....
Kết thúc bằng lệnh enter sẽ xuất chiều dài các thanh vừa pick sang file excel với giá trị chiều dài các thanh nằm trên 1 cột như file đính kèm
 
http://www.cadviet.c...8_cotthep_1.rar
Mong các bác giúp đỡ, em xin cám ơn trước.
 
P/S: Em cũng tìm mấy hôm trên diễn đàn về lisp tính chiều dài pline và xuất sang excel thì chưa tìm được lisp đúng ý.
Lisp này thì tính chiều dài từng phần trong pline mà ko tính tổng, lại ko tính liên tục các pline được, nhờ các bác sửa giúp em

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=43033
(defun c:p2E(/ i ent ss lstV pt_lst nb)
; Polyline Vertex Length to Excel
; @ gia_bach
  (vl-load-com)
  (if (setq ss (ssget (list (cons 0 "*POLYLINE"))))
    (progn
    (repeat (setq i (sslength ss))
	(setq ent (ssname ss (setq i (1- i))) 
		  nb (strcat "Pline " (rtos (- (sslength ss) i) 2 0)) 
		  lstV (append (list(list nb))(pll ent)))
	(foreach pt lstV
	  (setq pt_lst (append pt_lst (list pt)))
	))	  
      (if (vlax-get-or-create-object "Excel.Application")
	(WriteToExcel pt_lst)
	(WriteToCSV pt_lst) )))
  (princ))

(defun WriteToExcel (lst_data / col row x xlApp xlCells)
  (setq xlApp (vlax-get-or-create-object "Excel.Application")
	xlCells (vlax-get-property
		  (vlax-get-property
		    (vlax-get-property
		      (vlax-invoke-method
			(vlax-get-property xlApp "Workbooks")
			"Add")
		      "Sheets")
		    "Item" 1)
		  "Cells"))
  (setq row 3)
  (foreach pt lst_data
    (setq col 3)
    (foreach coor pt
      (vlax-put-property xlCells 'Item row col coor)
      (setq col (1+ col)))
    (setq row (1+ row)) )
  (vla-put-visible xlApp :vlax-true)
  (mapcar
    (function (lambda (x)
		(vl-catch-all-apply (function (lambda ()(if x (vlax-release-object x)))))))
    (list xlCells xlApp))
  (gc) (gc) )

(defun WriteToCSV (lst_data / fl)  
  (if (setq fl (getfiled "Output File" "" "csv" 1))
    (if (setq fl (open fl "w"))
      (progn
	(foreach pt lst_data 
	  (write-line (strcat (rtos (car pt)) "," (rtos (cadr pt)) "," (rtos (caddr pt))) fl) )
	(close fl) ) ) )
  (princ))
  
  
  
  (defun pll ( e / j)         
  (setq j (1- (vlax-curve-getStartParam e)) lst '())
  (while (<= (setq j (1+ j)) (vlax-curve-getEndParam e))
    (setq lst
        (cons 
          (list (- (vlax-curve-getDistatParam e j)
             (if (zerop j) 0
             (vlax-curve-getDistatParam e (1- j)))))
		lst
		)
	)
  )
	(setq lst (cdr (reverse lst)))
	lst
)

 
Hoặc lisp này thì lại chỉ tính được line:

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

Mình muốn lấy chiều dài đường polyline sau khi vẽ trên cad chuyển đến ô cell mà con trỏ hiện hành trong file excel mình đang mở sẵn rồi chứ không phải là book mới thì làm sao bạn?? thanks


  • 0