[討論]有沒有圖塊的快速標註方法？

由 **naruto018** 2017-01-10, 10:26

圖面上有多個圖塊需要標註
但因為太多個，又因為多個區域
標註在基準點上
我只找到QDIM的快速標註圓和弧
但沒法用在圖塊
所以有沒有圖塊的快速標註方法？

[討論]有沒有圖塊的快速標註方法？ 1MLO2Cm

上圖都是圖塊
標註成如下圖(希望可以標註再插入點或圖塊中心)
[討論]有沒有圖塊的快速標註方法？ YJnoDg9

(如看不到圖片請案右鍵分頁開啟圖片)

由 **pc200098** 2017-01-13, 11:50

請可以列個使用方式嗎? 因為QIDM有很多功能，標註方向、方式都會因使用者而不同。

由 **naruto018** 2017-01-14, 12:52

使用QDIM沒辦法把圖塊的插入點當作標註點
會顯示成無效點
無法標註出來
但是使用QDIM裡的編輯-加入標著點可以選到圖塊地插入點
才能夠標註
[討論]有沒有圖塊的快速標註方法？ Hiuzdvy

由 **shackle_2005** 2017-01-14, 13:44

選取物件會過濾不是圖塊的物件, 程式會自動抓圖塊的中心點, 然後再點選標註要落下的地方. 試用一下如果有問題我再修改, 因為我只會寫程式, 不會畫圖. 3Q !!

附件

: block_qdim_20170114.zip 您無權下載這里的附件。(26 Kb) 下載 23 次

由 **naruto018** 2017-01-14, 14:49

shackle_2005 寫到:選取物件會過濾不是圖塊的物件, 程式會自動抓圖塊的中心點, 然後再點選標註要落下的地方. 試用一下如果有問題我再修改, 因為我只會寫程式, 不會畫圖. 3Q !!

感謝shackle_2005大大
我試用了一下
大致上就是我要的
不過我發現有個問題
如果選擇註解的平行方向上有2個以上的物體的話
會出現標註為0的問題
[討論]有沒有圖塊的快速標註方法？ O8OaU3q

由 **shackle_2005** 2017-01-14, 15:16

方便的話可能上傳一下有問題的部份dwg sample 圖檔. 我不會畫圖, 測試我是自己隨便弄兩個圖塊, 不太了解問題. 3Q

由 **naruto018** 2017-01-14, 17:23

大致上類似CAD檔內的房間
我挑出不同圖塊密度比較高部分
感謝大大的幫忙

附件

: Drawing1.zip 您無權下載這里的附件。(51 Kb) 下載 14 次

由 **shackle_2005** 2017-01-14, 17:59

我懂了, 程式我花五分鐘就寫好了, 是簡單陽春的功能. 所以同高度的圖塊之間也會標註, 所以會是 0. 比較簡單的方法就是不要全選圖塊, 同高度選一個圖塊就好了. 同高度只要標註一個, 不出現 0, 這就比較複雜, 我要慢慢試. OK

由 **jenniferaptg** 2017-01-14, 22:35

終於找到我要的程式了因為每次都要花很多時間在對點也誠心感謝善心人士分享這個程式讓我提高工作效率

由 **shackle_2005** 2017-01-14, 23:02

圖塊快速標註(VBA) 程式原理說明 : 1. 先過濾出要標註的圖塊. 2. 圖塊.getboundingbox 這個 VBA 程式指令可以得到圖塊的左下角及右上角點座標. 3. 得到這兩個座標就可以算出圖塊的正中心點. 4. 在每個圖塊的正中心點畫一個假功能的小圓 5. 建立一個新的群組, 把假功能的小圓都加入. 6. 因為 qdim 指令可以輸入群組(G), 所以把很多小圓的群組餵給 qdim 指令. 7. 再點選標註落點, 這樣就標註好了, 最後再把所有假功能的小圓全部刪除. 我個人覺得 VBA 寫有點難又不太難的程式很好用, 大家可以參考一下.

由 **naruto018** 2017-01-15, 08:34

shackle_2005 寫到:圖塊快速標註(VBA) 程式原理說明 : 1. 先過濾出要標註的圖塊. 2. 圖塊.getboundingbox 這個 VBA 程式指令可以得到圖塊的左下角及右上角點座標. 3. 得到這兩個座標就可以算出圖塊的正中心點. 4. 在每個圖塊的正中心點畫一個假功能的小圓 5. 建立一個新的群組, 把假功能的小圓都加入. 6. 因為 qdim 指令可以輸入群組(G), 所以把很多小圓的群組餵給 qdim 指令. 7. 再點選標註落點, 這樣就標註好了, 最後再把所有假功能的小圓全部刪除. 我個人覺得 VBA 寫有點難又不太難的程式很好用, 大家可以參考一下.

感謝shackle_2005大大的解說
雖然我寫過Excel VBA(不精通)
但沒寫過AutoCAD的
不清楚相關的控制指令的部分
所以我沒有去碰，加上不清楚哪裡可以找到相關的範例和教學

不過我測試一下QDIM的指令
並排好幾個圓並不會出現標註為0的問題
[討論]有沒有圖塊的快速標註方法？ Zm1Lx2m

由 **shackle_2005** 2017-01-15, 10:52

這證明我不會畫圖, Qdim 怎麼運作我不了解, 我只是把圖塊餵給 Qdim, 我再慢慢研究一下, 加油!!

Dim tm As AcadModelSpace
Dim tu As AcadUtility
Dim ent_set As AcadSelectionSet
Dim group_obj As AcadGroup
Dim ent_obj As AcadObject
Dim add_entity(0) As AcadEntity
Dim min_p As Variant
Dim max_p As Variant
Dim center_p(0 To 2) As Double ' 一般我都用 double 雙倍精度, 所以高度差一點點, 就會不對.
Dim cir As AcadCircle
Dim group_name As String
Dim dim_p As Variant

' 設定 tm 為這張圖面的模型空間, 設定 tu 為這張圖面的公用程式
Set tm = ThisDrawing.ModelSpace: Set tu = ThisDrawing.Utility

Do While True

Set ent_set = ThisDrawing.SelectionSets.Add(rnd_process)

tu.prompt "請選取要標註的物件!!....... Esc(結束)"

ent_set.SelectOnScreen

If ent_set.count = 0 Then Exit Do

dim_p = tu.GetPoint(, "請點選標註落點!!..........")

If Err Then Exit Do

group_name = rnd_process

Set group_obj = ThisDrawing.Groups.Add(group_name)

For Each ent_obj In ent_set

If TypeOf ent_obj Is AcadBlockReference Then

' *** 抓圖塊左下跟右上角點座標
ent_obj.GetBoundingBox min_p, max_p

' *** 計算圖塊的正中心點, 多個平行的圖塊, 正中心點只要差個 0.0000000001, Qdim 就會以為是不同高度的圖塊.
center_p(0) = (min_p(0) + max_p(0)) / 2: center_p(1) = (min_p(1) + max_p(1)) / 2

Set cir = tm.AddCircle(center_p, 1): cir.Update

Set add_entity(0) = cir: group_obj.AppendItems add_entity
End If
Next ent_obj

' ***************** 執行 Qdim, 把小圓組成的群組餵給指令 *********************************
ThisDrawing.SendCommand "qdim" & vbCr & "g" & vbCr & group_name & vbCr & vbCr & _
p_str_2d(dim_p) & vbCr
For Each ent_obj In group_obj
ent_obj.Delete
Next ent_obj

group_obj.Delete

Loop