vba過濾多段線

A. vba filter函數怎麼用

filter英文意思是過濾器。顧名思義，這個函數大致功能就是過濾篩選，它是一個針對於數組的函數。有4個參數，分別是：sourcearray(待篩選數組)，match(要查找的字元串)，include(布爾值，是否包含匹配項)，compare(字元查找對比方式)。下面用一個例子說明用法：

Subtest()
DimarrAsVariant,brrAsVariant,crrAsVariant
arr=Array(2,1,2,4,3,2)
brr=Filter(arr,2,False)
crr=Filter(arr,2,True)
MsgBox"過濾掉匹配項，保留其餘項："&vbCrLf&Join(brr,"_")
MsgBox"過濾掉不匹配項，保留匹配項目："&vbCrLf&Join(crr,"_")
EndSub
'執行結果分別是：
'過濾掉匹配項，保留其餘項：
'1_4_3
'過濾掉不匹配項，保留匹配項目：
'2_2_2

從上面的例子brr數組是從arr數組中過濾掉了2，保留其他非匹配項目組成的一個新數組，crr是從arr中去掉了非匹配項，保留了是2的項組成的新數組。所以filter第三個參數是關鍵，如果是false就不保留匹配向，是true就只保留匹配項，我們一般用的是像brr那種，crr這種現實中沒什麼意義，只是用ubound(crr)-lbound(crr)+1>0 這種來確定某個字元在某個數組中是否存在!

B. 用excel vba代碼提取CAD多段線坐標到excel裡面

我有提取CAD多段線坐標到Excel裡面的軟體，可以批量提取

C. 我想通過這段CAD VBA代碼實現提取"JMD"圖層中所有閉合二位多段線的面積統計，但是不知道哪兒錯了

Public Sub create_sset_PL()
' 創建新的選擇集
Dim sset As AcadSelectionSet
Dim FilterType() As Integer, FilterData() As Variant
ReDim gpCode(2) As Integer
ReDim dataValue(2) As Variant

Set sset = ThisDrawing.SelectionSets.Add("ssl")
'創建過濾器
'本例為過濾圖層為「JMD」的閉合多段線
'使用的是變體數組進行定義

'多段線過濾器
gpCode(0) = 0
dataValue(0) = "LWPolyline"

gpCode(2) = 70
dataValue(2) = 1
'圖層過濾器
gpCode(1) = 8
dataValue(1) = "JMD"

FilterType = gpCode
FilterData = dataValue

' 添加至選擇集中，在選擇過程中進行過濾
' 完成選擇後按回車。
sset.Select acSelectionSetAll, , , FilterType, FilterData

' 在選擇集中循環並將每一已合條件的對象面積統計輸出。

Dim sum As Double
Dim i As Integer
Dim s As Variant
Dim PlineObj As AcadLWPolyline
sum = 0
For Each PlineObj In sset
sum = sum + PlineObj.Area
Next PlineObj

ThisDrawing.Utility.Prompt "拆除砌體總面積為：" & Str(Round(sum, 3)) & " 平方米"
sset.Delete
End Sub

D. 怎樣利用VBA提取選定的cad中多段線坐標,並將這些坐標寫入txt中

1.要改兩個部份，第一步，改首行的private 為 public
2.ss_dim.Select acSelectionSetAll, , , dxf_code, dxf_value
改正:
ss_dim.SelectOnScreen dxf_code, dxf_value

這樣就是輸出選中對象了。

----------------------------
Public Sub GetLWPOLYLINECoordinates()
Dim ss_dim As AcadSelectionSet, ent As AcadLWPolyline
Dim dxf_code() As Integer, dxf_value() As Variant
Dim i As Long, j As Long
Dim dbCor As Variant, x As Double, y As Double, z As Double

Set ss_dim = ThisDrawing.SelectionSets.Add("ssLine1")
ReDim dxf_code(0), dxf_value(0)
dxf_code(0) = 0: dxf_value(0) = "LWPOLYLINE"
'ss_dim.Select acSelectionSetAll, , , dxf_code, dxf_value
ss_dim.SelectOnScreen dxf_code, dxf_value
Open "d:\aaaaa.txt" For Append As #1

