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

NgọcH

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

    22
  • Đã tham gia

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

Bài đăng được đăng bởi NgọcH


  1. Vào lúc 30/9/2014 tại 17:21, nhoclangbat đã nói:

    - bạn cứ test thử nhiều trường hợp có lỗi pm nhoc hen ^^

    
    ;; free lisp from cadviet.com
    ;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/13750-lisp-tinh-gia-tri-trung-binh-cua-cac-text/page-3
    (defun mktext (point height string justify style  mau / lst)
    (setq lst (list '(0 . "TEXT")
                                  (cons 10 point)
    							  (cons 40 height)
    							  (cons 7 style)
    							  (cons 1 string)
    							  (cons 62 mau)
    			)
    			justify (strcase justify))
    		(cond   ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 11 point)))))
    		        ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))
    				((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))
    				((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))
    				)
    	(entmakex Lst)
      )	;end mktext
    ;;;;
    (prompt "Lenh tinh trung binh cong cac so: TBCC")
    (defun C:tbcc(/ c tong mstbc num ss pt ctext kq old sty)
    (setq old (getvar "osmode"))
    (setq sty (getvar "textstyle"))
    (setq c -1 tong 0 mstbc 0)
    (if (setq ss (ssget '((0 . "TEXT"))))
     (progn
        (while (setq ename (ssname ss (setq c (1+ c))))
          (if (setq num (distof (cdr (assoc 1 (entget ename)))))
    	      
              (setq tong (+ tong num) mstbc (1+ mstbc))
          );if
    	  (if ename
    	  (progn
    	  (setq ctext (cdr (assoc 40 (entget ename))))
    	  ;(setq glayer (cdr (assoc 8 (entget ename))))
    	  ;(setq gstyle (cdr (assoc 7 (entget ename))))
    	  )
    	  )
    	  
        );while
    	
    	
    	(if (null (zerop mstbc))
    	(progn
    	(setq kq (/ tong mstbc))
    	(setvar "osmode" 0)
    	(setq pt (getpoint "\nchon diem dat ket qua:"))
        (mktext pt ctext (rtos kq 2 3) "L" sty 1)
         );progn
        );if	 
    	
      );progn
      (alert "\nChua co doi tuong dc chon hoac ban chi chon toan text chu ^^")
    );if    
    (setvar "osmode" old)
    (princ)
    )
    

     

    Chào a, phiền a có thể chỉnh text xuất ra: 

    + layer và màu theo layer hiện hành

    + kiểu text theo kiểu text hiện hành

    + chiều cao chữ do mình tự chọn

    được không ạ


  2. 19 giờ trước, vietduc147258 đã nói:

    Vì lệnh này mà bỏ 2016 lên 2018. Tính ra cad mới lưu mạc định cũng 2018 nên cũng tiện nhiều thứ ghê. 

    Ngoài ra hình như có lệnh hplayer, textlayer, nữa thì phải. Có lệnh layer đường center line nữa

    e cảm ơn ạ, dùng lệnh này ổn rồi hehe


  3. Vào lúc 16/7/2012 tại 13:19, lp_hai đã nói:

    Mình nhớ trước đây có bạn yêu cầu lisp chọn những dt có vị trí trương đồng ở nhiều Mặt bằng khác nhau, có viết cho riêng trường hợp bạn ấy yêu cầu, kiểu chọn đối tượng là (ssget "W"), bạn test thử có giống như vậy không?

     

    
    (defun c:ss(/ dt lstp p01 p02 n id dtc p1 p2 stdc spt)
     (setq dt (ssadd)
    osm (getvar "osmode")
    )
     (setq p01(getpoint "\nchon diem goc 1:"))
     (command "ucs" "n" p01)
     (setvar "osmode" 0)
     (while (setq p1(getpoint"\nchon doi tuong:"))
    (setq p2(getcorner p1)
      lstp (append (list p1 p2) lstp))
    )
     (setq spt (/(length lstp)2)
    n 0)
     (repeat spt
    (setq dtc (ssget "W" (nth n lstp) (nth (+ n 1) lstp))
      n (+ n 2)
      )
    (setq sdtc (sslength dtc)
      id 0)
    (repeat sdtc
     	(setq dt (ssadd (ssname dtc id) dt)
    	id (1+ id))
     	)
    )
     (setvar "osmode" osm)
     ;;;;
     (while (setq p02 (getpoint "\nchon diem goc tiep theo:"))
    (command "ucs" "n" p02)
    (setvar "osmode" 0)
    (setq n 0)
    (repeat spt
     	(setq dtc (ssget "W" (nth n lstp) (nth (+ n 1) lstp))
      n (+ n 2)
      )
     	(setq sdtc (sslength dtc)
      id 0)
     	(repeat sdtc
    (setq dt (ssadd (ssname dtc id) dt)
      	id (1+ id))
    )
     	)
    (setvar "osmode" osm)
    )
     (command "ucs" "w")
     (sssetfirst dt dt) 
     (princ)
     )
    
     

     

    a cho e hỏi lisp này có chọn được các đối tượng giống nhau theo vị trí và số lượng ko ạ. 1 mặt bằng có rất nhiều tấm như này và e muốn tìm những tấm giống với tấm e khoanh đỏ kia

    image.png


  4. 23 giờ trước, cuongtk2 đã nói:
    
    (defun c:test ( / CK CK1 LISTCIRCLE LISTLINE SS nss)
    (setq ss (mapcar 'vlax-ename->vla-object (ACET-SS-TO-LIST(ssget))))
    (setq listcircle (vl-remove-if-not '(lambda (obj) (= "AcDbCircle" (vla-get-ObjectName obj))) ss)
          listline (vl-remove-if '(lambda (obj) (= "AcDbCircle" (vla-get-ObjectName obj))) ss))
      (SETQ nss (ssadd))
    (foreach circle listcircle
      (setq ck nil)
      (foreach line listline  
        (if (vlax-invoke circle 'intersectwith line acextendnone)
          (setq ck T))   ;if
        );foreach
      (if ck (setq nss (ssadd  (vlax-vla-object->ename circle) nss ))
        );if
      );foreach
      (command "select" nss "")
     ; (command "select" "_P" )  xu ly tiep theo cho nss 
      )

     

    e cảm ơn a, e nhận thấy lisp nó không xóa được các block phức tạp như gồm nhiều đoạn thẳng khác nhau hoặc block chứa nhiều đường cong và thi thoảng lisp nó không hoạt động. a có biết nguyên nhân vì sao không ạ

     


  5. Chào mọi người. Mọi người có thể giúp e hàm thống kê số lượng thanh được không ạ. Mỗi thanh loại thanh là pline có layer và chiều dài khác nhau. 

    Ví dụ kết quả trả về:

    .....

    H10: so thanh : 3 L=2500

    H10: so thanh : 1 L=2250

    H12: so thanh : 3 L=4000

    H12: so thanh 1 L=2000

    ........

    Do hàm VBA này e đang sử dụng và muốn chọn quét nó ra cả số lượng thanh nên mọi người có thể thêm tiếp vào file e để bên dưới được không ạ. em cảm ơn mọi người.

    test.dwg

    test.txt


  6. giả sử có trường hợp: các đối tượng đè là hình vuông hoặc hình tròn có kích thước khác nhau ( ví dụ có đường tròn bán kính 50, 100. hình vuông cạnh 50, 100) thì lisp kia a có thể thêm 1 thao tác là chọn đối tượng muốn xóa sau khi gõ lệnh không ạ.

    - ví dụ e chỉ muốn xóa đường tròn bán kinh 50 thì sẽ có thêm 1 bước chọn object (đường tròn bán kính 50) hoặc xóa hình vuông thì chọn hình vuông,... và nó chỉ xóa những đối tượng cùng thuộc tính, kích thước với đối tượng mình đã chọn.

    - A có thể làm 2 lisp:

    + xóa luôn ko cần chọn đối tượng sau khi lọc

    + có chọn đối tượng sau khi lọc

    ví e test 2 lisp a gửi thì lisp chọn đối tượng nó chạy sẽ lâu hơn là ko cần chọn đối tượng.

    e cảm ơn a ạ


  7. 2 giờ trước, cuongtk2 đã nói:
    
    (defun c:test ( / CK CK1 LISTCIRCLE LISTLINE SS nss)
    (setq ss (mapcar 'vlax-ename->vla-object (ACET-SS-TO-LIST(ssget))))
    (setq listcircle (vl-remove-if-not '(lambda (obj) (= "AcDbCircle" (vla-get-ObjectName obj))) ss)
          listline (vl-remove-if '(lambda (obj) (= "AcDbCircle" (vla-get-ObjectName obj))) ss))
      (SETQ nss (ssadd))
    (foreach circle listcircle
      (setq ck nil)
      (foreach line listline  
        (if (vlax-invoke circle 'intersectwith line acextendnone)
          (setq ck T))   ;if
        );foreach
      (if ck (setq nss (ssadd  (vlax-vla-object->ename circle) nss ))
        );if
      );foreach
      (command "select" nss "")
     ; (command "select" "_P" )  xu ly tiep theo cho nss 
      )

    có cách nào mà nó chọn luôn không cần gõ lại lệnh khum a

     

     


  8. Vào lúc 8/8/2024 tại 15:15, cuongtk2 đã nói:
    
    (defun c:test ( / CK CK1 LISTCIRCLE LISTLINE SS)
    (setq ss (mapcar 'vlax-ename->vla-object (ACET-SS-TO-LIST(ssget))))
    (setq listcircle (vl-remove-if-not '(lambda (obj) (= "AcDbCircle" (vla-get-ObjectName obj))) ss)
          listline (vl-remove-if '(lambda (obj) (= "AcDbCircle" (vla-get-ObjectName obj))) ss))
    (foreach circle listcircle
      (setq ck nil)
      (foreach line listline    
         (setq ck1 (vlax-invoke circle 'intersectwith line acextendnone))
        (if ck1 (setq ck ck1))   
        )
      (if ck (vla-delete circle))
      )
      )

     

    thực sự cảm ơn a rất nhiều, nó hoạt động rất hiệu quả. thay vì nó xóa luôn thì mình có thể cho nó chọn đối tượng đó thôi được không a


  9. 1 giờ} trướ}c, ZIS3 đã nói:

    @NgọcH

    1. Filter không lọc được

    2. Về lý thuyết, coi các các đường tròn bị đè là đường tròn có giao cắt với đối tượng khác.

    Cách 1:  Đưa các đường tròn vào tập hợp A;  các đối tượng còn lại vào tập hợp B.  Nếu 1 phần tử thuộc A giao (intersect) với ít nhất 1 phần tử thuộc B thì nhét đường tròn vào tập hợp C.

    Cách 2:  Đưa các đường tròn vào tập hợp A.  Từ toạ độ và bán kính 1 đường tròn, tính ra 6 điểm nội tiếp đường tròn.   Chọn (Select polygon) bằng 6 điểm này, nếu chọn được phần tử thì nhét đường tròn vào vào tập hợp C.

    *

    Cách 1 chạy chậm nhưng chính xác.  Cách 2 nhanh nhưng gần đúng thôi.

    làm theo cách 1 thì sẽ chạy lâu quá không ạ, mình có khoảng 30.000 phần tử và khoảng 300 phần tử giao nhau. chắc phải học thêm vba để làm. cảm ơn b

     


  10. 20 phút trước, cuongtk2 đã nói:

    Bạn toàn toàn search được hướng dẫn trên Youtube cũng với những từ như trên. Chỉ cần thay cụm từ "Chào mọi người" thành "Autocad".

    E có tìm hiểu trên web và youtobe rồi nhưng chỉ có hướng dẫn chọn đường tròn. ở đây e chỉ muốn chọn các đường tròn bị đè để xóa đi và không muốn xóa các đường tròn xung quanh không bị đè a ạ

     

×