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

Bee

Thành viên
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    553

  • Đã tham gia

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

  • Ngày trúng

    37

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

  2. Đã đăng · Trả lời báo cáo

    9 giờ trước, beeboy đã nói:

    Oh, mình xin cám ơn mấy bác đã chỉ.

     

    Giúp mình sửa  lisp dùng để khóa, mở khóa layer (Lock/Unlock Layer/Unlock All Layer)

    Nhưng trong quá trình sử dụng mình phát hiện có điểm bất tiện là: mỗi lần nhập lệnh thì lisp chỉ (khóa/mở khóa) được 1 đối tượng/mỗi lần nhập lệnh

    Nhờ mọi người giúp mình sửa lisp trở nên tiện lợi hơn: cụ thể là: mỗi lần nhập lệnh sẽ pick được nhiều đối tượng. (chọn đc nhiều đối tượng/mỗi lần nhập lệnh)

    Thử cái này xem ^_^ 

    (defun c:lock_m  (/ n ss)
  (prompt "\nTo Lock their Layer(s),")
  (setq ss (ssget)) 
  (repeat (setq n (sslength ss))
    (command "_.layer" "_lock" (cdr (assoc 8 (entget (ssname ss (setq n (1- n)))))) "")
    ) ; repeat
  )

(defun c:unlock_m  (/ n ss)
  (prompt "\nTo Lock their Layer(s),")
  (setq ss (ssget)) 
  (repeat (setq n (sslength ss))
    (command "_.layer" "_unlock" (cdr (assoc 8 (entget (ssname ss (setq n (1- n)))))) "")
    ) ; repeat
  )

     

    • Like 2

  3. Đã đăng · Trả lời báo cáo

    2 giờ trước, jangboko đã nói:

    Chào các bạn. Mình có vấn đề với tỷ lệ với các đối tượng chứa annotative. Mong các bạn giúp đỡ.

    - lệnh "AIOBJECTSCALEREMOVE" có tác dụng remo tỷ lệ hiện hành trong đối tượng chứa annotative ( ví dụ ở môi trường model mình đang để tỷ lệ annotative là 30. Khi sử dụng lệnh " AIOBJECTSCALEREMOVE " nó sẽ remo tỷ lệ 30 trong đối tượng được chọn). Mình nhờ các bạn viết hộ mình 1 lisp có tác dụng ngược lại. Có nghĩa là nó sẽ remo tất cả các tỷ lệ trong đối tượng đó, trừ tỷ lệ hiện hành. 

    - Cám ơn các bạn, cám ơn diễn đàn :D

    Không biết đúng ý bạn không. ^_^

    (nguồn http://www.cadtutor.net/forum/showthread.php?53069-Annotative-troubles&p=359702&viewfull=1#post359702)

    Code here: 

    (defun c:ObjectScaleCurOnly (/ ss n scLst OSC:GetScales)
  (print "Select the objects you wish to modify: ")
  (if (or (setq ss (ssget "I")) (setq ss (ssget)))
    (progn
      ;; Define helper function to get scales attached to an entity
      (defun OSC:GetScales (en / ed xn xd cdn cdd asn asd cn cd sn sd cannoscale)
        (setq ed (entget en))
        (if (and
              ;; Get the XDictionary attached to the object
              (setq xn (vl-position '(102 . "{ACAD_XDICTIONARY") ed))
              (setq xn (cdr (nth (1+ xn) ed)))
              (setq xd (entget xn))
              ;; Get the Context Data Management dictionary attached to the XDictionary
              (setq cdn (vl-position '(3 . "AcDbContextDataManager") xd))
              (setq cdn (cdr (nth (1+ cdn) xd)))
              (setq cdd (entget cdn))
              ;; Get the Annotation Scales dictionary attached to the CD
              (setq asn (vl-position '(3 . "ACDB_ANNOTATIONSCALES") cdd))
              (setq asn (cdr (nth (1+ asn) cdd)))
              (setq asd (entget asn))
              ;; Get the 1st scale attached
              (setq cn (assoc 3 asd))
              (setq cn (member cn asd))
            )
          ;; Step through all scales attached
          (while cn
            (if (and (= (caar cn) 350) ;It it's pointing to a scale record
                     ;; Get the record's data
                     (setq cd (entget (cdar cn)))
                     ;; Get the Context data class
                     (setq sn (assoc 340 cd))
                     (setq sd (entget (cdr sn)))
                     (setq sn (assoc 300 sd))
                     ;; Check if the scale is already in the list
                     (not (vl-position (cdr sn) scLst))
                )
              ;; Add it to the list
              (setq scLst (cons (cdr sn) scLst))
            )
            (setq cn (cdr cn))
          )
        )
      )

      ;; Find a list of scales used in selection
      (setq n (sslength ss))
      (while (>= (setq n (1- n)) 0)
        (OSC:GetScales (ssname ss n))
      )

      ;; Add the current scale to the selection
      (setq cannoscale (getvar "CANNOSCALE"))
      (command "._ObjectScale" ss "" "_Add" cannoscale "")

      ;; Remove all other scales attached
      (command "._ObjectScale" ss "" "_Delete")
      (foreach n scLst
        (if (wcmatch (strcase n) (strcat "~" (strcase cannoscale)))
          (command n)
        )
      )
      (command "")
    )
  )

  (princ)
)

     

    • Like 1

  8. Đã đăng · Trả lời báo cáo

    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. ^_^

  9. Đã đăng · Trả lời báo cáo

    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 ^_^

     

  10. Đã đăng · Trả lời báo cáo

    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 ^_^

  11. Đã đăng · Trả lời báo cáo

    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

  13. Đã đăng · Trả lời báo cáo

    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

  16. Đã đăng · Trả lời báo cáo

    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

  17. Đã đăng · Trả lời báo cáo

    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

  18. Đã đăng · Trả lời báo cáo

    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.

  19. Đã đăng · Trả lời báo cáo

    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")
  )

     

  23. Đã đăng · Trả lời báo cáo

    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

  24. Đã đăng · Trả lời báo cáo

    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.

  25. Đã đăng · Trả lời báo cáo

    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.?

×