For Each ent In ss_dim
For j = 0 To UBound(ent.Coordinates) \ 2
x = ent.Coordinates(j * 2)
y = ent.Coordinates(j * 2 + 1)
Print #1, (j); ",," & x & "," & y
Next
Next
Close #1
ss_dim.Clear
ss_dim.Delete
End Sub

E. CAD VBA 獲取多段線任意一點到多段線起點的距離

你的問題可以歸納為：
1、找到多段線的起點坐標
2、找到任意點的坐標，
3、將兩個版坐標點用勾股定理算一下權距離
----其中第2條，你說的任意一點，是不是指多段線的任意轉折點，方程是列不出來，但如果你能指定某點，比如說是第三點或第四點之類的，VBA是可以解決你的問題的

F. AutoCAD VBA如何判斷拾取的曲線是多段線還是樣條曲線

可以用它們的ObjectID屬性來判斷，每個對象的ObjectID屬性值是不一樣的。

G. excel 怎麼通過vba過濾出一行的重復的數據

度友，你好，如圖，公式：=MID(SUM(MID(A1&1/17,SMALL(FIND(ROW($1:$10)-1,A1&1/17),ROW($1:$10)),1)/10^ROW($1:$10)),3,COUNT(FIND(ROW($1:$10)-1,A1)))

如果是2016版本的，支持TEXTJOIN的話，公式：=TEXTJOIN("",1,IF(ISNUMBER(FIND(ROW($1:$10)-1,A1)),ROW($1:$10)-1,""))

數組公式，需要shift+ctrl+enter三鍵結束

H. AutoCAD中用vba的方式，怎樣框取多條直線（或多段線）獲取相交點坐標呢

使用while函數來循環，下面是一個計算交點的autolisp代碼：

(defunc:tes(/&k1&kw1&ss1&ss2ix)
(setvar"cmdecho"0)
(setvar"blipmode"0)
(if(nullvlax-mp-object)(vl-load-com))
(princ"
請選擇曲線")
(if(setq&kw1(ssget'((0."*LINE,ARC,CIRCLE,ELLIPSE,HELIX"))))
(progn
(setq&ss1'()i-1.0)
(while(setq&k1(ssname&kw1(setqi(1+i))))
(setq&ss1(cons&k1&ss1));提取對象
);while
(while(and(setq&k1(car&ss1))(setq&ss1(cdr&ss1)));計算這條曲線與其他對象的交點
(setq&ss2(apply'append(vl-remove-if'(lambda(x)(=xnil))
(mapcar'(lambda(x)(acet-geom-intersectwith&k1x0))&ss1))))
;&ss2是計算得到的交點,沒有交點的話是nil
);while;2
)
)
(princ)
)

I. 如何用VBA過濾多列重復數據

Sub 去重方法二()

Dim d As Object, bR, arr

t = Timer
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual

zw = [XFD1].End(xlToLeft).Column ' 自動識別最後一列。從右往左，找出第一個非空單元格，取它列號。
sm = 8 '第8列，即H列，也即運單編號所在列，根據此欄位來判斷是否有重復項。8這個數字不用改。

Set c1 = Cells(1000000, sm).End(xlUp)
qq = c1.Row

bR = [A2].Resize(qq - 1, zw) '把數據區域 裝入bR數組
Set d = CreateObject("scripting.dictionary")
n = 0
ReDim arr(1 To c1.Row, 1 To zw) '定義arr數組長，寬
For i = 2 To qq
If Not d.exists(bR(i - 1, sm)) Then
d.Add bR(i - 1, sm), "" '【核心】循環 運單編號 欄位，把此欄位唯一值循環裝入字典d
n = n + 1
For j = 1 To zw
arr(n, j) = bR(i - 1, j) '同時，再把它其他信息裝入arr數組
Next
End If
Next
Range(Cells(2, "A"), Cells(1000000, zw)).ClearContents
[A2].Resize(n, zw) = arr
Set d = Nothing: Erase bR: Erase arr

Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "搞定！耗時 " & Round(Timer - t, 0) & " 秒！已刪除 " & qq - Cells(1000000, sm).End(xlUp).Row & " 個重復項！"

End Sub

J. excel vba怎麼篩選和過濾數據

錄制一段宏，看代碼不就行了。只要界面上能操作的，不知道VBA怎麼寫都可以錄制宏，然後復制到自己的VBA代碼里修改一下即可。