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

Bee

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

    546
  • Đã tham gia

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

  • Ngày trúng

    37

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


  1. 23 phút trước, Mèo Mun đã nói:

     

     

    Bác giúp em code cách kiểm tra :Justify của Att với . :((( Kiểm tra thuộc tính đối tượng thì em đang dùng NENTSEL, nhưng để chọn được đối tượng khối ngoài cùng ( là Block chứa nó ) , thì em chưa biết làm. 

    Ok đây là phần check justify với trường hợp là các dtuong cùng left hoặc right để mirror. Nếu lẫn lộn thì bạn tự modify code thêm nhé.

    (defun c:mirror_blockatt  ()
      
      (command "select" "all" "")
      (setq remove (ssget "p"))
    
      (print "MIRROR Select objects: ")
      (if (setq ss (ssget))
        (progn
          (command "mirror" ss "" pause pause "N")
    
          (command "select" "all" "remove" remove "")
          (setq new (ssget "p"))
    
          (if (= 0 (check_justify (ssname new 0)))
            (setq j "R")
            (setq j "L")
            )
    
          (command "_justifytext" new "" j "")
          )
        )
      (princ)
      )
    
    (defun check_justify (en / ent justify)
      (setq ent (entnext en))
      (while (/= "SEQEND" (cdr (assoc 0 (entget ent))))
        (if (= "ATTRIB" (cdr (assoc 0 (entget ent))))
          (setq justify (cdr (assoc 72 (entget ent))))
          )
        (setq ent (entnext ent))
        )
      justify
      )

    @DVH: chắc bạn này chưa sài qua autolisp duyệt att in block. ^_^


  2. 4 phút trước, Mèo Mun đã nói:

    Bác #Doan Van Ha

    Có lẽ sẽ tuyệt hơn nếu chỉ click vô cái hình mũi tên đối xứng, là đối xứng vèo 1 cái Block. ^^. Chứ thêm thao tác sẽ làm mất đi tính hay của Attriblock. 

    Lisp em cũng vừa viết thử như sau: 

     

    (defun c:dxt ( / object pt1 pt2)
      (setq object (car (entsel "Chon block doi xung: "))
        pt1 (cdr (assoc 10 (entget object)))
        pt2 (list (car pt1) (+ (cadr pt1) 100000)))
      (command "MIRROR" object "" "non" pt1 "non" pt2 "y")
      (command "_JUSTIFYTEXT" object "" "BR" "")
      (princ))

     

    + Tuy nhiên: Lisp có 1 nhược điểm: 

    - Giả sử ban đầu block của em đặt định dạng : Bottom Left   ---> Khi đối xứng qua lisp: thành Bottom Right.  Nhưng nếu em đối xứng lại 1 lần nữa: Thì Bottom Right ---> Không thể trở thành Bottom Left được. Chẳng lẽ lại tạo thêm cái lisp nữa cho thêm phần gay cấn hả bác ^^ :;):;)

    Lisp của bác #Bee cũng tương tự như vậy : ( Nhưng công nhận rất hay trong cách chọn lại tập đối tượng của bác :)))

     

    Dynamic block khong flip duoc justify att.

    Bạn thêm vào lisp phần check justify của att rồi cho nó tự xử. Em đang định post thì bác Hạ pót roài ^_^

     


  3. 53 phút trước, truongthanh đã nói:

    Chào các anh chị!

    Hiện nay e đang gặp tình huống các Pline ống cấp nước vẽ chồng qua Block van cấp nước! Giờ nhờ a e chỉ giúp cách nào nhanh nhất để cắt đường pline khi giao cắt với Block ạ!

    Cụ thể có trong file cad đính kèm ạ! Trong bản vẽ e rất nhìu trường hợp như vậy ạ!

    chân thành cảm ơn mọi người!

    block.dwg

    2018-06-04_142349.jpg

    Chui vào block rồi tạo cái wipout. Xong ra ngoài select all block rồi draworder cho nó lên trên là xong. Fast and furious ^_^


  4. 1 giờ trước, Mèo Mun đã nói:

    ^_^ . Nhưng mà vậy thì hơi auto "tay"  quá ạ.

    Có hướng giải quyết nào mà chỉ cần Click vô nút Mirror là xong không anh #Bee @@. ??

    Còn nếu ko được chắc phải dùng cách của anh thật. :(

    Đang rảnh nên nghịch chút cho bạn làm luôn. Dùng lisp thôi ^_^. Bạn tự thêm phần check right or left nhé.

    (defun c:mirror_blockatt  ()
      
      (command "select" "all" "")
      (setq remove (ssget "p"))
    
      (print "MIRROR Select objects: ")
      (if (setq ss (ssget))
        (progn
          (command "mirror" ss "" pause pause "N")
    
          (command "select" "all" "remove" remove "")
          (setq new (ssget "p"))
    
          (command "_justifytext" new "" "R")
          )
        )
      (princ)
      )

     

    • Like 1

  5. 34 phút trước, auto89 đã nói:

    Bài toán của em là thế này: trên bản vẽ có rất nhiều đối tượng khác nhau,  n nhóm đối tượng giống nhau trong mỗi nhóm có các phần tử (A,B,,C....) nhưng chúng lại chưa block, tất cả chúng có chung đặc tính là chung (color, layer, linetype,lineweight)   chỉ khác nhau về hình dạng và kích thước . bây giờ em muốn chuyển n nhóm đối tượng giống nhau sang một layer, hoặc màu khác để quản lý. Em đã thử dùng các lệnh : ssx, getsel, selectsimilar, quickselect đều không được vì nó chọn sang cả các đối tượng khác. Bác nào có cách giải bài toán này chỉ em với ah 

    đây là bản vẽ của em 

     

    abc.dwg

    Sao dùng Quickselect lại không được ????

    Do bản vẽ là đối tượng đa số line và arc nên việc lựa chọn quick select sẽ phải thao tác nhiều lần và khôn khéo 1 chút.

    Thay vì chọn đối tượng line nằm ngang và dọc vuông góc thì nên chọn chuyển đối tượng line đường chéo sang layer khác thì sẽ còn lại đường bo cần lựa chọn. Thao tác mấy góc là xong thôi mà.! Chắc mất 1phut. ^_^

    image.thumb.png.f0167f53067b8da259ecae23615ef911.pngimage.thumb.png.1ffb4d4c85bf0953d10b4118512407c6.png

    • Like 1

  6. 11 giờ trước, khongban231 đã nói:

    hic. cái mình up lên b code giúp thì chạy được, mình thử vào bản vẽ mình đang làm nhiều đối tượng quá nó lại báo error. sử lý hộ mình cái code nhé bạn Bee :((

    new block.dwg

    Oài còn 1 đống trường hợp chưa xử lý mà.

    1. Đối tượng này không nằm trong wcs.

    2. Đối tượng pline nhưng không kín.

    3. Đối tượng không phải pline

    4. 2 pline nằm  trong nhau

     

    Hê hê nhiều nhỉ. Cái này thì từ từ mình sẽ fix, giờ đang chạy lụt nên chưa có time. Hoặc chờ các cao thủ fix cho. ^_^

    image.png.8f56c8159ca7cd2708ca645ebbc9b222.png

    image.png.d3f1a8804af57df48376dcd677845f95.png

     

    image.png.8c5870ad9070095b362846dcaed6ed90.png

    image.png.792952b0e9f1e20989fc100f3d6f6c09.png

     

    image.png.6e4866f254ffe9e36b498f853d92e8cf.png


  7. 27 phút trước, khongban231 đã nói:

    sao mình làm mãi không được nhỉ? mình chạy trên nền cad 2007 với cad 2018 đều không được b Bee ? :((

    Mình gửi lại, copy paste và load chạy lệnh xem được chưa nhé.! ^_^

     

    (defun c:test  (/ vl-pline-centroid n pt ss ent)
      (load "extrim.lsp")
      (defun vl-pline-centroid  (pl / acdoc space obj reg cen)
        (vl-load-com)
        (setq acdoc (vla-get-activedocument (vlax-get-acad-object))
              space (if (= (getvar "CVPORT") 1)
                      (vla-get-paperspace acdoc)
                      (vla-get-modelspace acdoc)
                      )
              )
        (or (= (type pl) 'vla-object)
            (setq obj (vlax-ename->vla-object pl))
            )
        (setq reg (vlax-invoke space 'addregion (list obj))
              cen (vlax-get (car reg) 'centroid)
              )
        (vla-delete (car reg))
        (trans cen 1 (vlax-get obj 'normal))
        )
      (if (setq ss (ssget))
        (progn
          (setq n 0)
          (repeat (sslength ss)
            (setq pt (vl-pline-centroid (ssname ss n)))
    
            (setq ent (entmake
                        (list '(0 . "POINT") (cons 10 pt))
                        )
                  )
            (command "_.Zoom" "obj" (ssname ss n) "")
            (etrim (ssname ss n) pt)
      
            (setq n (1+ n))
            ) ;repeat
          ) ;progn
        ) ;if
      (command "zoom" "all")
      )

     

    • Like 1

  8. 1 giờ trước, khongban231 đã nói:

    Thank b bee nhưng không được b ơi. mình muốn lệnh kiểu như chọn lần 1 tất cả các line hay pline cần cắt => lần 2 chọn các hình muốn cắt ở trong hoặc ở ngoài ý, gần giống extrim nhưng mà chọn được nhiều đối tượng giao cắt. Trước m có lisp này r giờ lên mạng tìm không nhớ từ khóa gõ nát cả google không thấy , có cao nhân nào giúp mình cái đang cần quá. 

    Lisp này chỉ việc chọn những vùng boundary pline là nó tự trim hết bên trong mà! Giống file dwg mẫu bạn gửi đó thôi.


  9. 5 giờ trước, khongban231 đã nói:

    Thank bạn nhé!

    Nhưng mình muốn dùng lisp cắt cái như file đính kèm chỉ 1 thao tác, các hình trong file chỉ là ví dụ thôi chứ hiình của mình nó là cac đường giao mấy trăm đối tượng nên ko làm thủ công được. 

    Drawing1.dwg

    Quick code tí cho bạn. Chưa test hết các trường hợp nhưng thử bản vẽ drawing thì thấy chạy được. ^_^

    (defun c:test  (/ vl-pline-centroid n pt ss ent)
      (defun vl-pline-centroid  (pl / acdoc space obj reg cen)
        (vl-load-com)
        (setq acdoc (vla-get-activedocument (vlax-get-acad-object))
              space (if (= (getvar "CVPORT") 1)
                      (vla-get-paperspace acdoc)
                      (vla-get-modelspace acdoc)
                      )
              )
        (or (= (type pl) 'vla-object)
            (setq obj (vlax-ename->vla-object pl))
            )
        (setq reg (vlax-invoke space 'addregion (list obj))
              cen (vlax-get (car reg) 'centroid)
              )
        (vla-delete (car reg))
        (trans cen 1 (vlax-get obj 'normal))
        )
      (if (setq ss (ssget))
        (progn
          (setq n 0)
          (repeat (sslength ss)
            (setq pt (vl-pline-centroid (ssname ss n)))
    
            (setq ent (entmake
                        (list '(0 . "POINT") (cons 10 pt))
                        )
                  )
            (command "_.Zoom" "obj" (ssname ss n) "")
            (etrim (ssname ss n) pt)
      
            (setq n (1+ n))
            ) ;repeat
          ) ;progn
        ) ;if
      (command "zoom" "all")
      )

     


  10. 5 giờ trước, gia_bach đã nói:

    Thử cái này nhé (y/cầu NetFramework 3.5).

    - hiển thị các file có kí tự tàu, nhật, hàn (ảrập ...) trong folder đã chọn.

    - click Remove : copy các file có kí tự lạ ở bước trên và đổi thành tên mới (sau khi đã remove các kí tự lạ đó, file gốc giữ nguyên)

    5ab9fe535aeda_RemoveCJK.png.c403505b9af3d6fa5fb0c9f7ae1e4ec4.png

    RemoveJapanese.zip

    Ý tưởng tool này ngon quá, like bác gia_bạch đã ^_^

    Phát triển hoàn thiện thêm thì thành tool sài các chức năng khác liên quan thì ngon quá.

     

    Nhưng sao em chạy nó báokhông thấy cái folder name ở đâu nhỉ ? Bác đặt cái folder đấy ở đâu vậy :)

    image.png.4bac49ea21e1e2b64cbc2854b136d534.png


  11. 14 phút trước, dinhvantrang đã nói:

     

    ý bạn là Rename Folder uh?

    Nếu thế thì sẽ thế này:

    
    Dim fso
    Set fso = WScript.CreateObject("Scripting.Filesystemobject")
    Dim objFolder,objSubFolder
    Dim strFolderPath
    strFolderPath  = Left(WScript.ScriptFullName,Len(WScript.ScriptFullName)-Len(WScript.ScriptName))
    
    Set objFolder =fso.GetFolder(strFolderPath)
    Dim strNewName
    Dim varList,intCount
    If objFolder.SubFolders.Count>0 Then
    	For Each objSubFolder In objFolder.SubFolders
    		strNewName=vbNullString
    		
    			strOldName = objSubFolder.Name
    			
    			varList= Split(strOldName,"_")
    			
    			For intCount= 0 To UBound(varList)
    				
    				If strNewName=vbNullString Then
    					strNewName = varList(intCount)
    				Else
    					If intCount <> 2 Then
    						strNewName = strNewName & "_" & varList(intCount)
    					End If
    				End If
    				
    			Next
    			
    			objSubFolder.Name = strNewName
    	
    	Next
    	
    	MsgBox "Done",vbInformation,"TrangMeo_0986370918"
    End If

     

    OK bạn.

    Có funtion nào check in ParentFolder mà các SubFolder trong SubFolder không bạn.? Nghĩa là không cần biết folder trong folder mà cứ check all hết trong đó cả file và folder có thì nó xử lý hết, Chỉ cần browse folder ngoài cũng thôi.


  12. 7 phút trước, dinhvantrang đã nói:

     

    Hi Bee. bạn mở bằng Notepad và thay thế cái như hình dưới nhé.

    Chú ý: Do các file của bạn mình đoán là cái chữ Tiếng Nhật nó nằm ở Vị trí Thứ 3 (tương ứng với IntCount = 2), còn nếu nằm sai vị trí thì e rằng nó chạy không đúng.

     

     

    image.thumb.png.1bac617fa6dac8226867389ccfc35934.png

    Hì Ok. Thế trường hợp thay file thành Folder thì thế nào vậy Mr Trang.?


  13. 19 giờ trước, dinhvantrang đã nói:

    Gửi mr Bee kiểm tra thử nhé.Mình viết bằng vbscripting

    Cách chạy:

    Giải  nén và bỏ file giải nén đó vào trong Folder chứa các file cần Rename >>Run.

    MrBee.rar

    Mr Trang cho hỏi mở rộng hơn tí. ^_^

     

    Trường hợp mà ko có "_" mà chỉ space (thường có trong các file có tiếng việt) thì code VBS thế nào ?

     


  14. 32 phút trước, quocmanh04tt đã nói:

    Thử chạy bằng LISP coi sao!

    ((lambda (/ name new_filename)
       (defun new_filename  (filename / LM:str->lst lst)
         (defun LM:str->lst  (str del / pos)
           (if (setq pos (vl-string-search del str))
             (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del))
             (list str)))
         (setq lst (vl-remove-if '(lambda (x) (vl-string-search (chr 63) x))
                                 (LM:str->lst filename (chr 95))))
         (strcat (car lst) (apply 'strcat (mapcar '(lambda (x) (strcat (chr 95) x)) (cdr lst)))))
       (vlax-for f  (vlax-get (vlax-invoke-method
                                (vlax-create-object "Scripting.FilesystemObject")
                                'GetFolder
                                "D:\\TEMP")
                              'Files)
         (if (and (vl-string-search (chr 63) (setq name (vlax-get f 'name)))
                  (eq (strcase (vl-filename-extension name)) ".DWG"))
           (vlax-put f 'name (new_filename name))))))

    P/s:

    + Nếu thêm Browse Folder thì "Pờ - rồ" hơn, nhằm thay thế  "D:\\TEMP".

    + Chưa bắt, bẫy lỗi trùng tên file sau khi rename...

    Ok thanks Mr quocmanh. Để em chạy thử.

    Browse Folder thì dùng thằng này cũng nhanh gọn: (acet-ui-pickdir "Select Directory")) 


  15. 3 giờ trước, quocmanh04tt đã nói:

    Tạm thế này rồi có thể dựa vào đó nghiên cứu tiếp:

    (vl-list->string (vl-remove 63 (vl-string->list (car (vl-directory-files "C:\\TEMP" "*.dwg" 1)))))

    Quả này em thử roài.! Nhưng mà lúc rename ko được: 

    ("20180220_APARTMENT TYPE 1_????1_Block A.dwg")

     

    ????? thế sao rename được. ^_^

     

     

×