Đến nội dung


Hình ảnh
- - - - -

[Nhờ sữa lisp] xuất khối lượng qua excell


  • Please log in to reply
4 replies to this topic

#1 huunhantvxdts

huunhantvxdts

    biết dimbaseline

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

Đã gửi 13 August 2014 - 10:19 AM

Đây là lisp mình sửa lại để phục vụ cho công việc của mình

nhưng đang bị lỗi không xuất được những trắc ngang cuối cùng khoảng 7-8 trắc ngang chi đó

nhờ mọi người giúp đỡ

đây là lisp

 (defun c:Nhan (/ lstkm point kcach point1 pointtim diemtam)
 (defun sosanh (e1 e2 / p1 p2)
	(setq p1 (car e1)
		p2 (car e2)
	)
	(if (equal (cadr p1) (cadr p2) fuzz)
		(< (car p1) (car p2))
		(> (cadr p1) (cadr p2))
	)
	)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (prompt "\nChon doi tuong coc hoac ly trinh lam lop chuan.")  
  (setq dtltc (car (entsel)))
  (setq lop1 (cdr (assoc 8 (entget dtltc))))
  (prompt "\nChon doi tuong ghi dien tich lam lop chuan.")
  (setq lop2 (car (entsel)))
  (setq lop2 (cdr (assoc 8 (entget lop2))))
  ;(setq cot (getint "\nSo cot can xuat ra Excel:"))
(setq danhsachkm (acet-ss-to-list (ssget (list (cons 8 lop1) (cons 1 "K*")))))
(setq lstkm (mapcar '(lambda (e) (cons (cdr (assoc 11 (entget e))) (cdr (assoc 1 (entget e))))) danhsachkm))
(setq lstkm (vl-sort lstkm '(lambda(x y / tmx tmy) (setq tmx (timlt x) tmy (timlt y))
               (or (< (car tmx) (car tmy))
   (and (= (car tmx) (car tmy)) (< (last tmx) (last tmy)))))))
(setq ss (acet-ss-to-list (ssget "X" '((0 . "LINE")(8 . "ENTTNTUNHIEN")))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq fn (getfiled "Chon file de save" "" "csv" 1))
(setq fid (open fn "w"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(foreach ent lstkm
(setq point (car ent))
(setq kcach (distance point (cdr (assoc 11 (entget (nth 0 ss))))))
(foreach enxt ss
(setq point1 (cdr (assoc 11 (entget enxt))))
(setq toay (cadr point1))
(if (and (< (distance point1 point) kcach) (< toay (cadr point)) (equal (car point1) (car point) 1))
(progn
(setq pointtim (cdr (assoc 11 (entget enxt))))
(setq kcach (distance pointtim point))
)
)
)
(setq diemtam (polar pointtim (/ pi 2) (/ kcach 2)))
(command "ZOOM" "c" diemtam (+ kcach 5))
(setq dd (acet-ss-to-list (ssget "C" (polar pointtim (/ pi 4) 0.1 ) (polar pointtim (/ pi -4) 0.1 ) '((0 . "LINE")(8 . "ENTTNTUNHIEN")))))
(setq diemdau (cdr (assoc 10 (entget (car dd)))))
(setq diemcuoi (cdr (assoc 11 (entget (car dd)))))
(setq diemtren (polar point (/ pi 2) 3))
(command ".RECTANGLE" diemdau diemtren)
(setq text (ssget "C" diemdau diemtren (list (cons 0 "text"))))
(setq lst0 (ss2ent text lop1))
(setq lst0 (mapcar '(lambda (e) (cons (cdr (assoc 10 (entget e))) (cdr (assoc 1 (entget e))))) lst0))
(setq lst2 (ss2ent text lop2))
(setq lst2 (mapcar '(lambda (e) (cons (cdr (assoc 10 (entget e))) (cdr (assoc 1 (entget e))))) lst2))
(setq
	caotext (cdr (assoc 40 (entget (ssname text 0))))
	fuzz (* caotext 1.0)
	lst0 (vl-sort lst0 'sosanh)
	lst2 (vl-sort lst2 'sosanh)
	index 1
	oldy nil
)
(setq xuongdong 1)
	(foreach em lst0
	(if (= dong 0)
	(progn
	   (princ (cdr em) fid)
	   (princ "\n" fid)
	)
	(progn
	(if (= xuongdong 1)
	   (progn
	   (princ "\n" fid)
	   (princ (cdr em) fid)
	   (princ "\n" fid)
	   (setq xuongdong 2)
	   )
	(princ (cdr em) fid)
	)
	)
	)
	)
(setq dong 1)
	(foreach en lst2
	(if (equal oldy (cadr (car en)) fuzz)
  		(progn
     			(if (< index 4)
  			(progn
        		(princ "," fid)
        		(setq index (1+ index))
  			)
       		(progn
       		(setq index 1)
       		(princ "\n" fid)
       		)
      		)
  		)
 		(progn
  		(if hangdau
            		(progn
            		(setq index 1)
            		(princ "\n" fid)
           	 )
   		(setq hangdau t)
   		)
 		)
	)
	(princ (cdr en) fid)
	(setq oldy (cadr (car en)))
	)
(command ".RECTANGLE" diemcuoi diemtren)
(setq text1 (ssget "C" diemcuoi diemtren (list (cons 0 "text"))))
(setq lst3 (ss2ent text1 lop2))
(setq lst3 (mapcar '(lambda (e) (cons (cdr (assoc 10 (entget e))) (cdr (assoc 1 (entget e))))) lst3))
(setq
	lst3 (vl-sort lst3 'sosanh)
	index 1
	oldy nil
)
(setq dong 1)
	(foreach en lst3
	(if (equal oldy (cadr (car en)) fuzz)
  		(progn
     			(if (< index 4)
  			(progn
        		(princ "," fid)
        		(setq index (1+ index))
  			)
       		(progn
       		(setq index 1)
       		(princ "\n" fid)
       		)
      		)
  		)
 		(progn
  		(if hangdau
            		(progn
            		(setq index 1)
            		(princ "\n" fid)
           	 )
   		(setq hangdau t)
   		)
 		)
	)
	(princ (cdr en) fid)
	(setq oldy (cadr (car en)))
	)
)
)

(defun timlt (st / tm)
  (setq tm (vl-string->list (substr (strcase (cdr st)) (+ 3 (vl-string-search "KM" (strcase (cdr st)))))))
  (read (strcat "(" (vl-list->string (subst 32 43 (subst 32 58 tm))) ")"))
)
(defun ss2ent (ss lop / sodt index lstent)
(setq
sodt (if ss
(sslength ss)
0
)
index 0
)
(repeat sodt
(setq ent (ssname ss index))
(setq index (1+ index))
(if (= (cdr (assoc 8 (entget ent))) lop)
(setq lstent (cons ent lstent))
)
)
(reverse lstent)

)

đây là file thực hiện

http://www.cadviet.c...dc_dia_chat.dwg


  • 0

#2 Tot77

Tot77

    biết lệnh adcenter

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

Đã gửi 13 August 2014 - 02:20 PM

Không biết cái này có được không, test thì vẫn đưa ra đủ.

Tôi phải sửa cho nó gọn lại cho dễ nhìn.

 (defun c:Nhan (/ lstkm point kcach point1 pointtim diemtam)
   (defun sosanh (e1 e2 / p1 p2)
(setq p1 (car e1)
p2 (car e2)
)
(if (equal (cadr p1) (cadr p2) fuzz)
(< (car p1) (car p2))
(> (cadr p1) (cadr p2))
)
   )
   
   (defun inra(lst)
    (setq index 1
 oldy nil)
    (foreach en lst
      (if (equal oldy (cadr (car en)) fuzz)
(progn (if (< index 4)
 (progn (princ "," fid) (setq index (1+ index)))
 (progn (setq index 1) (princ "\n" fid) )
       )
    )
(progn  (if hangdau
 (progn (setq index 1) (princ "\n" fid))
 (setq hangdau t))
  )
      )
      (princ (cdr en) fid)
      (setq oldy (cadr (car en)))
    )
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (prompt "\nChon doi tuong coc hoac ly trinh lam lop chuan.")  
  (setq dtltc (car (entsel)))
  (setq lop1 (cdr (assoc 8 (entget dtltc))))
  (prompt "\nChon doi tuong ghi dien tich lam lop chuan.")
  (setq lop2 (car (entsel)))
  (setq lop2 (cdr (assoc 8 (entget lop2))))
  ;(setq cot (getint "\nSo cot can xuat ra Excel:"))
  (setq danhsachkm (acet-ss-to-list (ssget (list (cons 8 lop1) (cons 1 "K*")))))
  (setq lstkm (mapcar '(lambda (e) (cons (cdr (assoc 11 (entget e))) (cdr (assoc 1 (entget e))))) danhsachkm))
  (setq lstkm (vl-sort lstkm '(lambda(x y / tmx tmy) (setq tmx (timlt x) tmy (timlt y))
                 (or (< (car tmx) (car tmy))
    (and (= (car tmx) (car tmy)) (< (last tmx) (last tmy)))))))
  (setq ss (acet-ss-to-list (ssget "X" '((0 . "LINE")(8 . "ENTTNTUNHIEN")))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (setq fn (getfiled "Chon file de save" "" "csv" 1))
  (setq fid (open fn "w"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (foreach ent lstkm
    (setq point (car ent))
    (setq kcach (distance point (cdr (assoc 11 (entget (nth 0 ss))))))
    (foreach enxt ss
      (setq point1 (cdr (assoc 11 (entget enxt))))
      (setq toay (cadr point1))
      (if (and (< (distance point1 point) kcach) (< toay (cadr point)) (equal (car point1) (car point) 1))
(progn
 (setq pointtim (cdr (assoc 11 (entget enxt))))
 (setq kcach (distance pointtim point))
)
      )
    )
    (setq diemtam (polar pointtim (/ pi 2) (/ kcach 2)))
    (command "ZOOM" "c" diemtam (+ kcach 5))
    (setq dd (acet-ss-to-list (ssget "C" (polar pointtim (/ pi 4) 0.1 ) (polar pointtim (/ pi -4) 0.1 ) '((0 . "LINE")(8 . "ENTTNTUNHIEN")))))
    (setq diemdau (cdr (assoc 10 (entget (car dd)))))
    (setq diemcuoi (cdr (assoc 11 (entget (car dd)))))
    (setq diemtren (polar point (/ pi 2) 3))
    
    (command ".RECTANGLE" diemdau diemtren)
    (setq text (ssget "C" diemdau diemtren (list (cons 0 "text"))))
    (setq lst0 (ss2ent text lop1))
    (setq lst0 (mapcar '(lambda (e) (cons (cdr (assoc 10 (entget e))) (cdr (assoc 1 (entget e))))) lst0))
    (setq lst2 (ss2ent text lop2))
    (setq lst2 (mapcar '(lambda (e) (cons (cdr (assoc 10 (entget e))) (cdr (assoc 1 (entget e))))) lst2))
    (setq
caotext (cdr (assoc 40 (entget (ssname text 0))))
fuzz (* caotext 1.0)
lst0 (vl-sort lst0 'sosanh)
lst2 (vl-sort lst2 'sosanh)
    )
    (setq xuongdong 1)
    (foreach em lst0
(if (= dong 0)
 (progn (princ (cdr em) fid) (princ "\n" fid))
 (if (= xuongdong 1)
   (progn (princ "\n" fid) (princ (cdr em) fid) (princ "\n" fid) (setq xuongdong 2))
   (princ (cdr em) fid)
)
      )
    ) 
    (inra lst2)
 
    (command ".RECTANGLE" diemcuoi diemtren)
    (setq text1 (ssget "C" diemcuoi diemtren (list (cons 0 "text"))))
    (setq lst3 (ss2ent text1 lop2))
    (setq lst3 (mapcar '(lambda (e) (cons (cdr (assoc 10 (entget e))) (cdr (assoc 1 (entget e))))) lst3))
    (setq lst3 (vl-sort lst3 'sosanh))
    (inra lst3)
  )
  (if fid (close fid))
)
 
(defun timlt (st / tm)
  (setq tm (vl-string->list (substr (strcase (cdr st)) (+ 3 (vl-string-search "KM" (strcase (cdr st)))))))
  (read (strcat "(" (vl-list->string (subst 32 43 (subst 32 58 tm))) ")"))
)
 
(defun ss2ent (ss lop / sodt index lstent)
  (setq sodt (if ss (sslength ss) 0)
index 0)
  (repeat sodt
    (setq ent (ssname ss index))
    (setq index (1+ index))
    (if (= (cdr (assoc 8 (entget ent))) lop)
      (setq lstent (cons ent lstent))
    )
  )
  (reverse lstent)
)
 

  • 1

#3 huunhantvxdts

huunhantvxdts

    biết dimbaseline

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

Đã gửi 13 August 2014 - 02:34 PM

Cám ơn bạn 

để tôi kiểm tra lại


  • 0

#4 huunhantvxdts

huunhantvxdts

    biết dimbaseline

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

Đã gửi 13 August 2014 - 03:02 PM

Không biết cái này có được không, test thì vẫn đưa ra đủ.

Tôi phải sửa cho nó gọn lại cho dễ nhìn.

 

 (defun c:Nhan (/ lstkm point kcach point1 pointtim diemtam)
   (defun sosanh (e1 e2 / p1 p2)
(setq p1 (car e1)
p2 (car e2)
)
(if (equal (cadr p1) (cadr p2) fuzz)
(< (car p1) (car p2))
(> (cadr p1) (cadr p2))
)
   )
   
   (defun inra(lst)
    (setq index 1
 oldy nil)
    (foreach en lst
      (if (equal oldy (cadr (car en)) fuzz)
(progn (if (< index 4)
 (progn (princ "," fid) (setq index (1+ index)))
 (progn (setq index 1) (princ "\n" fid) )
       )
    )
(progn  (if hangdau
 (progn (setq index 1) (princ "\n" fid))
 (setq hangdau t))
  )
      )
      (princ (cdr en) fid)
      (setq oldy (cadr (car en)))
    )
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (prompt "\nChon doi tuong coc hoac ly trinh lam lop chuan.")  
  (setq dtltc (car (entsel)))
  (setq lop1 (cdr (assoc 8 (entget dtltc))))
  (prompt "\nChon doi tuong ghi dien tich lam lop chuan.")
  (setq lop2 (car (entsel)))
  (setq lop2 (cdr (assoc 8 (entget lop2))))
  ;(setq cot (getint "\nSo cot can xuat ra Excel:"))
  (setq danhsachkm (acet-ss-to-list (ssget (list (cons 8 lop1) (cons 1 "K*")))))
  (setq lstkm (mapcar '(lambda (e) (cons (cdr (assoc 11 (entget e))) (cdr (assoc 1 (entget e))))) danhsachkm))
  (setq lstkm (vl-sort lstkm '(lambda(x y / tmx tmy) (setq tmx (timlt x) tmy (timlt y))
                 (or (< (car tmx) (car tmy))
    (and (= (car tmx) (car tmy)) (< (last tmx) (last tmy)))))))
  (setq ss (acet-ss-to-list (ssget "X" '((0 . "LINE")(8 . "ENTTNTUNHIEN")))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (setq fn (getfiled "Chon file de save" "" "csv" 1))
  (setq fid (open fn "w"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (foreach ent lstkm
    (setq point (car ent))
    (setq kcach (distance point (cdr (assoc 11 (entget (nth 0 ss))))))
    (foreach enxt ss
      (setq point1 (cdr (assoc 11 (entget enxt))))
      (setq toay (cadr point1))
      (if (and (< (distance point1 point) kcach) (< toay (cadr point)) (equal (car point1) (car point) 1))
(progn
 (setq pointtim (cdr (assoc 11 (entget enxt))))
 (setq kcach (distance pointtim point))
)
      )
    )
    (setq diemtam (polar pointtim (/ pi 2) (/ kcach 2)))
    (command "ZOOM" "c" diemtam (+ kcach 5))
    (setq dd (acet-ss-to-list (ssget "C" (polar pointtim (/ pi 4) 0.1 ) (polar pointtim (/ pi -4) 0.1 ) '((0 . "LINE")(8 . "ENTTNTUNHIEN")))))
    (setq diemdau (cdr (assoc 10 (entget (car dd)))))
    (setq diemcuoi (cdr (assoc 11 (entget (car dd)))))
    (setq diemtren (polar point (/ pi 2) 3))
    
    (command ".RECTANGLE" diemdau diemtren)
    (setq text (ssget "C" diemdau diemtren (list (cons 0 "text"))))
    (setq lst0 (ss2ent text lop1))
    (setq lst0 (mapcar '(lambda (e) (cons (cdr (assoc 10 (entget e))) (cdr (assoc 1 (entget e))))) lst0))
    (setq lst2 (ss2ent text lop2))
    (setq lst2 (mapcar '(lambda (e) (cons (cdr (assoc 10 (entget e))) (cdr (assoc 1 (entget e))))) lst2))
    (setq
caotext (cdr (assoc 40 (entget (ssname text 0))))
fuzz (* caotext 1.0)
lst0 (vl-sort lst0 'sosanh)
lst2 (vl-sort lst2 'sosanh)
    )
    (setq xuongdong 1)
    (foreach em lst0
(if (= dong 0)
 (progn (princ (cdr em) fid) (princ "\n" fid))
 (if (= xuongdong 1)
   (progn (princ "\n" fid) (princ (cdr em) fid) (princ "\n" fid) (setq xuongdong 2))
   (princ (cdr em) fid)
)
      )
    ) 
    (inra lst2)
 
    (command ".RECTANGLE" diemcuoi diemtren)
    (setq text1 (ssget "C" diemcuoi diemtren (list (cons 0 "text"))))
    (setq lst3 (ss2ent text1 lop2))
    (setq lst3 (mapcar '(lambda (e) (cons (cdr (assoc 10 (entget e))) (cdr (assoc 1 (entget e))))) lst3))
    (setq lst3 (vl-sort lst3 'sosanh))
    (inra lst3)
  )
  (if fid (close fid))
)
 
(defun timlt (st / tm)
  (setq tm (vl-string->list (substr (strcase (cdr st)) (+ 3 (vl-string-search "KM" (strcase (cdr st)))))))
  (read (strcat "(" (vl-list->string (subst 32 43 (subst 32 58 tm))) ")"))
)
 
(defun ss2ent (ss lop / sodt index lstent)
  (setq sodt (if ss (sslength ss) 0)
index 0)
  (repeat sodt
    (setq ent (ssname ss index))
    (setq index (1+ index))
    (if (= (cdr (assoc 8 (entget ent))) lop)
      (setq lstent (cons ent lstent))
    )
  )
  (reverse lstent)
)
 

Đúng như bạn nói chỉ chỉnh lại cho gọn thôi mà bây giờ nó lại xuất ra đúng

Vậy cái lúc đầu sai ở đâu???

Bạn thử  sử dụng cái lisp đầu cho ý kiến

1 lần nữa cám ơn bạn nhiều


  • 0

#5 Tot77

Tot77

    biết lệnh adcenter

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

Đã gửi 13 August 2014 - 04:02 PM

Chắc do bạn không (close fid). Bạn close file thì mở lại mới thấy nó thay đổi.


  • 0