[討論]有沒有那位大哥懂VBA 的能指點一下嗎?, LISP 也行!!(功能變數)

我的  "圖塊A" 中有一個自定義好的欄位叫  "F"
然後我希望能在 F 中, 用功能變數的方法, 插入某LINE 的長度。(也就是以後我只要改 LINE 的長度, F 欄位自己會更新長度值)

因為我有N多個圖塊A, 都要輸入F欄位!! 且每個F 對應到不同的 LINE 的長度, 所以我一直在想辦法減少輸入的過程
目前想達成
    1.點一下圖塊
    2.點一下LINE
    其它交給VBA .....


請問如何用VBA 還是在圖塊中的屬性輸入功能變數,
有那位大哥知道的嗎? 給個範列吧~~ 感謝!!
LISP 目前還沒接觸, 聽說語法不容易意讀...

聽你的描述,似乎可以由選取線段圖元,取出圖元的長度值,接著再選取圖塊,將長度值填入對應的圖塊"F"欄位,
但是Line長度改變,F欄位會自動改變,這種變數方式我就不會了,其實有沒有這種方法,我還不曉得,
不知道有沒有其他前輩知道,出手指點一下,
可以請你提供一下圖面範例嗎?方便做一下測試!

提供一下測試圖檔 2010 格式
第一個圖塊塊是還沒設定 LINE 欄位
第二個圖塊已插入攻能變數對應到 "旁邊的LINE長度"

或是 LISP 作的到這功能嗎?

改完 LINE 長度記得REGEN, 功能變數才會重算

測試檔
https://googledrive.com/host/0B35LzDuPHIVhWlF3eXRPakF0QmM/test.dwg

收到,給點時間研究一下!

插入功能變數的方式給了我一個想法,
程式就不用寫的太複雜!
我就借你的圖塊來做示範囉!
你用看看是不是你要的結果.
其他的參數再依你要的方式修改吧!

dj_v4圖檔存放位置,可依自己存放位置來做修改,
"C:\Documents and Settings\dj_v4.dwg"

操作前要載入lineset.dvb檔

巨集操作指令
(command "-vbarun" "pickline" )


▼操作示範
2013-07-19_0531

▼dj_v4圖塊下載位置
https://dl.dropboxusercontent.com/u/78359810/dj_v4.dwg
備用載點： https://app.box.com/s/ghaiby6sajw7vf3symj8

▼linset.dvb下載位置
https://dl.dropboxusercontent.com/u/78359810/Lineset.dvb
備用載點： https://app.box.com/s/3tkzen279b5oqk78w4ow

---

Tiger&蘋果爸 寫到: 謝謝熱心程式回覆~< 積分 +1>
[公告]關於團隊成員的回文及貢獻

這麼快!!...太感謝了~~ 我先研究一下~再上來報告~~ ^_^

剛研究完了....ginse0727 兄非常好的範例, 淺顯易懂, 連我這個新手也看的懂。真是太感謝了~~

另外就是
ThisDrawing.Utility.GetEntity objAcadEntity, varPickPoint, "請選擇要標記關聯的線段:"

這東西有沒有辦法區分出
   1.USER 按ESC 結束
   2.ENTER 結束
   3.沒選取到物件 ERROR
的情況呢?

我網上找到的範例都是用ERR.number , 可是沒點選到, 跟按ESC 都是同個錯誤碼...沒法子用來判斷情況..

程式做了以下二個改善,
1.按下"esc"及"space"鍵可離開程式.
2.沒選到物件時可再次選取,直到選到物件,不會再彈出錯誤視窗.

請重新下載,祝你使用愉快!

OK 下載完了..真的很好用, 感謝您~~
像大陸那邊的網站, 就沒有這麼熱心的了, 回答都是1~2句話帶過, 我新手程度不夠, 結果還是吸收不了

又有問題了...下面是ginse0727 兄的程式..

Public Sub PickLine()
   Dim objAcadEntity As AcadEntity
   Dim varPickPoint As Variant
   Dim objBlockRef  As AcadBlockReference
   Dim strobjID, strLineName, strLineNumber, strTime, strDrawShow, strType, strN1, strStartPoint, strEndPoint, strLinelength, strNo, strGroup, strKeepC, strCom1, strCom2 As String
   Dim objattribRef  As AcadAttributeReference
   
   ThisDrawing.Utility.GetEntity objAcadEntity, varPickPoint, "請選擇要標記關聯的線段:"
       
       strobjID = objAcadEntity.ObjectID
       strLineName = "#"
       strLineNumber = ""
       strTime = Format(Now, "yyyy/mm/dd h:m:s")
       strDrawShow = "(00-00)"
       strType = "DJ配分"
       strN1 = ""
       strStartPoint = "%<\AcObjProp Object(%<\_ObjId " & strobjID & ">%).StartPoint \f " & "%lu2%pt3%pr3" & ">%"
       strEndPoint = "%<\AcObjProp Object(%<\_ObjId " & strobjID & ">%).EndPoint \f " & "%lu2%pt3%pr3" & ">%"
       strLinelength = "%<\AcObjProp Object(%<\_ObjId " & strobjID & ">%).Length \f " & "%lu2%pr3" & ">%"
       strNo = "x"
       strGroup = "0"
       strKeepC = "0"
       strCom1 = ""
       strCom2 = ""
