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

nguyendinhlinh_xd

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

  • Số lượng nội dung

    2

  • Đã tham gia

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

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

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

    nếu ai biết về cad thì có thể tạo một layer đơn giản như sau : la ==> alt + n  vào đó và đánh tên , hoặc giả dùng vba + lisp

    B1 : tạo một dự án VBA : addtext như sau : 

    Public Sub AddLayer()

    Dim strLayerName As String 

    Dim objLayer As AcadLayer

    strLayerName = InputBox("Name of Layer to add: ") 'nhập thông báo tên newlayer

    If "" = strLayerName Then Exit Sub ' thoát khi không nhập tên

    On Error Resume Next 

    'kiểm tra sự tồn tại của layer

    Set objLayer = ThisDrawing.Layers(strLayerName)

    If objLayer Is Nothing Then

    Set objLayer = ThisDrawing.Layers.Add(strLayerName)

    If objLayer Is Nothing Then 

    MsgBox "Unable to Add '" & strLayerName & "'"

    Else

    MsgBox "Added Layer '" & objLayer.Name & "'"

    End If

    Else

    MsgBox "Layer already existed"

    End If

    End Sub

     

    tạo 1 file lisp có nội dung :(defun c:AddLayer()(command "vbarun" "AddLayer")(princ))

     như vậy lúc nào tiện ap file lisp đó thì lệnh trong lisp giống lệnh trong vba . chúc các bạn thành công .http://www.cadviet.com/upfiles/3/121145_testaddarc.lsphttp://www.cadviet.com/upfiles/3/121145_active_space__copy.rar

     

    2 file 1 file là dự án độc lập vba một bên là chuyển lệnh từ vba sang lisp. còn có cách khác là khi nào mở cad là có lệnh giống như lệnh nguyên thuỷ của máy nữa sẽ trình bày sau. 

    (defun c:AddLayer()(command "vbarun" "AddLayer")(princ))
     
    (defun c:AddLayer()(command "vbarun" "AddLayer")(princ))
     
    (defun c:AddLayer()(command "vbarun" "AddLayer")(princ))
     
    (defun c:AddLayer()(command "vbarun" "AddLayer")(princ))
     
    Public Sub AddLayer()
    Dim strLayerName As String
    Dim objLayer As AcadLayer
    strLayerName = InputBox("Name of Layer to add: ")
    If "" = strLayerName Then Exit Sub ' exit if no name entered
    On Error Resume Next ' handle exceptions inline
    'check to see if layer already exists
    Set objLayer = ThisDrawing.Layers(strLayerName)
    If objLayer Is Nothing Then
    Set objLayer = ThisDrawing.Layers.Add(strLayerName)
    If objLayer Is Nothing Then ' check if obj has been set
    MsgBox "Unable to Add '" & strLayerName & "'"
    Else
    MsgBox "Added Layer '" & objLayer.Name & "'"
    End If
    Else
    MsgBox "Layer already existed"
    End If
    End Sub
    Public Sub AddLayer()
    Dim strLayerName As String
    Dim objLayer As AcadLayer
    strLayerName = InputBox("Name of Layer to add: ")
    If "" = strLayerName Then Exit Sub ' exit if no name entered
    On Error Resume Next ' handle exceptions inline
    'check to see if layer already exists
    Set objLayer = ThisDrawing.Layers(strLayerName)
    If objLayer Is Nothing Then
    Set objLayer = ThisDrawing.Layers.Add(strLayerName)
    If objLayer Is Nothing Then ' check if obj has been set
    MsgBox "Unable to Add '" & strLayerName & "'"
    Else
    MsgBox "Added Layer '" & objLayer.Name & "'"
    End If
    Else
    MsgBox "Layer already existed"
    End If
    End Sub
    Public Sub AddLayer()
    Dim strLayerName As String
    Dim objLayer As AcadLayer
    strLayerName = InputBox("Name of Layer to add: ")
    If "" = strLayerName Then Exit Sub ' exit if no name entered
    On Error Resume Next ' handle exceptions inline
    'check to see if layer already exists
    Set objLayer = ThisDrawing.Layers(strLayerName)
    If objLayer Is Nothing Then
    Set objLayer = ThisDrawing.Layers.Add(strLayerName)
    If objLayer Is Nothing Then ' check if obj has been set
    MsgBox "Unable to Add '" & strLayerName & "'"
    Else
    MsgBox "Added Layer '" & objLayer.Name & "'"
    End If
    Else
    MsgBox "Layer already existed"
    End If
    End Sub
×