[Yêu Cầu] Lisp thống kê đoạn thẳng

[onggia83 3]

Vào lúc 6/4/2019 tại 15:39, huunhantvxdts đã nói:

sửa lại cho bạn có vòng lặp và chạy được còn kết quả theo của bạn

• ttc.lsp
  
• [✎]
   

(defun C:TTC ();(D H1 H2 WF TL1 K P1 P2 P3 P4 P5 P6 P7 P8 PT PT1 P9 P10 P11 P12 P13 TTL L)
(SETVAR "cmdecho" 0)
(command "undo" "begin")
(setq LADIN (GETVAR "dimzin"))
(setq LAOS (GETVAR "osmode"))
(setq STY (GETVAR "textstyle"))
(setq D (TBLSEARCH "style" STY))
(setq H1 (CDR (ASSOC 40 D)))
(setq H2 (CDR (ASSOC 42 D)))
(setq WF (CDR (ASSOC 41 D)))
(setq H H2)
;(setq L 0)
(setq TL 1)
(setq TL1 (GETREAL (STRCAT (RTOS TL 2 0) " >: 1/")))
(setq TL TL1)
(setq K 0)
(setq TTL 0)
(SETVAR "dimzin" 0)
(SETVAR "OSMODE" 0)
(setq PT (GETPOINT "\nChon diem xuat bang thong ke: "))
(setq P1 (LIST (+ (CAR PT) (* 6 H)) (CADR PT)))
(setq P2 (LIST (+ (CAR PT) (* 22 H)) (CADR PT)))
(setq P3 (LIST (CAR PT) (- (CADR PT) (* 3 H))))
(setq P4 (LIST (CAR P1) (CADR P3)))
(setq P5 (LIST (CAR P2) (CADR P3)))
(setq P6 (LIST (+ (CAR PT) (* 11 H)) (+ (CADR PT) (* 2 H))))
(setq P7 (LIST (+ (CAR PT) (* 3 H)) (- (CADR PT) (* 1.5 H))))
(setq P8 (LIST (+ (CAR PT) (* 14 H)) (- (CADR PT) (* 1.5 H))))
(command "pline" PT P2 P5 P3 "C")
(command "pline" P1 P4 "")
(command "TEXT" "M" P6 "" "" "BANG THONG KE CHIEU DAI" "")
(command "TEXT" "M" P7 "" "" "STT" "")
(command "TEXT" "M" P8 "" "" "CHIEU DAI" "")
(while (setq E (CAR (ENTSEL "\n Chon doi tuong tinh chieu dai : ")))
(setq K (1+ K))
(setq PT (LIST (CAR P3) (CADR P3)))
(setq P1 (LIST (+ (CAR PT) (* 6 H)) (CADR PT)))
(setq P2 (LIST (+ (CAR PT) (* 22 H)) (CADR PT)))
(setq P3 (LIST (CAR PT) (- (CADR PT) (* 3 H))))
(setq P4 (LIST (CAR P1) (CADR P3)))
(setq P5 (LIST (CAR P2) (CADR P3)))
(setq P7 (LIST (+ (CAR PT) (* 3 H)) (- (CADR PT) (* 1.5 H))))
(setq P8 (LIST (+ (CAR PT) (* 14 H)) (- (CADR PT) (* 1.5 H))))
(setq P9 (LIST (CAR PT) (- (CADR P3) (* 3 H))))
(setq P10 (LIST (CAR P1) (CADR P9)))
(setq P11 (LIST (CAR P2) (CADR P9)))
(setq P12 (LIST (CAR P7) (- (CADR P3) (* 1.5 H))))
(setq P13 (LIST (CAR P8) (CADR P12)))
(setq L (* (LEN E) TL))
(setq TTL (+ L TTL))
(command "pline" PT P2 P5 P3 "C")
(command "pline" P1 P4 "")
(command "TEXT" "M" P7 "" "" (RTOS K 2 0) "")
(command "TEXT" "M" P8 "" "" (RTOS L 2 2) "")
;(setq E (CAR (ENTSEL (STRCAT "\nTong chieu dai = " (RTOS TTL 2 3) ". Chon doi tuong tiep theo..."))))
)
(SETVAR "DIMZIN" LADIN)
(command "pline" P3 P9 P11 P5 "C")
(command "pline" P10 P4 "")
(command "TEXT" "M" P12 "" "" "TONG" "")
(command "TEXT" "M" P13 "" "" (RTOS TTL 2 2) "")
(SETVAR "OSMODE" LAOS)
(command "undo" "end")
  )