以下略......

紅字的部分是ObjectID是吧...
先前是填進 線段的長度.. 所以 ObjectID 都一樣..  
但如果是 圖塊的定義欄位...則針對此圖塊的每個欄位, ObjectID 是不一樣的....我猜可能填的不是ObjectID ... 那要怎麼去查這個數字是什麼呢?

測試檔
我用CAD 設好在DJ_V4 裡的 start 和 end,  分別對應到右邊圖界標2 的NU 和 NU1 , 裡面可看到ObjectID 是不一樣的...

就本程的選項而言,ObjectID指的是選取到的線段ID,也就是這條線在圖裡的"身份證"!
你要填入"圖界標2"這個圖塊"NU"和"NU1"的值,那就必須取得"圖界標2"的ObjectID,
動態圖塊的這個值,可以用filed查到,目前程式無法直接取出動態圖塊的id,
因為我也不會,要請其他前輩指點吧!

取得動態圖塊ObjectID的方法:


將參數式複制到dj_V4的指定欄位中:

' 不很了解你們的討論, 但我知道這個指令. 可能可以把直線的 Handle 存起來.
' 再用 HandleToObject 找到直線, 就是新的長度了, 參考一下

Dim line_obj As Acadline ' 假設直線的 handle 是 2de
Set line_obj = ThisDrawing.HandleToObject("2de")

我們主要是在討論 如何用程式插入功能變數,
EX : 在圖塊自訂欄位插入某LINE的長度, 後續當線段長度改變, 只要REGEN , 圖塊的欄位就自動更新了。
卡到的問題是, 如果插入的不是線段長度這種單純的東西, 比如自訂義圖塊欄位值,
那取不到這個欄位的ObjectID ...(因為圖塊中的每個欄位的ObjectID 都不同)

那就不要用功能變數或 REGEN. 儲存要參考圖塊的 handle 跟 欄位. 用 HandleToObject 指令, 程式執行去找一個一個更新可能也是可以, 達到一樣的目的就好了, 我只知道這些了, 參考一下

這個用法我沒有用過,我也想學習handle的用法,
不過我在說明裡好像沒找到,
可否請shackle_2005大大指導一下,
貼個簡單的例子給我們學習一下,
謝謝!

' 以下是 Autocad on-line help 的說明
' Handle 就是你 list 一個物件, 第三行"處理碼"這個欄位會出現英文字母跟數字
' 運用這個處理碼跟 HandleToObject 就可以抓到這個物件, 參考一下

Sub Example_HandleToObject()
' This example creates a spline in model space, and returns the
' handle for the spline. Then the spline is returned from the handle and colored.

' Create the spline
Dim splineObj As AcadSpline
Dim startTan(0 To 2) As Double
Dim endTan(0 To 2) As Double
Dim fitPoints(0 To 8) As Double

startTan(0) = 0.5: startTan(1) = 0.5: startTan(2) = 0
endTan(0) = 0.5: endTan(1) = 0.5: endTan(2) = 0
fitPoints(0) = 1: fitPoints(1) = 1: fitPoints(2) = 0
fitPoints(3) = 5: fitPoints(4) = 5: fitPoints(5) = 0
fitPoints(6) = 10: fitPoints(7) = 0: fitPoints(8) = 0
Set splineObj = ThisDrawing.ModelSpace.AddSpline(fitPoints, startTan, endTan)

ZoomAll

' Find the handle of the spline
Dim handle As String
handle = splineObj.handle
MsgBox "The handle of the Spline is: " & splineObj.handle, , "HandleToObject Example"

' Find an object from a given handle
Dim tempObj As AcadObject
Set tempObj = ThisDrawing.HandleToObject(handle)

' Now use the newly initialized object variable to color the object
Dim color As AcadAcCmColor
Set color = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.19")
Call color.SetRGB(80, 100, 244)

tempObj.TrueColor = color

ThisDrawing.Regen True
MsgBox "The Spline is now blue.", , "ObjectIDToObject Example"

End Sub

感謝您!我又多學了一種用法.
所以是取得物件的處理碼後,將它存在特定屬性圖塊裡,一旦出現某一個特定的指令,
再重新掃瞄這些屬性圖塊,依次取出物件處理碼,來更新物件的新值,
是這樣的邏輯嗎?

應該是這樣, 我也只是提供可用指令參考, 我的工作很少需要版主所提這樣的要求. HandleToObject 最基本可以用在新程式剛開始寫的時候. 如果你需要先選擇一個物件 Thisdrawing.Utility.GetEntity........ 那就可以用這個功能 HandleToObject 直接去抓這個物件, 程式可能要測試幾十次, 你就不用每次都要用滑鼠去選. 直接測試下面的程式碼, 大概就這樣, 參考一下. Thanks

ginse0727 寫到:感謝您!我又多學了一種用法.
所以是取得物件的處理碼後,將它存在特定屬性圖塊裡,一旦出現某一個特定的指令,
再重新掃瞄這些屬性圖塊,依次取出物件處理碼,來更新物件的新值,
是這樣的邏輯嗎?

