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代码里修改一下即可。