sub polylinelength() dim pnt as variant dim ent as acadentity on error resume next do thisdrawing.utility.getentity ent, pnt, "选择多段线:" if err then exit sub if typename(ent) like "iacad*polyline" then exit do loop dim coordinatecount as long if typename(ent) = "iacadlwpolyline" then coordinatecount = (ubound(ent.coordinates) + 1) / 2 elseif (typename(ent) = "iacadpolyline" and ent.type = acsimplepoly) or (typename(ent) = "iacad3dpolyline" and ent.type = acsimple3dpoly) then coordinatecount = (ubound(ent.coordinates) + 1) / 3 else exit sub end if dim i as long dim totallength as double dim bugle as double if typename(ent) = "iacad3dpolyline" then for i = 0 to coordinatecount - 2 totallength = totallength + getarcleng(ent.coordinate(i), ent, coordinate(i + 1), 0) next if ent.closed then totallength = totallength + getarcleng(ent.coordinate(coordinatecount - 1), ent.coordinate(0), 0) else for i = 0 to coordinatecount - 2 totallength = totallength + getarcleng(ent.coordinate(i), ent.coordinate(i + 1), ent.getbulge(i)) next if ent.closed then totallength = totallength + getarcleng(ent.coordinate(coordinatecount - 1), ent.coordinate(0), ent.getbulge(coordinatecount - 1)) end if msgbox "选定多段线的总长度为:" & totallength end sub private function getarcleng(points as variant, pointe as variant, bugle as double) as double dim angle as double dim radius as double dim length as double dim dist as double dim i as integer for i = lbound(points) to ubound(points) dist = dist + ((points(i) - pointe(i)) ^ 2) next length = sqr(dist) if bugle = 0 then getarcleng = length else angle = 4 * atn(abs(bugle)) radius = (length / 2) / sin(angle / 2) getarcleng = radius * angle end if end function |
|