Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
banbe0274

[Nhờ chỉnh sửa] lisp polyline

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

banbe0274    0

Bác Hoành nóng tính thế hi hi ...

Lisp náy chỉ xuất được chiều dài Plyline sang EXcel.

Nhưng không xuất được góc giữa 2 đoạn thẳng của Polyline .

Nhờ Các Bác Bổ Sung hoàn thiện giúp em thê chức năng này.

1. Xuất chiếu dài các đoạn thẳng ra file excel.

2. Góc hợp bởi các đoạn của thẳng polyline:

+Nếu đoạn thẳng của Polyline thứ hai so với đoạn thẳng của Polyline thứ nhất rẽ và quay cùng chiều kim đồng hồ là rẽ phải (P=30o20'25'') chẳng hạn; ngược lại nếu quay ngược chiều kim đồng hồ là rẽ trái (T=30o20'25'').

Các bác xem ví dụ minh hoạ nhé.

Các bác giúp em nhé.

Cám ơn các Bác!

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
banbe0274    0

Các bác chắc bận bỏ rơi toppic nay hay sao ấy ?

Kính mong bác Hoàng, bác Kexu, bác Phan Thanh Bình và các Bác cao thủ lisp giúp đỡ em với .

Trân thành cám ơn các Bác!

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
npham    75

Các bác chắc bận bỏ rơi toppic nay hay sao ấy ?

Kính mong bác Hoàng, bác Kexu, bác Phan Thanh Bình và các Bác cao thủ lisp giúp đỡ em với .

Trân thành cám ơn các Bác!

 

Xin phép bác Hoàng, Bác Kexu và bác PTBình cho em đưa ra đoạn code tham khảo nhé.

 


