creating a new layer bằng vba

[nguyendinhlinh_xd 0]

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

[HungDHXD 6]

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 : 

Thật ra theo mình : 

* nên viết thành 1 Funciton ExistsLayer()  hàm này sẽ kiểm tra sự tồn tại của tên Layer--> và khi ta muốn tạo 1 layer mới thì code sẽ như kiểu : If ExistsLayer("strLayer") then .......

* Thói quen của mình hạn chế dùng On Error Resume Next để bẫy lỗi đưa kết quả ( cái vụ On error này "cực chẳng đã " ta mới dùng bẫy lỗi để lập trình) vì nếu trong một Sub rất nhiều giải thuật --> đôi lúc sẽ khiến ta không kiểm soát hết được lỗi , lúc này ta phải thêm 1 câu lệnh on error goto 0

* Với bài này ta có thể dùng vòng lặp duyệt qua tất cả các tên của layer, nếu tên nào trùng với strLayer --> kết luận đã tồn tại layer này và thoát khỏi vòng lặp.

 

==> đây chỉ là ý kiến chủ quan của mình thôi !

[nguyendinhlinh_xd 0]

cảm ơn ý kiến của anh.