jakielin 發問時間: 電腦與網際網路軟體 · 9 年前

Excel修改圖層

請問

Excel VBA 如何修改 AuyoCAD圖層

修改部分為:

圖層顏色 線型式

另外想刪除圖層(含資料)

圖層的資料是資料庫展繪上去

可強制刪除嗎?(電腦會當機嗎?)

我的困難是已經將資料展繪到AutoCAD

但是發現展繪資料錯誤

要將展繪資料全部刪除

另外我想以點選AutoCAD檔案的方式進行開啟AutoCAD

也就是希望在展繪資料前讓我點選AutoCAD圖檔

以上

已更新項目:

那圖層的顏色

比方說:我想將圖層原本藍色改為紅色

那刪除圖層的時候,圖層裡面含有物件可以刪除嗎?

2 個已更新項目:

Cola感謝您:

我馬上進行新增動作

另外再請教您下面的問題(不好意思與主題不太一樣)

Dim mystr As String

mystr = "圈選繪圖資料,按下確定鈕"

On Error Resume Next

Set kkk = Application.InputBox(mystr, Type:=8)

ppp = kkk.Copy

Sheets("成果展繪CAD").Cells(2, 1).PasteSpecial Paste

我該怎麼讓它知道我按"取消"就結束

以上

3 個已更新項目:

Cola您好:

我有一個檔案做練習"練習開圖檔與變更顏色"

開檔案沒問題 但是想要開檔案的時候自動show介面

變更圖層顏色也OK

關閉圖層_不能動作

刪除圖層_不能動作

http://vspace.cc/file/PT9II76IWD4JL1BP.html

請您幫忙指導

4 個已更新項目:

Cola您好:

目前剩下刪除圖層有困難

我的AutoCAD是2004版本

但是我將儲存與開啟定為2000版本

不知道會不會有影響

我已經都把圖層設為"0"層

再進行刪除我不要的圖層

假如我欲刪除的圖層,裡面的物件為顯示狀態

依然可以刪除嗎?

我的會出現"選取的圖層未被刪除"

它說裡面含有物件圖層

2 個解答

