Đến nội dung


Hình ảnh
- - - - -

Xin lisp / vba xác định chiều dài của nhiều đường polyline


  • Please log in to reply
3 replies to this topic

#1 BKXD98

BKXD98

    biết vẽ circle

  • Members
  • PipPip
  • 32 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 16 August 2007 - 05:27 PM

Tôi đang cần lisp hay vba để xác định tổng chiều dài của nhiều đường polyline, bác nào có vui lòng cho tôi xin với.
Tôi cũng biết lisp và vba nhưng chưa tìm ra được giải thuật để viết (trong acad tôi ko tìm thấy system variable nào chứa chiều dài của nó (giống như biến area chứa diện tích sau khi dùng lệnh area), còn bảng mã dxf của đối tượng polyline chỉ chứa tọa độ các điểm, nếu tính tay từng đoạn thì đối với phân đoạn arc trong poline thì sao ??), nếu bác nào đã biết vui lòng hướng dẫn tôi phương pháp cũng được.
Xin cảm ơn.
  • -1

#2 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 4105 Bài viết
Điểm đánh giá: 4495 (đỉnh cao)

Đã gửi 16 August 2007 - 05:44 PM

Tôi đang cần lisp hay vba để xác định tổng chiều dài của nhiều đường polyline, bác nào có vui lòng cho tôi xin với.
Tôi cũng biết lisp và vba nhưng chưa tìm ra được giải thuật để viết (trong acad tôi ko tìm thấy system variable nào chứa chiều dài của nó (giống như biến area chứa diện tích sau khi dùng lệnh area), còn bảng mã dxf của đối tượng polyline chỉ chứa tọa độ các điểm, nếu tính tay từng đoạn thì đối với phân đoạn arc trong poline thì sao ??), nếu bác nào đã biết vui lòng hướng dẫn tôi phương pháp cũng được.
Xin cảm ơn.

- Lisp: để tính chiều dài của đối tượng bạn xem ở đây:
http://www.cadviet.com/forum/index.php?showtopic=763

- VBA: để tính chiều dài của đối tượng, bạn dùng thuộc tính (property) Length của nó.
Đây là ví dụ mẫu của AutoCAD:


Sub Example_Length()
' This example adds a line in model space and returns the length of the new line

Dim lineObj As AcadLine
Dim startPoint(0 To 2) As Double, endPoint(0 To 2) As Double

' Define the start and end points for the line
startPoint(0) = 1: startPoint(1) = 1: startPoint(2) = 0
endPoint(0) = 5: endPoint(1) = 5: endPoint(2) = 0

' Create the line in model space
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)

ThisDrawing.Application.ZoomAll

MsgBox "The length of the new Line is: " & lineObj.length
End Sub

  • 0

#3 phantuhuong

phantuhuong

    biết dimstyle

  • Moderator
  • PipPipPipPipPip
  • 383 Bài viết
Điểm đánh giá: 200 (khá)

Đã gửi 16 August 2007 - 09:26 PM

Anh BKXD98 ơi, thử xem cái này này:

http://www.cauduong.net/forum_posts.asp?TID=1241&PN=1
  • 0
Bồi dưỡng Excel & VBA cho các đơn vị ở Hà Nội và khu vực lân cận

Từng bước loại đồ Tàu ra khỏi cuộc sống!


#4 BKXD98

BKXD98

    biết vẽ circle

  • Members
  • PipPip
  • 32 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 17 August 2007 - 12:04 AM

Xin cảm ơn các bác !

Qua đây, tôi mới biết thêm là lệnh "lengthen" có chức năng là xác định chiều dài 1 đối tượng và biến "PERIMETER" lưu giá trị này, còn vba thì quá đơn giản (do tôi vội quá nên nhờ vả mà ko chịu đọc help).

Tôi cũng đã search trên google tìm được đoạn code này trên 1 forum của nước ngoài, chức năng là xác định tổng chiều dài / diện tích của các đường polyline thuộc 1 layer
;   Length/Area of Polyline by Layer
; David Bethel May 2004 from an original idea by David Watson
; This command will give a total area or length for all polylines on a specified layer.
;
(defun c:zone ( / ss la rv i tv op en)

(while (not ss)
(princ "\nPick any object on the required layer")
(setq ss (ssget)))

(initget "Length Area")
(setq rv (getkword "\nWould you like to measure Length/<Area> : "))
(and (not rv)
(setq rv "Area"))

(setq la (cdr (assoc 8 (entget (ssname ss 0))))
ss (ssget "X" (list (cons 0 "*POLYLINE")
(cons 8 la)))
i (sslength ss)
tv 0
op 0)
(while (not (minusp (setq i (1- i))))
(setq en (ssname ss i))
(command "_.AREA" "_E" en)
(cond ((= rv "Length")
(setq tv (+ tv (getvar "PERIMETER"))))
(T
(setq tv (+ tv (getvar "AREA")))
(if (/= (logand (cdr (assoc 70 (entget en))) 1) 1)
(setq op (1+ op))))))

(princ (strcat "\nTotal " rv
" for layer " la
" = " (rtos tv 2 2)
" in " (itoa (sslength ss)) " polylines\n"
(if (/= rv "Length")
(strcat (itoa op) " with open polylines") "")))
(prin1))

  • -1