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

phamngoctukts

CADViet Team
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    1104

  • Đã tham gia

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

  • Ngày trúng

    51

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

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

    Của bạn đây:



    
Sub xoa()
    
On Error Resume Next
    
Dim ss As AcadSelectionSet
    
Dim mode As Integer
    
mode = acSelectionSetAll
    
Dim gpCode(0) As Integer
    
    Dim dataValue(0) As Variant
    
    gpCode(0) = 0
    
    dataValue(0) = "Line"
    
ThisDrawing.SelectionSets.Item("SS").Delete
    
Dim obj As AcadObject
    
Dim p1 As Variant
    
Dim p2 As Variant
    
Set ss = ThisDrawing.SelectionSets.Add("SS")
    
ss.Select mode, , , gpCode, dataValue
    
For Each obj In ss
    
p1 = obj.StartPoint
    
p2 = obj.EndPoint
    
If p1(0) = p2(0) Then
    
obj.Erase
    
End If
    
Next
    
End Sub

    • Vote tăng 1

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

    Để viết cho attribute @ThuyLinh cần tìm hiểu thêm về các kiểu đối số của hàm command. Đố làm được đấy!

    Cái phần dùng cho BlockAtt và Attribute mình đã làm xong rồi (Cái này chỉ cần thay entsel = nentsel). Cái của mình dùng trên cad đời thấp không có biến EDITTEXT nên còn nhiều hạn chế do vậy mình không up lên.

    • Vote tăng 4

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

    Mình thấy cái này hay hay nên edit chút để dùng được cho cad đời thấp. Do vội nên chưa test kỹ không biết có lỗi gì không.

    
