Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
21 replies to this topic

#1 banbe0274

banbe0274

    biết vẽ pline

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

Đã gửi 01 September 2011 - 09:40 PM

Nhờ các cao thủ hoàn thiện và chỉnh sửa giúp lisp
http://www.cadviet.c...iles/3/11_4.rar
  • 0

#2 banbe0274

banbe0274

    biết vẽ pline

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

Đã gửi 05 September 2011 - 09:19 PM

Sao không thấy Bác Hoành, Bác phan Thanh Bình Và Các bác Cao Thủ Giúp mình nhỉ???
  • 0

#3 banbe0274

banbe0274

    biết vẽ pline

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

Đã gửi 06 September 2011 - 06:02 AM

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!
  • 0

#4 banbe0274

banbe0274

    biết vẽ pline

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

Đã gửi 10 September 2011 - 06:39 AM

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!
  • 0

#5 npham

npham

    biết lệnh rotate

  • Members
  • PipPipPip
  • 136 Bài viết
Điểm đánh giá: 75 (tàm tạm)

Đã gửi 10 September 2011 - 01:07 PM

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

  • 1

#6 npham

npham

    biết lệnh rotate

  • Members
  • PipPipPip
  • 136 Bài viết
Điểm đánh giá: 75 (tàm tạm)

Đã gửi 10 September 2011 - 03:12 PM

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

#7 banbe0274

banbe0274

    biết vẽ pline

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

Đã gửi 30 May 2014 - 08:15 AM

Nhờ các Bác trên diễn đàn giúp đỡ sửa lisp cho phù hợp với công việc của em với ạ .Em trân thành cám ơn các Bác.
  • 0

#8 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 31 May 2014 - 03:00 PM

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.c...2353_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 ...


  • 0

#9 banbe0274

banbe0274

    biết vẽ pline

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

Đã gửi 01 June 2014 - 09:26 AM

đ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 đỡ.


  • 0

#10 thien long

thien long

    Chưa sử dụng CAD

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

Đã gửi 01 June 2014 - 04:05 PM

Có ai có hướng dẫn máy toan đạc điện tử PTS-255R của SOKKIA cho em xin với


  • 0

#11 banbe0274

banbe0274

    biết vẽ pline

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

Đã gửi 04 June 2014 - 07:41 PM

Bác tot77 nhờ Bác sửa lisp giùm em với.
  • 0

#12 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 04 June 2014 - 08:17 PM

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.
  • 0

#13 banbe0274

banbe0274

    biết vẽ pline

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

Đã gửi 08 June 2014 - 12:56 PM

Chờ tin Bác tot77 và các Bác trên diễn đàn giúp đỡ Em.
  • 0

#14 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 08 June 2014 - 02:07 PM

Biết rồi, đang làm, đụng vấn đề hơi hóc búa, chờ thêm vài ngày nữa đi.
  • 0

#15 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 12 June 2014 - 08:04 AM

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

  • 0

#16 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 16 June 2014 - 03:46 PM

Sao lần nào bạn gửi file cũng có file acad.fas vậy, bạn coi chừng máy bị nhiễm virus acad.fas đó.


  • 0

#17 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 16 June 2014 - 04:07 PM

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.


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#18 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 16 June 2014 - 04:14 PM

Layer đó dùng để bắt đối tượng là chính, còn entmake chỉ là phụ thôi bác HA.


  • 0

#19 banbe0274

banbe0274

    biết vẽ pline

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

Đã gửi 19 June 2014 - 09:47 AM

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 ạ


  • 0

#20 banbe0274

banbe0274

    biết vẽ pline

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

Đã gửi 22 June 2014 - 09:05 AM

Cầu cứu Các bác trên diễn đàn giúp đỡ em với ạ.Trân thành cám ơn các Bác.


  • 0