目前我也是改用這種方式, 本來用功能變數是想偷懶, 只接利用CAD 提供的功能, 結果還是跑不掉

你改用的方式,方便po出來借參考一下嗎?
雖說我覺得有點概念,但還是覺得程式寫起來有點複雜,
如果可以參考一下你的應用,說不定是我想太多了,
可以少走點冤路.

其實會復雜很多...我也還沒寫完, 不過大約架構是這樣, 我只會這種土方法, 各位前輩可能有比較好的方法吧
其實基本上就是在圖塊多個欄位, 像我是 "起配" 則現在多一個 "S起配" ,
"S起配"這個用來放 ObjectID,
然後 RUN update程序, update 程序取出 "S起配" (ObjectID) 這圖塊中的START 欄位 , 寫到 "起配"

Sub marks_SetStartEnd()
  Dim Tar_obj As AcadEntity
  Dim start_obj As AcadEntity
  Dim end_obj As AcadEntity
  Dim line_obj As AcadEntity
  Dim IDstart As String
  Dim IDend As String
  Dim IDline As String
  Dim strStart As String
  Dim strEnd As String
  Dim strline As String
 
  On Error Resume Next
 
  Call ShowGetEn("請選擇 Start 圖塊", start_obj)
  IDstart = start_obj.ObjectID ' 我的是tar_obj 需要去參考到 start_obj 中的start 欄位
  Call writeBlock("S起配", IDstart, Tar_obj)            '寫入到 "S起配" 欄位
 
  Call ShowGetEn("請選擇 End 圖塊", end_obj)
  IDend = end_obj.ObjectID
  Call writeBlock("S終配", IDend, Tar_obj)
Sub marks_SetStartEnd()

------------------------------------------------------------------

用過濾器找出要處理的圖塊放到 ListBox .....這段程式省略...各位比我還熟...

------------------------------------------------------------------

Public Function UpdateLineSE(value As ListBox) As RecordLine
    Dim tempObj  As AcadObject
    Dim tempStart  As AcadObject
    Dim tempEnd  As AcadObject
   
    Dim Index As Integer
    Dim aID  As String
    Dim strStartObjID  As String
    Dim strEndObjID  As String
    Dim strStart  As String
    Dim strEnd  As String
   
   On Error Resume Next
   
       For Index = 0 To value.ListCount - 1
             Set tempObj = ThisDrawing.ObjectIdToObject(value.list(Index))
             strStartObjID = ReadBlock("S起配", tempObj)                        'READ "S起配" 欄
             Set tempStart = ThisDrawing.ObjectIdToObject(strStartObjID)' 取得"S起配" 欄 記錄的物件
             strStart = ReadBlock("START", tempStart)                             ' 取得物件圖塊的START 欄位 , 這裡是真正要取得的圖塊數值
                                                                                                       ' 可以再加入一些運算, 比如 設計長度 x105%, 5%當備用料
             Set tempObj = ThisDrawing.ObjectIdToObject(value.list(Index))
             strEndObjID = ReadBlock("S終配", tempObj)
             Set tempEnd = ThisDrawing.ObjectIdToObject(strEndObjID)
             strEnd = ReadBlock("COM2", tempEnd)
             
             Call writeBlock("起配", strStart, tempObj)                              ' 再寫回到圖塊, 更新完畢,
             Call writeBlock("終配", strEnd, tempObj)
       Next Index
End Function

謝謝!
感謝你分享自己的程式給我觀摩,
雖然我工作上也沒有需要用到像你目前這樣的處理方式!
有困難再提出來討論吧!
祝你早日開發成功!

VBA只能讀寫「圖塊的屬性參考」、「物件的xData」，沒辦法直接讀寫「自定義屬性」，
就我知道的方法是
先做一個專門讀自定義欄位的Class，做成dll檔，
Imports Autodesk.Gis.Map
Imports Autodesk.Gis.Map.ObjectData
Imports Autodesk.Gis.Map.Constants
Imports Autodesk.Gis.Map.Utilities
然後開啟CAD用Netload指令，把這個dll載到CAD裡面，
然後就可以直接下Command讀。
可以參考CAD網頁這位講師的說明，
http://autodesk.mediasite.com/Mediasite/Play/fd6f4e668e1243cba87257abc7c1c379

雖然是有點久的主題，不過我覺得有點意思，就試著寫了一個小程式
借用AUTOCAD圖檔性質裡的自訂性質的欄位，將線及文字連結起來
改變文字的數字，線的長度能跟著變
改變線的長度，數字也能跟著變

操作如下
LineNText

程式碼如附件

Vincera,
觀摩過您的程式,真的是很精簡明確,這樣的方式也是我未曾有過的經驗,這樣的方式應讓很容易就可以處理好蜻蜓草的需求,謝謝您的賜教.
測試了一下,發現好像線段如果不是一開始從原點開始畫出制定,選用隨機畫的話,程式run過數值或是線段的長度就會變的不正確,
這點有辦法克服嗎?