Chuyển đến nội dung
Diễn đàn CADViet

tientracdia

Thành viên
  • Số lượng nội dung

    145
  • Đã tham gia

  • Lần ghé thăm cuối

Bài đăng được đăng bởi tientracdia


  1. Xin chân thành cám ơn tất cả các bạn đã giúp.

    Xin nhờ bạn giúp cho việc xuất các text của lớp Main_STT ( trong đa giác ) và text lớp Main_CDTN tại các đỉnh hay gần đỉnh đa giác trên ra file csv theo hàng ngang trong từng đa giác theo tên của lớp Main_STT . Mục đích để xuất cao độ tự nhiên của các mắt ô đỉnh đa giác.( STT, cdtn, cdtn , .... )

    http://www.cadviet.com/upfiles/3/114381_ycau5.dwg

    Rất cám ơn


  2. Hề hề hề,

    Bác này trốn việc nhanh thế. Thực ra thì việc trả lời bạn ấy không dễ dàng gì vì bạn ấy không gửi cái bản vẽ không xuất được text đó lên. Thôi thì cứ trả lời theo kiểu đoán mò của mình vậy.

    1/- Có thể bạn ấy vẽ lwpolyline không phải là màu 63.

    2/- Cũng có thể bạn ấy vẽ bẳng lệnh line chứ không phải là polyline. Vì thế mà không chọn được đối tượng cũng như hàm acet-geom-vertex-list không có tác dụng.

    3/- Việc tạo bộ chọn có cả màu và layer thực chất chỉ nhằm để tránh chọn nhầm đối tượng mà thôi. Tuy nhiên nếu không quản lý đối tượng tốt thì sẽ lại là việc gây cản trở cho lisp. Vì vậy người dùng rất cần phải hiểu rõ về bộ chọn này.

     

    Hề hề hề, hy vọng rằng bác không bực mình vì trả lời mò thế này.

    Hề hề hề.

    Xin lỗi, mình đã gởi bản vẽ yêu cầu xuất ra cvs phần trên. mong được bạn giúp


  3. Chú ý là các đa giác phải cùng màu và cùng lớp với circle nhé.

    
    (defun c:xt2ex (/ oldos sslst tlst filename f sslst1 C1 C2 C3 C4 C5 C6 C7 C8 )
    (vl-load-com)
    (command "undo" "be")
    (setq oldos (getvar "osmode"))
    (setvar "osmode" 0)
    (setq sslst (acet-ss-to-list (ssget (list (cons 0 "LWPOLYLINE") (cons 62 63) (cons 8 "Main_tach_o"))))
             tlst ""   )
    (setq filename (getfiled "Select a File" "" "csv" 1))
    (setq f (open filename "w"))
    (write-line "Main_STT,Main_H_Dap,Main_S_Dap,Main_V_Dap,Main_H_Dao,Main_S_Dao,Main_V_Dao,Main_S_O," f)
    (foreach e sslst
    	(setq sslst1 (acet-ss-to-list (ssget "wp" (acet-geom-vertex-list e)
                                                                             (list (cons 0 "text")) 	))  )
    	(setq C1 nil C2 nil C3 nil C4 nil C5 nil C6 nil C7 nil C8 nil)
    	(foreach en sslst1
                     (if (= (cdr (assoc 8 (entget en))) "Main_STT")
                         (setq C1 (cdr (assoc 1 (entget en))) )
                     )
    	)
    	(foreach en sslst1
                     (if (= (cdr (assoc 8 (entget en))) "Main_H_Dap")
                         (setq C2 (cdr (assoc 1 (entget en))) )
                     )
    	)
    	(foreach en sslst1
                     (if (= (cdr (assoc 8 (entget en))) "Main_S_Dap")
        				(setq C3 (cdr (assoc 1 (entget en))) )
                     )
    	)
    	(foreach en sslst1
                     (if (= (cdr (assoc 8 (entget en))) "Main_V_Dap")
                         (setq C4 (cdr (assoc 1 (entget en))) )
                     )
    	)
    	(foreach en sslst1
                     (if (= (cdr (assoc 8 (entget en))) "Main_H_Dao")
                         (setq C5 (cdr (assoc 1 (entget en))) )
                     )
    	)
    	(foreach en sslst1
                     (if (= (cdr (assoc 8 (entget en))) "Main_S_Dao")
        				(setq C6 (cdr (assoc 1 (entget en))) )
                     )
    	)
    	(foreach en sslst1
                     (if (= (cdr (assoc 8 (entget en))) "Main_V_Dao")
                         (setq C7 (cdr (assoc 1 (entget en))) )
                     )
    	)
    
    	(foreach en sslst1
                     (if (= (cdr (assoc 8 (entget en)))  "Main_S_O")
        				(setq C8 (cdr (assoc 1 (entget en))) )
                     )
    	)
    	(setq tlst (strcat (if C1 C1 " ") (chr 44) (if C2 C2 " ") (chr 44) (if C3 C3 " ") (chr 44) (if C4 C4 " ") (chr 44)
                                       (if C5 C5 " ") (chr 44) (if C6 C6 " ") (chr 44) (if C7 C7 " ") (chr 44) (if C8 C8 " ") (chr 44) ))
    	(write-line tlst f)
    	(setq tlst "")
    )
    (close f)
    (setvar "osmode" oldos)
    (command "undo" "e")
    (princ)
    )
    

    Vẩn không xuất ra cvs được bạn ơi

    Nhưng tại sao mình lại chuyển cùng màu và cùng lớp vậy bạn ?

    khi đã thay đổi

    (setq sslst (acet-ss-to-list (ssget (list (cons 0 "LWPOLYLINE") (cons 62 63) (cons 8 "Main_tach_o"))))

    tlst "" )

    http://www.cadviet.com/upfiles/3/114381_ycau4.dwg


  4. Cám ơn bạn phanthangbinh, lisp của bạn viết xuất ra excel rất tuyệt.

    Nhưng khi thành phần trong vòng tròn có thay đổi ( Không có khồi lượng đào hay đấp bị xóa đi ) , như trường hợp A, thì ô tính thể tích chung xuất ra excel không đúng vào cột . Có khả năng lisp chưa kiểm soát nội dung lop trong vòng tròn xuất đúng vào cột trên excel.

    Với trường hợp B chỉ có ô vòng tròn dạng thể hiện 1 nội dung đào, đấp thì lisp xuất không đúng vào vị trí cột

    rất mong được bạn giúp


  5. cám ơn Bạn, Vấn đề này hơi phức tạp ha..

    Trước tiên mình muốn xuất các nội dung trong vòng tròn ra file excel khi chọn toàn bộ các vòng tròn đó theo hàng ngang với thứ tự Main_H_Dap Main_S_Dap Main_V_Dap Main_H_Dao Main_V_Dao Main_S_Dao Main_S_O

    rất cám ơn bạn giúp

    http://www.cadviet.com/upfiles/3/114381_114381_yeu_cau_xuat_ra_excel.rar


  6. Mình muốn xuất số liệu từ Cad sang excel của bản vẽ san nền ra file excel với thứ tự như sau:

    1. Cao độ tự nhiên tại các mắt ô lưới lớp CDTN.

    2. Xuất các nội dung trong vòng tròn ghi kết quả tính khối lượng gồm : STT, CCTC, Dtich và khối lượng ( đào , đấp ) theo lớp đã thể hiện trên bản vẽ.

    việc xuất theo thứ tự của số liệu ô lưới, nhỏ trước, lớn sau.

    Rất cám ơn được bạn giúp.


  7. Mình có sưu tàm file lisp này dùng để khóa lisp;

    Nhờ các anh hướng dẫn cho nội dung của lisp này và cách sử dụng

    
    ; pfc is stand for Password For Code
    ;    	Design by  : Adesu <Ade Suharna>
    ;    	Email  	: mteybid@yuasabattery.co.id
    ;    	Homepage   : http://www.yuasa-battery.co.id
    ;    	Create 	: 13 July 2006
    ;    	Program no.: 0381/07/2006
    ;    	Edit by	: Adesu   14/07/2006  	1).
    
    

    Rất cám ơn


  8. Trước đây mình cũng có viết một hàm vẽ HCN với yêu cầu khác của bạn một chút.

    Bạn có thể tham khảo để thấy được kết quả trong khi chọn điểm thứ ba.

    (defun RectangPts (p1 p2 rp3 rp4 / a )
    (setq a (angle p1 p2))
    (set rp4 (inters p1 (polar p1 (+ a (/ pi 2)) 100) (eval rp3) (polar (eval rp3) a 100) nil))
    (set rp3 (polar (eval rp4) a (distance p1 p2)))
    )
    
    (defun C:RotateRectang (/ n p1 p2 p3 p4 a grdat om)
    (setq p1 (getpoint "\nPoint 1:") p2 (getpoint p1 "\nPoint 2:") a (angle p1 p2))
    (while (/= 3 n)
    	(setq grdat (grread t 7 0) n (car grdat) p3 (cadr grdat))
    (if (eq 5 n)
    		(progn
    			(redraw)(RectangPts p1 p2 'p3 'p4 )
    			(grvecs (list -7 p1 p2 p2 p3 p3 p4 p4 p1) )
    	)	)
    )
    (setq om (getvar "osmode"))
    (setvar "osmode" 0)
    (redraw)(RectangPts p1 p2 'p3 'p4 )
    (command "PLINE" p1 p2 p3 p4 "c" )
    (setvar "osmode" om)
    )

    Nhờ Bạn chỉnh lisp vẽ kiễu nhà dựa trên lisp vẽ hình chữ nhật trên, mong duoc giup do

    Cám ơn

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


  9. ui sr, ko đọc kỹ đề bài ^^! Edit ...

    (defun GET-TEXT ()
     (princ "\nChon cac cao trinh san lap <TEXT>: ")
     (while (null (setq Hsl (ssget '((0 . "TEXT")))))
    (princ "\n**You selected NOTHING!**")
     )
    )
    (defun c:KLG1 (/ DT ENT HSL ID INDEX RESULT TXT VALUE KL)
     (GET-TEXT)
     (while (/= Hsl nil)
    (while
     	(or (null
    (setq dt (car (entsel "\nDien tich o: ")))
      )
      (/= (cdr (assoc 0 (entget dt))) "TEXT")
      (null (numberp (read (cdr (assoc 1 (entget dt))))))
     	)
      	(princ "\nDien tich o: ")
    )
    (while
     	(or (null
    (setq kl (car (entsel "\nKhoi luong: ")))
      )
      (/= (cdr (assoc 0 (entget kl))) "TEXT")
      (null (numberp (read (cdr (assoc 1 (entget kl))))))
     	)
      	(princ "\nKhoi luong: ")
    )
    (setq dt (atof (cdr (assoc 1 (entget dt)))))
    (setq kl (atof (cdr (assoc 1 (entget kl)))))
    (setq index 0
      id 0
      result 0
    )
    (repeat (sslength Hsl)
     	(setq ent   (entget (ssname Hsl index))
    value (read (cdr (assoc 1 ent)))
    index (1+ index)
     	)
     	(if (numberp value)
      (setq result (+ result value)
     id 	(1+ id)
      )
     	)
    )
    (setq result (- (/ (*  kl (1+ id)) dt) result))
    (while (null (setq txt (entsel "\nChoose TEXT to replace: ")))
     	(princ "\n**You selected NOTHING!**")
    )
    (setq txt (entget (car txt))
      txt (subst (cons 1 (rtos result 2 2)) (assoc 1 txt) txt)
    )
    (entmod txt)
    (setq Hsl (ssget '((0 . "TEXT"))))
     )
     (princ)
    )
    

    @girl: đây là lisp mình viết lâu rùi, đáp ứng chính xác nhu cầu của bạn. (Trước đây mình cũng làm san nền, hay explode HS để chỉnh sửa ;) ).

    (defun GET-TEXT ()
     (princ "\nChon cac cao trinh san lap <TEXT>: ")
     (while (null (setq Hsl (ssget '((0 . "TEXT")))))
    (princ "\n**You selected NOTHING!**")
     )
    )
    (defun c:KLG (/ DT ENT HSL ID INDEX RESULT TXT VALUE)
     (GET-TEXT)
     (while (/= Hsl nil)
    (while
     	(or (null
    (setq dt (car (entsel "\nDien tich o: ")))
      )
      (/= (cdr (assoc 0 (entget dt))) "TEXT")
      (null (numberp (read (cdr (assoc 1 (entget dt))))))
     	)
      	(princ "\nDien tich o: ")
    )
    (setq dt (atof (cdr (assoc 1 (entget dt)))))
    (setq index 0
      id 0
      result 0
    )
    (princ "\n>>Expression: (")
    (repeat (sslength Hsl)
     	(setq ent   (entget (ssname Hsl index))
    value (read (cdr (assoc 1 ent)))
    index (1+ index)
     	)
     	(if (numberp value)
    (progn
      (setq result (+ result value)
     id 	(1+ id)
      )
      (if (/= index 1)
    (princ " + ")
      )
      (princ (rtos value 2 2))
    )
     	)
    )
    (setq result (/ (float result) id))
    (princ (strcat ") / " (rtos id 2 0)))
    (princ (strcat "\n>>Htb = " (rtos result 2 2)))
    (princ (strcat "\nDien tich = " (rtos dt 2 2)))
    (setq result (* result dt))
    (princ (strcat "\n>>Volumn = " (rtos result 2 2)))
    (while (null (setq txt (entsel "\nChoose TEXT to replace: ")))
     	(princ "\n**You selected NOTHING!**")
    )
    (setq txt (entget (car txt))
      txt (subst (cons 1 (rtos result 2 2)) (assoc 1 txt) txt)
    )
    (entmod txt)
    (setq Hsl (ssget '((0 . "TEXT"))))
     )
     (princ)
    )
    

    ;;;-----------------------------

    Mình nhờ các Anh chỉnh giúp mình để chỉnh Lisp trên để thực hiện tính chênh cao trung bình các ô lưới :

    1. Chọn các text Chênh cao trung bình, xong enter chọn text thay thế nếu chưa có thì ghi kết quả CCTB tại điểm chọn và ghi nhớ nó,

    2. Tiếp chọn Text Diện tích, thực hiện phép tính ( CCTB*Diện tích= Khối lượng )

    3. Chọn text ghi thay thế Khối lượng, nếu chưa có thì ghi vào điểm chọn.

    Rất Mong được các anh giúp


  10. Cám ơn Bạn, file này thì được khi xuất ra Excel, nhưng trên Cad thì các só theo hàng thể hiện lại bằng 0.

    Mình có thể nhờ bạn giúp cho việc xuất các sồ trên ra excel theo một qui luật, như sau :

    1. Chọn theo đường bao đa giác bất kỳ.

    2. Xuất nội dung theo lớp khi chọn đường bao đó

    3. xuất ra excel theo từng hàng ngang theo thứ tự sau STT ô - CDTN1,2............. -Diện tích

    File gởi kèm

    http://www.cadviet.com/upfiles/3/114381_ycau_1_1.dwg

    Rất mong được bạn giúp.


  11. Bạn hãy nói rõ lỗi xuất hiện từ lúc nào trong quá trình chạy? Sau khi lỗi, nhấn F2, copy và paste lên đây xem. Tôi đang nghi ngờ ở 1 chỗ.

    Chon diem dat bang

    Nhap chieu cao chu: 1

     

    Select objects: Specify opposite corner: 6 found

     

    Select objects:

    ; error: no function definition: ACET-SS-TO-LIST

     

    Lỗi như thế này đó bạn


  12. Hề hề hề,

    Phiền bạn test thử cái lisp này coi đã ưng ý chưa nhé.

    
    (defun c:xtxt ()
    (vl-load-com)
    (setq oldos (getvar "osmode"))
    (setvar "osmode" 0)
    (setq tmp (getfiled "Chon file xuat Text goc" (getvar "dwgprefix") "csv;txt" 1))
    (setq fw (open tmp "w"))
    (setq p1 (getpoint "\n Chon diem dat bang"))
    (setq h (getreal "\n Nhap chieu cao chu: "))
    (alert "\n Chon lan luot cac text can xuat trong mot nhom ")
    (setq sst (ssget (list (cons 0 "*text"))))
    (while sst
    (setq sstl (acet-ss-to-list sst)
      			p2 (polar p1 0 (* 8 h))
      			p3 (polar p2 0 (* 8 h))
      			p4 (polar p3 0 (* 8 h))
      			p5 (polar p4 0 (* 8 h))
      			p6 (polar p5 0 (* 8 h))
      			p7 (polar p6 0 (* 8 h))
      			p8 (polar p7 0 (* 8 h))
      			p9 (polar p8 0 (* 8 h))
      			p11 (polar p1 (- (/ pi 2)) (* 4 h))
      			p12 (polar p2 (- (/ pi 2)) (* 4 h))
      			p13 (polar p3 (- (/ pi 2)) (* 4 h))
      			p14 (polar p4 (- (/ pi 2)) (* 4 h))
      			p15 (polar p5 (- (/ pi 2)) (* 4 h))
      			p16 (polar p6 (- (/ pi 2)) (* 4 h))
      			p17 (polar p7 (- (/ pi 2)) (* 4 h))
      			p18 (polar p8 (- (/ pi 2)) (* 4 h))
      			p19 (polar p9 (- (/ pi 2)) (* 4 h))
      			p21 (list (+ (car p1) (* 4 h)) (- (cadr p1) (* 2 h)))
      			k 0
      			txl ""
    )
    (command "pline" p1 p9 p19 p11 "c")
    (command "pline" p2 p12 "" )
    (command "pline" p3 p13 "" )
    (command "pline" p4 p14 "" )
    (command "pline" p5 p15 "" )
    (command "pline" p6 p16 "" )
    (command "pline" p7 p17 "" )
    (command "pline" p8 p18 "" )
    (foreach txt sstl
               (setq t1 (cdr (assoc 1 (entget txt)))                      
                         txl (strcat txl t1 ",")  )
               (command "text" "j" "mc" (list (+ (car p21) (* k 8 h)) (cadr p21)) h 0 t1)
               (setq  k (1+ k ) )
    )
    (write-line txl fw)
    (alert "\n Tiep tuc chon lan luot cac text can xuat cho nhom ke tiep")
    (setq sst (ssget (list (cons 0 "*text"))))
    (setq p1 p11)
    )
    (close fw)
    (setvar "osmode" oldos)
    (princ)
    )
    

    Chúc bạn vui.

    Cám ơn Bạn.

    Lisp của bạn khi xuất ra Excel rất chuẩn, mình xin nhờ bạn giúp cho việc : vì số lượng text cần xuất ra excel rất lớn, khi tạm ngưng muốn xuất tiếp tục và ghi nối và file cũ đã xuất trước đó, cho đỡ ghép các file lại với nhau.

    Không cần việc xuất ra bảng cad mà chỉ ra và ghi vào file excel thôi

    Cám ơn

×