(defun c:p2E(/ i ent ss lstV  nb)
; Polyline Vertex Length to Excel
; @ npham

(defun vlp-GetPoint (ent / lst ret name)
   	(setq lst  (vlax-get (vlax-ename->vla-object ent) 'Coordinates))
  (while lst
   	(setq ret (append ret (list (list (car lst) (cadr lst)))))
   	(setq lst (cddr lst))
	)
 ret
 )

(defun vlp-getAngle (p1 p2 p3 / a a1 a2 test)
(setq a1 (angle p1 p2))
(setq a2 (angle p2 p3))
   	(setq a3 (angle p1 p3))
(setq a (abs (- a2 a1)))
(if (> a pi) (setq a (- (* 2 pi) a)))
   	(if (> a1 pi) (setq a1 (- a1 (* 2 pi))))
   	(if (> a3 pi) (setq a3 (- a3 (* 2 pi))))

(strcat (if (> a3 a1) "T=" "P=") (angtos a 1 4))
)

(defun vlp-getdata (ss / i j data data1 ent lst p1 p2 p3)
 (setq i 0 data (append))
 (while (setq ent (ssname ss i))
	(setq data1 (append))
	(setq lst (vlp-getpoint ent))
	(setq p1 (car lst))
	(setq p2 (cadr lst))
	(setq j 2)
	(while (setq p3 (nth j lst))        
	(setq data1 (append data1 (list (list (distance p1 p2) (vlp-getAngle p1 p2 p3)))))
	(setq p1 p2 p2 p3)          
(setq j (1+ j))
)
(setq data (append data (list (list (strcat "Pline" (itoa (+ i 1))))) data1 (list (list (distance p1 p2)))))
(setq i (1+ i))
)
 data
 )

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

 ;main
 (vl-load-com)
 (if (setq ss (ssget (list (cons 0 "*POLYLINE"))))

 	(if (vlax-get-or-create-object "Excel.Application")
  (WriteToExcel (vlp-getdata ss))
  (WriteToCSV pt_lst (vlp-getdata ss))
 	)
)
 (princ)
 )

  • Vote tăng 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
npham    75

Máy tính tính thì sai làm sao được hở bác. Nếu không muốn làm tròn ở đơn vị phút bạn sửa lại dòng

 

(angtos a 1 2) Thành (angtos a 1 4)

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
Tot77    501

Nhờ Các trên diễn đàn giúp đỡ:

Chỉnh hộ em lisp như sau: Xuất góc và khoảng cách ra file cad và từ cad xuất ra file excel.

 Em có file cad như hình vẽ gồm nhiều nhánh.

Nhánh 1: VT1 đến VT2

Nhánh 2: VT2 đến VT8

Nhánh 3: VT9 đến VT13

Nhánh 4: VT2 đến VT28

Nhánh 5: VT18 đến VT21

Nhánh 6: VT23 đến VT30

trong các nhánh là line và block cột Nhờ các Bác Xuất góc và khoảng cách ra file cad và từ cad xuất ra file excel.

Các góc >=3 độ mới được tính. Cám ơn các Báchttp://www.cadviet.com/upfiles/3/72353_vi_du1.rar

Giữa điểm chèn block và đỉnh các line nối 2 block vị trí không trùng nhau, vậy lấy cái nào làm chuẩn? 

Nút 6,7,25 ...

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
banbe0274    0

điểm chèn block vừa nằn trên đường line vừa nằm trên đỉnh nối giữa 2 line bác ạ.Bác sửa giúp em nút 6,7,25... đỉnh về nằm tại đỉnh line với ạ.
Em cám ơn Bác giúp đỡ.

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
Tot77    501

Thấy bạn kiên trì quá nên tôi cũng ráng giúp, nhưng chắc không nhanh được vì cái này cũng khó không đơn giản chút nào.

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
Tot77    501

Của bạn đây. Chú ý:

1. File ket qua.xls phải có trong cùng thư mục với file cad, và file đó phải đóng khi chạy lisp. Vì muốn test cho nên tôi chỉ ghi kết quả ở bên cạnh chứ không đè lên dữ liệu cũ.

2. Lisp dựa vào toạ độ điểm chèn block cột, cho nên nếu toạ độ đó sai thì kết quả sẽ sai.

3. Trong lisp có liên quan đến 1 số layer  : "DZ0.4kV XDMoi" , "cot" . Do đó nếu không có các layer đó thì sẽ bị lỗi.

4. Khi chạy lisp thấy hơi lâu là do load excel, nhanh chậm tuỳ theo cấu hình máy.

Tôi chỉ mới test trên file bạn đưa, bạn test thêm nhiều file khác, có phát sinh lỗi gì thì cho tôi biết.

 

(defun c:tmp()
(vl-load-com)
(defun dxf(id v) (cdr (assoc id (entget v))))
(defun midp(a b) (polar a (angle a b) (* 0.5 (distance a b))))  
(defun ang(pt1 pt2) (if (< (car pt1) (car pt2)) (angle pt1 pt2) (angle pt2 pt1)))
(defun timtxt(pt)
(cadar (vl-sort ssc '(lambda(x y) (< (distance (car x) pt) (distance (car y) pt))))))
(defun timcdr(a) (caar (vl-remove-if '(lambda(x) (/= (cadr x) a)) ssc)))
 
(defun tgoc(a b c / d e f g)
(setq d (inters a b c (polar c (+ (angle a b) 1.5708) 1) nil))    
(setq e (abs (- (angle b c) (angle a b))))    
(if (> e pi) (setq e (- (* 2 pi) e)))
(strcat (angtos e 1 4)
(if (equal (cos (angle d c)) (cos (+ 1.5708 (angle a b))) 0.001) "T" "P"))
)
 
(defun txtmake1(pt1 pt2 txt / tm)
(entmake (list '(0 . "TEXT") '(8 . "Cot")
(cons 10 (setq tm (polar (midp pt1 pt2) (+ 1.5708 (ang pt1 pt2)) 3))) '(40 . 3.0) (cons 1 txt)
(cons 50  (ang pt1 pt2)) '(41 . 0.8) '(7 . "Vu") '(71 . 0) '(72 . 1) (cons 11 tm) '(73 . 2)))
)
 
(defun txtmake2(pt1 pt2 txt / tm)
(entmake (list '(0 . "TEXT") '(8 . "loaiday") '(62 . 90)
(cons 10 (setq tm (polar pt2 (angle pt1 pt2) 3))) '(40 . 1.0) (cons 11 tm)
(cons 1 (strcat "L" (chr (car (reverse (vl-string->list txt)))) "=" (substr txt 1 (1- (strlen txt)))))
(cons 50 (angle pt1 pt2)) '(41 . 0.8) '(7 . "Vu") '(71 . 0) '(72 . 0) '(73 . 2)))
) 
 
;;========================;;
 
(command "undo" "be")
(prompt "\nChon Block cot, Text cot va Line:")
(setq ssx (acet-ss-to-list (ssget '((0 . "INSERT,TEXT,LINE"))))
sst (vl-remove-if-not '(lambda(x) (and (= "TEXT" (dxf 0 x)) (= (dxf 8 x) "Cot") (/= 0 (atoi (dxf 1 x))))) ssx)
ssi (vl-remove-if-not '(lambda(x) (= "INSERT" (dxf 0 x))) ssx)
ssl (vl-remove-if-not '(lambda(x) (and (= "LINE" (dxf 0 x)) (= (dxf 8 x) "DZ0.4kV XDMoi"))) ssx)
ssc (vl-sort (mapcar '(lambda(x) (setq tt10 (dxf 10 x)) (list (dxf 10 (car
(vl-sort ssi '(lambda(y z) (< (distance tt10 (dxf 10 y))
(distance tt10 (dxf 10 z))))))) (dxf 1 x))) sst)
'(lambda(y z) (< (atoi (cadr y)) (atoi (cadr z)))))
ssj (vl-sort (mapcar '(lambda(x) (list (timtxt (dxf 10 x)) (timtxt (dxf 11 x)))) ssl)
'(lambda(y z) (< (atoi (car y)) (atoi (car z)))))
ssj (mapcar '(lambda(x) (if (setq tm (vl-remove-if-not '(lambda(y)
(equal pi (abs (- pi (abs (- (angle (car y) (timcdr (last x)))
(angle (timcdr (car x)) (car y)))))) 0.001)) ssc))
(cons (car x) (append (mapcar 'last tm) (list (last x)))) x)) ssj)   
)  
(setq excel (vlax-create-object "Excel.Application")  
currworkbook (vlax-invoke-method (vlax-get-property excel 'Workbooks) 'Open (strcat (getvar 'dwgprefix) "Ket qua.xls"))
cells (vlax-get-property (vlax-get-property excel 'ActiveSheet) 'Cells)
row 6
col 4)
 
(setq n -1 n1 0)
(repeat (1- (length ssc))
(setq v1 (nth (setq n (1+ n)) ssc)
v2 (nth (1+ n) ssc))
(vlax-put-property cells 'Item row col (last v1))
(if (= n (- (length ssc) 2)) (vlax-put-property cells 'Item (1+ row) col (last v2)))
 
(if (setq tm (vl-remove-if-not '(lambda(x) (and (member (last v1) x) (member (last v2) x))) ssj))  
(progn
(txtmake1 (car v1) (car v2) (setq tm1 (rtos (distance (car v1) (car v2)) 2 0)))
(vlax-put-property cells 'Item (1+ row) (1+ col) tm1)
 
(if (and (setq tm2 (vl-remove-if-not '(lambda(x) (and (member (last v1) x)
(> (vl-position (last v1) x) 0))) ssj))
(< 3 (atoi (setq goc (tgoc (timcdr (nth (1- (vl-position (last v1) (car tm2))) (car tm2)))
(car v1) (car v2))))))
(progn
(txtmake2 (timcdr (nth (1- (vl-position (last v1) (car tm2))) (car tm2))) (car v1) goc)
(if (< (atoi goc) 90)
(vlax-put-property cells 'Item row (+ 2 col)
(strcat "G" (itoa (setq n1 (1+ n1))) "=" goc)))))
)
)
(setq row (1+ row))
)
 
(vlax-invoke-method currworkbook 'Save)
(vlax-invoke-method excel 'Quit)
(command "undo" "e")
(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
Doan Van Ha    2.676

 

Của bạn đây. Chú ý:

1. File ket qua.xls phải có trong cùng thư mục với file cad, và file đó phải đóng khi chạy lisp. Vì muốn test cho nên tôi chỉ ghi kết quả ở bên cạnh chứ không đè lên dữ liệu cũ.

2. Lisp dựa vào toạ độ điểm chèn block cột, cho nên nếu toạ độ đó sai thì kết quả sẽ sai.

3. Trong lisp có liên quan đến 1 số layer  : "DZ0.4kV XDMoi" , "cot" . Do đó nếu không có các layer đó thì sẽ bị lỗi.

4. Khi chạy lisp thấy hơi lâu là do load excel, nhanh chậm tuỳ theo cấu hình máy.

Tôi chỉ mới test trên file bạn đưa, bạn test thêm nhiều file khác, có phát sinh lỗi gì thì cho tôi biết.

 


@Tot77: khi dùng entmake(x) thì không cần quan tâm các Layer là đã có hay chưa có. Nếu chưa có thì nó tự sinh ra.

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
banbe0274    0

Nhờ Bác tot77, Bác Hà và Bác Bình giúp đỡ sửa lisp phù hợp theo bài #17 hộ em với nhé.Em xin bổ sung 1chút lấy góc hợp bởi 2 line sẽ chính xác hơn toạ độ chèn block bác ạ

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

Đăng nhập để thực hiện theo  

×