;(defun LEN (E))
(defun LEN(E) (vlax-curve-getDistAtParam E (vlax-curve-getEndParam E)))
;(defun WTXT_M (TXT  P / STY D H1 H2 WF H)
;(setq STY (GETVAR "textstyle"))
;(setq D (TBLSEARCH "style" STY))
;(setq H1 (CDR (ASSOC 40 D)))
;(setq H2 (CDR (ASSOC 42 D)))
;(setq WF (CDR (ASSOC 41 D)))
;(setq H H1)
;)

 

 

Vào lúc 17/9/2013 tại 10:26, trieubb đã nói:

Lệnh rất hay bác ạ nhưng bác có thể viết them 1 cái là chỉ cần thống kê chiều dài và tên layer ra luôn bản vẽ và đặt cạnh từng đoạn luôn không bác, thanks bác nhiều.Chờ tin bác

List mình test thử ko xuất dc kết quả. List của bạn rất hay, ủng hộ bạn.

[huunhantvxdts 195]

37 phút trước, onggia83 đã nói:

 

List mình test thử ko xuất dc kết quả. List của bạn rất hay, ủng hộ bạn.

Lỗi thế nào bạn phải chụp hình copy cái thông báo lên chứ??

 

[onggia83 3]

Mình đã test lại và hoạt động tốt. List rất bổ ích. Chúc bạn luôn mạnh khỏe và thành công trong cuộc sống.

 

[Binh Luu 0]

Vào lúc 2/3/2017 tại 08:35, a12k39duchao đã nói:

Đáp án của bạn đây.

Thực hiện bởi anh #quocmanh04tt

https://drive.google.com/file/d/0B2LetfHDljPGUThCUGJfV3FuWVU/view

Bác ơi file bác đã hoàn hảo lắm rồi. Tuy nhiên bác có thể làm thêm một ít chức năng nữa không ạ:

1/ tất cả những polyline có tổng chiều dài giống nhau gom lại và thống kê ra số lượng bao nhiêu luôn được không ạ? sao cho những polyline giống nhau chỉ xuất về cùng 1 dòng ghi ra số lượng bao nhiêu thôi

[mrthanhdat 0]

Vào lúc 11/7/2013 tại 17:01, Doan Van Ha đã nói:

Sửa cho bạn đây. Lisp có thể dùng cho Line, Polyline, Lwpolyline, Spline.

 

• ha.lsp
  
• [✎]
   

;Doan Van Ha - CADViet.com - Ngay 16/5/2012. Edit 11/7/2013
;Muc dich: nhom cac doi tuong *Line cung Length va cung Layer, sau do xuat ra file.
(defun C:HA( / entlst lst fn pw)
(princ "\nChon cac doi tuong de lay chieu dai can xuat ra file...")
(setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "*LINE")))))))
(foreach ent entlst
 (setq lst (cons (list (cdr (assoc 8 (entget ent))) (atof (rtos (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)) 2 4))) lst)))
(setq lst (LM:ListOccurrences lst))
(setq fn (getfiled "Chon file de xuat ket qua" "" "xls" 1))
(setq pw (open fn "w"))
(write-line (strcat "Chieu dai" "\t" "So luong" "\t" "Layer") pw)
(foreach n lst
  (write-line (strcat (vl-prin1-to-string (cadr (car n))) "\t" (itoa (cdr n)) "\t" (car (car n))) pw))
(close pw) )
(defun LM:ListOccurrences (lst) ;Thank Lee Mac
(if lst
  (cons
   (cons (car lst) (- (length lst) (length (vl-remove (car lst) (cdr lst)))))
   (LM:ListOccurrences (vl-remove (car lst) (cdr lst))))))
 

Lips hay quá bác Hà. Nhưng bác giúp em làm thế nào để thống kê thanh (không cần dim) xuất ra bảng trong CAD gồm:

1. STT

2. LAYER

3. Kích thước

4. Số lượng

 

Cám ơn bác nhiều

[kientamarch 0]

Mình vẽ kết cấu thép sàn, mỗi lần vẽ  phải đo thủ công chiều dài và chiều rộng của sàn , sau đó mới dùng máy tính chia chiều dài hoặc  chiều rộng đó ra khoảng cách a của cốt thép  . các anh chị nào có lisp giống lệnh Measure, bằng cách chia đoạn thẳng thành nhiều đoạn với khoảng cách cho trước, sau đó ghi ra thành text là một con số các đoạn thẳng mà mình muốn  chia, sau đó mình chỉ edit text sửa thành ví dụ 8 phi 8 a 200 hoặc 6 phi 12 a 200.....cám ơn trước