(vl-load-com)
;;; Dinh nghia lai lenh ED de lay ename doi tuong
(defun c:edt (/ textedit font ent)
(SETQ OLDERR *error*
*error* myerror)
(sendkeys "^+")
(while (setq textedit (car (entsel)))
(setq ent (cdr (assoc 0 (entget textedit))))
(if (wcmatch ent "*TEXT")
(progn
(setq font (vla-get-stylename (vlax-ename->vla-object textedit)))
(call font)
)
)  
(command "ddedit" textedit "")
)
(back)
(SETQ *error* OLDERR)
(princ))
;;; Ham call dieu khien bo go tieng viet
(defun call (font / code Crfont)
(if font (setq Crfont font) (setq Crfont (getvar "textstyle")))
  (setq code (check-font-code Crfont))
  (cond ((= code "TCVN3") (sendkeys "^+{F2}"))
((= code "UNICODE") (sendkeys "^+{F1}"))
((= code "VNI") (sendkeys "^+{F3}"))
)
)
;;; Ham tra lai English
(defun back ()
(sendkeys "^+")
)
;;; Ham kiem tra bang ma cua textstyle (su dung true type font)
;;; style: String - ten cua textstlye kiem tra
(defun Check-Font-Code (style / ts font Bold Italic charSet PitchandFamily)
(setq ts (vlax-ename->vla-object (tblobjname "style" style)))
(vla-GetFont ts 'font 'Bold 'Italic 'charSet 'PitchandFamily)
(if (= font "") (setq font (vla-get-fontfile ts)))
(cond ((wcmatch (setq font (strcase font)) "ARIAL*,TAHOMA*,TIMES*,COURIER NEW,CAMBRIA,CONSOLAS") "UNICODE")
   ((wcmatch font ".VN*") "TCVN3")
   ((wcmatch font "VNI*") "VNI")))
;;; Ham senkeys
(defun SendKeys (keys / wscript)
(vlax-invoke-method (setq wscript (vlax-create-object "WScript.Shell")) 'sendkeys keys)
(vlax-release-object wscript))
;;;Ham bay loi
(defun myerror (s)
(if (= s "Function Cancelled") (sendkeys "^+"))
 (setq *error* OLDERR)
 (princ)
)

    PS: Mình nghĩ cái này có thể phát triển thêm dùng cho cả block attribute.

    • Vote tăng 2

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

    Không ai biết bản vẽ này bị khóa bởi cái gì àh?

    Hịc.. buồn..

    (Không biết bản vẽ bị khóa bằng cái gì, thì làm sao mở khóa bây giờ :(( :(( :(( )

    Buồn cho chính bản thân bạn! (đâu còn là mem mới nữa post tới 71 bài rồi)

    Cái này đơn giản chỉ là dùng block minsert trên diễn đàn có quá nhiều bài viết về nó rồi chịu khó seach nhé.

    • Vote tăng 1

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

    Mình đã ẩn 2 bài bạn reddevil88 trình bày cách un-lock. Tất nhiên ý của bạn muốn share là rất tốt, tuy nhiên, hãy nhớ, đừng bao giờ viết trên topic của các tác giả, nếu không thì bài chia sẻ của các bạn không còn chút ý nghĩa nào

    Tùng ơi không cần phải ẩn các bài viết về cách mở khóa đâu. Anh làm cái khóa đó chỉ với mục đích là cho người dùng phải tự mầy mò tới lisp để có thể tự mở khóa thôi ngoài ra không có mục đích gì khác. Với lại anh cũng không có thời gian trả lời các câu hỏi của mem.

    • Vote tăng 1

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

    Sub nhap()
Dim h As Double
h = ThisDrawing.Utility.GetReal("Nhap chieu cao text:" & " < " & 2 & " > ")
If h = "" Then
h=2
End If
End Sub

    - Đoạn mã trên nếu nhấn Enter thì giá trị của h=2

    - Nếu nhập giá trị mới thì có h bằng h mới nhập

    Nhưng Code lỗi. Có bác nào rảnh mong xem giúp

    Cám ơn!

    Bạn có thể dùng thế này

    
Sub nhap()
On Error Resume Next
Dim h As Double
h = ThisDrawing.Utility.GetReal("Nhap chieu cao text:" & " < " & "2" & " > ")
If Err <> 0 Then
h = 2
Err.Clear
End If
End Sub

    • Vote tăng 2

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

    hehe, mình đâu có kêu bạn tách nó ra làm gì :D mình chỉ nêu 1 cách run lock code thôi, khi double click file đó sẽ decrypt drawing để user có thể xem dc đồng thời khoá các chức năng mà mình không muốn người dùng thực hiện lại. Khi close window drawing sẽ được encrypt lại như cũ :D

    việc tách file exe đó ra cũng ko phải là vấn đề vì nếu bạn muốn xem bản vẽ phải chạy file exe đó -> bị lock. và file exe đó thì việc protect code có lẽ hơn hẳn VBA nhỉ.

    Good luck!

    Híc Bác cho em hỏi cách nhúng file exe vào file dwg thì làm thế nào?

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

    Thực ra để khoá các lệnh của AutoCAD tức là bạn đang hack vào AutoCAD, để làm dc điều đó bạn phải tìm dc đường vào AutoCAD trước đã hay nói đúng hơn bạn phải làm sao chạy dc đoạn code khoá của mình đã.

    Mời bạn ntluyen và bạn phamngoctukts thử file dưới đây.

    p/s: Các bạn khác nếu lỡ mở lên mà máy tính hay CAD có bị gì thì mình ko chịu trách nhiệm đâu nhé :D

    file đây: http://www.cadviet.c...37_drawing1.dwg

    Good luck! :D

    Bác nói thế thì ai dám mở. Nếu đã có ý định phá thì ai mà đỡ nổi :unsure:

    PS: Em mở file của Bác ra trả thấy hiện tượng gì cả. Trên hình có mỗi cái hinh chữ nhật và tất cả chức năng vẫn dùng bình thường , vậy Bác đố gì ở đây nhỉ.

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

    Mở pass dễ thế này thì nhà em không làm khóa nữa đâu!!!!! :(

    Mình thấy khóa của bạn khá hoàn hảo rồi đấy, cố thêm chút nữa là ngon.

    Khóa là chỉ để chống người ngay thôi, còn "kẻ gian" thì khó lắm vì đã là khóa thì ắt là phải có chìa để mở. Khóa như kiểu của bạn là cũng đủ "Khoai" lắm rồi và không phải ai cũng mở được. Mong bạn đừng nản chí.

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

    Mình không dám nhận là cao thủ đâu :D

    tuy nhiên mở khoá của bác thì cũng phải gửi lại để bác thử sức chứ nhỉ

    Mời bạn thử file này. http://www.cadviet.c...xdwg_locked.dwg

     

    Lưu ý:

    Mình chỉ khoá 1 trường hợp duy nhất là các lệnh mhập vào command thôi, các trường hợp copy vào clipboard, shortcut key, ... mình ko xét tới. cái quan trọng ở đây là mình muốn nói về vấn đề giấu code VBA

    Bạn chỉ cần làm sao xem dc Code VBA là dc

    Good luck!

    Có phải Bác nói đến cái này

     

    Option Explicit

     

    Private Sub AcadDocument_Activate()

    Dim pt(2) As Double

     

    pt(0) = 0: pt(1) = 0: pt(2) = 0

    ThisDrawing.ModelSpace.AddText "This Dwg was Locked", pt, 10

    End Sub

     

    Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)

    Dim arr(4) As String

    Dim CMD As String

    Dim i As Integer

    Dim isAllow As Boolean

     

    arr(0) = "ZOOM"

    arr(1) = "PAN"

    arr(2) = "CLOSE"

    arr(3) = "QUIT"

    arr(4) = "PLOT"

     

    CMD = UCase(CommandName)

    isAllow = False

    For i = 0 To UBound(arr)

    If InStr(1, arr(i), CMD) Then

    isAllow = True

    Exit For

    End If

    Next

     

    If Not isAllow Then SendKeys ("{ESC}")

    End Sub

    • Vote tăng 1

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

    Từ đầu đến giờ vẫn chỉ thấy bạn nói xuông. Bạn giới thiệu nhiều như vậy chắc hẳn bạn phải làm một số công trình dạng này rồi chứ nhỉ. Bạn hãy up thử một số công trình mà bạn làm lên xem. Nếu có vấn đề cần bảo mật thì bạn có thể quay một video clip lên cho mọi người xem. Nói thật chứ đọc các bài của bạn mình trả hiểu gì :D

    • Vote tăng 1

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

    Nhưng khi tôi bỏ hẳn alert trong hàm IF thì vẫn không hiểu ^C^C để thoát lệnh.

    Vẫn chưa hiểu, xin chỉ giúp thêm!

    (Prompt "\Thi hanh bang lenh \"chaythu\".")
;Chuong trinh chinh
(Defun C:chaythu ()

  (chophep)

  (command "_.TEXT" "mc" (list 0.0 0.0 0.0) 5.0 0.0 "CHAY BINH THUONG")

  (alert "Chuong trinh chay binh thuong!")
  (princ)
);end defun chinh
(defun chophep (/ CHECK)
  (setq CHECK (findfile "C:\\Windows\\win11111.ini"))
  (if (= CHECK nil)
^^C)
);end chophep

     

    Kết quả vẫn chạy ra dòng text: CHAY BINH THUONG. Chứ không ngắt lệnh!?

     

     

    Thấy bạn loay hoay mãi vẫn chưa được vậy nên tốt nhất là sửa code cho bạn từ đó bạn có thể đưa ra cách làm.

     

    (Prompt "\Thi hanh bang lenh \"chaythu\".")

   ;Chuong trinh chinh
(Defun C:chaythu ()
  (if (chophep (setq dd "C:\\Windows\\win11111.ini"))
   (progn
(command "_.TEXT" "mc" (list 0.0 0.0 0.0) 5.0 0.0 "CHAY BINH THUONG")
(alert "Chuong trinh chay binh thuong!")
   )
   (alert (strcat "khong tim thay file: " dd))
  )
 (princ)
);end defun chinh
(defun chophep (CHECK)
  (setq kq (findfile CHECK))
 kq
);end chophep

×