評分
  • Cola
    Lv 5
    9 年前
    最佳解答

    ....

    ....

    If acadapp.Visible = False Then acadapp.Visible = True

    Set ThisDrawing = acadapp.ActiveDocument加下面2行,就可以選取圖檔開啟

    ThisDrawing.SendCommand "open" & vbCr '直接在AutoCad中下指令

    Set ThisDrawing = acadapp.ActiveDocument '取得目前作用的圖檔

    刪除圖層的步驟

    1.先將目前層切換到"0"層

    方法1: ThisDrawing.SetVariable "CLAYER", "0"

    方法2: ThisDrawing.ActiveLayer = ThisDrawing.Layers("0")

    方法3: ThisDrawing.SendCommand "_-LAYER" & vbCr & "S" & vbCr & "0" & vbCr & vbCr

    2.在AutoCad中執行刪除圖層指令:LAYDEL(這個指令好像2008才有)

    ThisDrawing.SendCommand "_-LAYDEL" & vbCr & "N" & vbCr & "表格線" & vbCr & vbCr & "Y" & vbCr

    之前回答的那一題,版大可再加入下面程式碼,就可省去copy的步驟

    若不copy,要將AtiveCell移到起始位置,再執行

    .....

    .....

    ThisDrawing.layers.Add lay If Selection.Count <= 1 Then

    ro = ActiveCell.Row

    co = ActiveCell.Column

    n = 0

    Do While n <= 2

    If Cells(ro + i, co) = "" Then

    n = n + 1

    Else

    n = 0

    End If

    i = i + 1

    Loop

    Range(Cells(ro, co), Cells(ro + i, co)).Select

    End If

    For i = 1 To Selection.Rows.Count

    .....

    .....

    以上

    若有問題請再提問

    2010-11-06 14:06:01 補充:

    '變更圖層顏色

    ThisDrawing.Layers("表格線").Color = 1

    用LAYDEL這個指令,只要目前層不是要刪除的圖層,不管有沒有物件都可刪除

    可以先判斷目前層是否為要刪除的圖層,是就將目前層切換到"0"層

    If ThisDrawing.ActiveLayer.Name = "表格線" Then

    ThisDrawing.ActiveLayer = ThisDrawing.Layers("0")

    End If

    '再進行刪除圖層動作

    2010-11-06 14:06:40 補充:

    '另外可以用vb的CommonDialog來選取檔案,要先新增Common Dialog控制項

    With UserForm5.CommonDialog1

    .Filter = "dwg (*.dwg)|*.dwg"

    .ShowOpen

    fname = .Filename

    End With

    If fname = "" Then

    Set ThisDrawing = acadapp.ActiveDocument

    Else

    Set ThisDrawing = acadapp.Documents.Open(fname)'開啟圖檔

    End If

    2010-11-06 14:06:51 補充:

    以上

    若有問題請再提問

    2010-11-06 20:08:46 補充:

    版大好:

    Set kkk = Application.InputBox(mystr, Type:=8)

    只要在下面加上是否有錯誤就可以了

    If Err Then

    Err.Clear

    Exit Sub

    End If

    一般若按取消會傳回false

    若Type:=8,加上set,按取消會傳回錯誤,若有選取會傳回Range物件

    若Type:=8,沒加Set,按取消會傳回false,有選取則會傳回Selection

    以上

    若有問題請再提問

    2010-11-06 21:24:15 補充:

    版大好

    關閉圖層

    ThisDrawing.Layers("98資料").LayerOn = False

    2010-11-06 21:24:54 補充:

    若要刪除最好先判斷圖層是否存在,否則會出錯,例如要刪除圖層"98表格"

    Set lay = ThisDrawing.Layers("98表格")

    If lay Is Nothing Then

    Else

    ThisDrawing.SendCommand "_-LAYDEL" & vbCr & "N" & vbCr & "98表格" & vbCr & vbCr & "Y" & vbCr

    End If

    2010-11-06 21:25:17 補充:

    要繼續刪除就copy同樣的程式碼,再變更圖層名稱就可以了

    以上

    若有問題請再提問

    2010-11-07 13:09:05 補充:

    '版大如有裝Express,就可用這個指令,跟2008有點不一樣

    '如要刪除圖層lay1,lay2

    2010-11-07 13:09:12 補充:

    ThisDrawing.SendCommand "_LAYDEL" & vbCr & _

    "T" & vbCr & "lay1" & vbCr & _

    "T" & vbCr & "lay2" & vbCr & _

    vbCr & "Y" & vbCr

    2010-11-07 13:09:41 補充:

    或是先刪除圖層內的所有圖元,再刪除圖層

    i = 0

    Do While i < ThisDrawing.ModelSpace.Count

    Set obj = ThisDrawing.ModelSpace(i)

    If obj.Layer = "lay1" Then

    obj.Delete

    Else

    i = i + 1

    End If

    Loop

    2010-11-07 13:09:55 補充:

    ThisDrawing.SetVariable "CLAYER", "0"

    ThisDrawing.Layers("lay1").Delete

    ThisDrawing.Application.Update

    2010-11-07 13:11:34 補充:

    儲存與開啟定為2000版本,並無影響

    以上

    若有問題,請再提問

    2010-11-07 21:48:24 補充:

    http://www.mediafire.com/?7s74omdcbqnq9s1

    修改好了,測試一下,若有問題請再提問

    2010-11-10 00:42:55 補充:

    上個載點可能是中文檔名的關係,文件名被變更,只要修改它的副檔名就可以了

    不過下載下面這個就可以了,已經都放在一起

    會自己產生數據坐連線的動作??

    因為資料裡面包含有非點資料,而是數值資料

    若輸入數值,會自動抓以滑鼠的方向,長度為輸入數值的點

    http://www.mediafire.com/?zapd1rszdspzqib

    若有問題請再提問

  • 9 年前

    感恩您的說明都好詳細

    我一看就知道怎麼回事

    謝謝

    另外我補充的部份也請您指導謝謝

    2010-11-07 16:06:28 補充:

    刪除圖層還是沒反應

    我上傳請您看一下

    http://vspace.cc/file/LPW6UBSJJFLEBNL4.html

    2010-11-09 13:17:30 補充:

    Cola:

    您上船處有誤

    無法下載

    另外請教您"物件鎖點"

    ThisDrawing.SendCommand "osmode" & vbCr & "0" & vbCr

    ......

    ......

    ......

    ThisDrawing.SendCommand "osmode" & vbCr & "1" & vbCr

    我在展繪前"關閉" 展繪後"開啟"

    請問這樣子的方式對嗎?

    或有他山之法請您指導一下?

    志慶敬上

    2010-11-09 15:15:15 補充:

    Cola:

    這是展線與展聚合線的檔案

    http://vspace.cc/file/Z84C65YIRUCH4J5V.html

    原本展繪一條聚合線

    我再增加一條結果它在" "部分沒有截斷

    它會自己產生數據坐連線的動作

    志慶敬上

    2010-11-10 14:17:14 補充:

    Cola:

    請教您

    再畫聚合線與線中 Stop 與 .Color = 4

    這個是多餘的行列嗎?

    Sub DrawLine()

    ...

    ...

    Stop

    .Color = 4

    ...

    ...

    是不是應該刪除這兩行

    志慶敬上

還有問題?馬上發問,尋求解答。