Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Nguyen Hoanh

Viết lisp theo yêu cầu [phần 2]

Các bài được khuyến nghị

Đưa các đường contour về cao độ 0, có đưa cả text cao độ về cao độ 0 luôn không conghoan?

Chỉ cần các đường contour thôi a Thiep a, các text để vậy cũng được. Để mai em lên cty kiểm tra lênh Flatten của anh Natca thế nào! Cảm ơn a Thiệp nha!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Nhờ các bác viết hộ cái lisp sau:

Mình có một polyline, biết cao độ hai điểm bất kỳ nằm trong polyline, mình muốn nội suy các cao độ nằm giữa hai điểm này.

trình tự thực hiện như thế này:

Chạy lisp:

Chọn polyline

pick điểm rồi nhập cao độ tại điểm này (cao độ điểm này đã có)

pick điểm và nhập cao độ điểm thứ hai (cao độ điểm này đã có)

pick điểm cần tìm cao độ (thuộc polyline) (Dùng phép nội suy tính ra cao độ điểm này)

pick điểm ghi cao độ điểm này.

pick điểm cần tìm thứ 2.

pick điẻm ghi cao độ điểm thứ 2.

Tiếp tục tìm cao độ các điểm khác..

Thank!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Bạn sử dụng Code này thử nhé :

(defun c:dk (/ V H tam)
(setq tam (getpoint "\nNhap tam cua solid hinh tru:"))
(setq V (getreal "\nNhap the tich cua solid hinh tru:")
H (getreal "\nNhap chieu cao cua solid hinh tru: ")
D (sqrt (/ (* V 4) (* H pi)))
)
(command "cylinder" tam (/ D 2) H) 
(alert 
(strcat "\n The tich cua solid hinh tru la :  " (rtos V 2 3) 
	"\n\n Chieu cao cua solid hinh tru la :  " (rtos H 2 3)
"\n\n Ket qua tinh duong kinh cua solid hinh tru :  " (rtos D 2 3)
)
)
(princ)
)

AutoLisp thật tuyệt vời...

Cảm ơn món quà mà Autodesk đã tặng cho chúng ta.

Cảm ơn tất cả.

Cảm ơn anh Tuệ đã nói trúng ý mình. Mình thấy yêu thích AutoLisp và yêu đời hơn. Nhất định mình sẽ học viết lisp, anh Tuệ hãy nói cho mình biết: để viết được lisp cần phải trang bị những kiến thức gì. Anh bớt chút thời gian, viết kinh nghiêm của bản thân từ lúc mới làm quen với lisp, đến khi viết được lisp. Chúc anh vui, khỏe , thành công, thành đạt ,trong cuộc sống! Cảm ơn anh nhiều nhé! :bigsmile: :bigsmile: :cry:

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Nhờ các bác viết hộ cái lisp sau:

Mình có một polyline, biết cao độ hai điểm bất kỳ nằm trong polyline, mình muốn nội suy các cao độ nằm giữa hai điểm này.

trình tự thực hiện như thế này:

Chạy lisp:

Chọn polyline

pick điểm rồi nhập cao độ tại điểm này (cao độ điểm này đã có)

pick điểm và nhập cao độ điểm thứ hai (cao độ điểm này đã có)

pick điểm cần tìm cao độ (thuộc polyline)

(Dùng phép nội suy tính ra cao độ điểm này)

Phức tạp vậy bạn? -> Sư dụng lệnh ID là xong.

 

Command: id

Specify point: X = 3497.0558 Y = 3497.0558 Z = 10.4912 -> Chọn 1 điểm trên PLINE

 

-> Z = 10.4912 : đây chính là cao độ cần tìm

  • Vote tăng 2

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Trước đây Tue_NV có viết cho mình cái lisp vẽ ký hiệu cắt ống. Nhưng nay vì công việc nên mình muốn phát triển thêm để tiện trong quá trình thiết kế. Nên mình có yêu cầu thế này nhờ Tue_NV hoặc các bạn giúp mình. Mình cảm ơn

Lisp trên chỉ vẽ được có 1 chiều (như hình 1), mình muốn khi pick điểm bất kỳ thì các hướng sẽ khác nhau (như hình minh hoạ đính kèm- Hình 2, 3, 4)

Mình gửi kèm file lisp và dwg

File đây: http://www.cadviet.com/upfiles/2/cat_ong.rar

Visit My Website

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Sao bác không dùng lệnh Flatten của Cad?

Cảm ơn a CHung nhiều, cái này đúng ý của em rồi!

@thiêp: Cái này e làm được rồi cảm ơn a Thiệp nha. không cần viết lisp nữa.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Phức tạp vậy bạn? -> Sư dụng lệnh ID là xong.

 

Command: id

Specify point: X = 3497.0558 Y = 3497.0558 Z = 10.4912 -> Chọn 1 điểm trên PLINE

 

-> Z = 10.4912 : đây chính là cao độ cần tìm

Thực tế thì các cao độ của polyline này đều bằng không hết rồi. Công viêc. của mình là làm quy hoạch. muốn tìm cao độ đặt hố ga trên tuyến khi biết cao độ hố đầu tiên và hố cuối cung, giờ mình muốn tìm cao độ của các hố ở giữa. Mong tue giúp đỡ! Thank!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Trước đây Tue_NV có viết cho mình cái lisp vẽ ký hiệu cắt ống. Nhưng nay vì công việc nên mình muốn phát triển thêm để tiện trong quá trình thiết kế. Nên mình có yêu cầu thế này nhờ Tue_NV hoặc các bạn giúp mình. Mình cảm ơn

Lisp trên chỉ vẽ được có 1 chiều (như hình 1), mình muốn khi pick điểm bất kỳ thì các hướng sẽ khác nhau (như hình minh hoạ đính kèm- Hình 2, 3, 4)

Mình gửi kèm file lisp và dwg

File đây: http://www.cadviet.com/upfiles/2/cat_ong.rar

Visit My Website

Bạn thay dòng :

(command ".INSERT" "C:\\Program Files\\AutoCAD 2007\\Support\\daucat.dwg" po tle tle 0)

thành dòng :

(command ".INSERT" "C:\\Program Files\\AutoCAD 2007\\Support\\daucat.dwg" po tle tle (/ (* (angle po1 po2) 180) pi))

 

đồng thời vào file daucat.dwg ở địa chỉ C:\\Program Files\\AutoCAD 2007\\Support\\daucat.dwg

xoay hình vẽ 1 góc 90 độ ngược chiều kim đồng hồ và điểm Rotate là gốc toạ độ 0,0,0 -> giống y như hình số 3) mà bạn đã post là OK(

 

@ut_cung : Bạn vui lòng nói rõ hơn. Càng chi tiết, càng cụ thể -> càng tốt. Nếu có thể, bạn hãy upload file dwg minh hoạ

  • Vote tăng 2

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Bạn thay dòng :

(command ".INSERT" "C:\\Program Files\\AutoCAD 2007\\Support\\daucat.dwg" po tle tle 0)

thành dòng :

(command ".INSERT" "C:\\Program Files\\AutoCAD 2007\\Support\\daucat.dwg" po tle tle (/ (* (angle po1 po2) 180) pi))

 

đồng thời vào file daucat.dwg ở địa chỉ C:\\Program Files\\AutoCAD 2007\\Support\\daucat.dwg

xoay hình vẽ 1 góc 90 độ ngược chiều kim đồng hồ và điểm Rotate là gốc toạ độ 0,0,0 -> giống y như hình số 3) mà bạn đã post là OK(

Cảm ơn Tue_NV nhiều lắm

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Bạn làm như thế này :

Command: pe PEDIT -> gõ lệnh PE (hoặc PEDIT)

Mình muốn PE các đường Spline , line & Arc nhưng không được . Lệnh PE có nối được không, nếu không nhờ các anh viết giúp lisp nối Spline với các đường khác để nó trở thành 1 đối tượng như đường Polyline?

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

ai có thể viết lisp đổi màu layer dùm mình đc ko?

Đầu tiên chọn layer muốn đổi , sau đó hiện bảng màu để mình chọn hoặc có thể đánh số màu mình cần , mình tìm trong diễn đàn mà ko thấy cái lisp này...

mình cám ơn trước nha :bigsmile:

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Mình muốn PE các đường Spline , line & Arc nhưng không được . Lệnh PE có nối được không, nếu không nhờ các anh viết giúp lisp nối Spline với các đường khác để nó trở thành 1 đối tượng như đường Polyline?

Chỉ có thể nối Spline với Spline (bằng lệnh Join), Pline, line, arc với Pline, line, arc (bằng lệnh Pe với lựa chọn join hoặc lệnh Join) bạn ạ

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
@ut_cung : Bạn vui lòng nói rõ hơn. Càng chi tiết, càng cụ thể -> càng tốt. Nếu có thể, bạn hãy upload file dwg minh hoạ

Có nghĩa là mình muốn tìm cao độ của các điểm trên 1 polyline khi đã có cao độ hai điểm trên polyline này. và sau đó xuất ra 1 cái text luôn.

dwg: http://www.cadviet.com/upfiles/2/thu.dwg

Thank!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Nhờ các anh em giúp cho Thiep 1 đoạn mã lisp: làm sao khi pick vào 1 đa tuyến kín, thì Cad sẽ in ra màn hình đa tuyến được tạo bởi các điểm theo thứ tự vị trí cùng chiều hay ngược chiều kim đồng hồ.

Đây là 1 hình ảnh đa tuyến được tạo bởi các điểm theo thứ tự vị trí ngược chiều kim đồng hồ:

chieutaodatuyen.jpg

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
ai có thể viết lisp đổi màu layer dùm mình đc ko?

Đầu tiên chọn layer muốn đổi , sau đó hiện bảng màu để mình chọn hoặc có thể đánh số màu mình cần , mình tìm trong diễn đàn mà ko thấy cái lisp này...

mình cám ơn trước nha :bigsmile:

Sao không sử dụng lệnh của cad nhỉ?? :bigsmile:

Lệnh: LAYER

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Nhờ các anh em giúp cho Thiep 1 đoạn mã lisp: làm sao khi pick vào 1 đa tuyến kín, thì Cad sẽ in ra màn hình đa tuyến được tạo bởi các điểm theo thứ tự vị trí cùng chiều hay ngược chiều kim đồng hồ.

Đây là 1 hình ảnh đa tuyến được tạo bởi các điểm theo thứ tự vị trí ngược chiều kim đồng hồ:

chieutaodatuyen.jpg

Thiệp viết hơi bị khó hiểu.

có phải là : ghi Text tại đỉnh Pline theo thứ tự vị trí cùng chiều hay ngược chiều kim đồng hồ.

;ATP -> Add Text Pline
(defun c:ATP (/ cEnt chcao cObj dc dd dg kc_txt ov param vl vt)
 (vl-load-com)
   (setq vl '("CMDECHO" "OSMODE" "AUPREC") ; Sys Var list
  ov (mapcar 'getvar vl)) ; Get Old values
 (mapcar 'setvar vl '(0 0 3)) ; Set new values  
 (if (and (setq cEnt (car (entsel "\nSelect Polyline: ")))
          (eq "AcDbPolyline"
            (vla-get-ObjectName
              (setq cObj (vlax-ename->vla-object cEnt)))))
   (progn
     (if (not (setq chcao (getreal (strcat "\nNhap chieu cao Text <" (rtos (getvar "TEXTSIZE") 2 1) "> :")) ))
(setq chcao (getvar "TEXTSIZE") )	
)
     (setq param 1
    dd (vlax-curve-getStartPoint cObj)
    kc_txt (* 1.5 chcao))
     (if (< (cadr dd)(cadr (vlax-curve-getPointAtParam cObj (1+ param))))
  (setq vt (polar dd (/ pi 2) kc_txt))
  (setq vt (polar dd (/ pi -2) kc_txt))
  )
     (Make_Text vt "K0" chcao)
     (while (< param (vlax-curve-getEndParam cObj))
(setq dg (vlax-curve-getPointAtParam cObj param)
      dc (vlax-curve-getPointAtParam cObj (1+ param))     )	
(if (> (cadr dg)(cadr dc))
  (setq vt (polar dg (/ pi 2) kc_txt))
  (setq vt (polar dg (/ pi -2) kc_txt))
  )
(Make_Text vt (strcat "K" (itoa param)) chcao)	
(setq param (1+ param )
      dd dg )
)
     )
   (princ "\n<< No Polyline Selected >>"))
 (mapcar 'setvar vl ov) ; reset Sys Vars
 (princ))

(defun Make_Text  (pt val h)
 (entmake (list (cons 0 "TEXT")
                (cons 62 2);color
                (cons 10 pt);position
                (cons 40 h);height
                (cons 1 val)
                '(71 . 0)
                '(72 . 1)
                '(73 . 1)
	 (cons 11 pt)
                )))

  • Vote tăng 2

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
ai có thể viết lisp đổi màu layer dùm mình đc ko?

Đầu tiên chọn layer muốn đổi , sau đó hiện bảng màu để mình chọn hoặc có thể đánh số màu mình cần , mình tìm trong diễn đàn mà ko thấy cái lisp này...

mình cám ơn trước nha :bigsmile:

*Tiện ích đổi màu của layer thuộc đối tượng chọn.

-Tên lệnh: DML

-Thao tác:

+Nhập lệnh DML

+Chọn 1 đối tượng thuộc layer muốn đổi màu.

+Chọn màu muốn thay

-Layer chứa đối tượng sẽ được sửa thành màu vừa chọn.

day!!!!!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Thiệp viết hơi bị khó hiểu.

có phải là : ghi Text tại đỉnh Pline theo thứ tự vị trí cùng chiều hay ngược chiều kim đồng hồ.

Không phải là ghi text tại đỉnh đa tuyến đâu bác Gia_bach ạ, mà là làm sao xác định được đa tuyến có các đỉnh được tạo theo thứ tự ngược chiều kim đồng hồ hay không?

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Không phải là ghi text tại đỉnh đa tuyến đâu bác Gia_bach ạ, mà là làm sao xác định được đa tuyến có các đỉnh được tạo theo thứ tự ngược chiều kim đồng hồ hay không?

Vấn đề của bạn là làm sao xác định đuợc tâm của đa tuyến (vị trí gắn kim đồng hồ ấy mà).

Sau khi có tâm, lần luợt duyệt qua các đỉnh -> tính góc của đỉnh.

phụ thuộc vào số đo các góc tăng hay giảm -> các đỉnh được tạo theo thứ tự ngược chiều kim đồng hồ hay thuận chiều kim đồng hồ.

  • Vote tăng 4

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Vấn đề của bạn là làm sao xác định đuợc tâm của đa tuyến (vị trí gắn kim đồng hồ ấy mà).

Sau khi có tâm, lần luợt duyệt qua các đỉnh -> tính góc của đỉnh.

phụ thuộc vào số đo các góc tăng hay giảm -> các đỉnh được tạo theo thứ tự ngược chiều kim đồng hồ hay thuận chiều kim đồng hồ.

Thuật toán của Giabach hay lắm, Thiep sẽ làm ngay.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

em thấy bên layout dùng cũng khá hay nhưng khi muốn khóa hay mở khóa,chọn tỉ lệ,tắt, mở ... của 1 khung nhìn cũng hơi lâu vì toàn phải ấn properties lên rồi mới chọn được. các bác viết hộ em cái lisp để mình có thể khóa, mở khóa khung nhìn hay để nhập tỉ lệ cho mối khung nhìn được không? cám ơn các bác trước nhé

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Nhờ các anh em giúp cho Thiep 1 đoạn mã lisp: làm sao khi pick vào 1 đa tuyến kín, thì Cad sẽ in ra màn hình đa tuyến được tạo bởi các điểm theo thứ tự vị trí cùng chiều hay ngược chiều kim đồng hồ.

Đây là 1 hình ảnh đa tuyến được tạo bởi các điểm theo thứ tự vị trí ngược chiều kim đồng hồ:

chieutaodatuyen.jpg

Bạn hãy dùng công thức tính diện tích bằng tọa độ. Nếu kq quả là dương là ngược chiều kim đồng hồ. kq âm là thuận chiều kim đồng hồ

Công thức tính diện tích bằng tọa độ viết bằng lisp hình như là vậy, bạn kiểm tra lại, mình kg nhớ rõ

(defun tinhdientich( lis / dt i)

(setq dt 0.0)

(setq i 0)

(setq lis (append lis (list (car lis))))

(repeat (- (length lis) 1)

(setq dt (+ dt (- (* (car (nth i lis)) (cadr (nth (1+ i) lis)))

(* (cadr (nth i lis)) (car (nth (1+ i) lis))))))

(setq i (1+ i))

)

(/ dt 2.0)

)

Với lis là danh sách tọa độ đỉnh đa tuyến

  • Vote tăng 2

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Vấn đề của bạn là làm sao xác định đuợc tâm của đa tuyến (vị trí gắn kim đồng hồ ấy mà).

Sau khi có tâm, lần luợt duyệt qua các đỉnh -> tính góc của đỉnh.

phụ thuộc vào số đo các góc tăng hay giảm -> các đỉnh được tạo theo thứ tự ngược chiều kim đồng hồ hay thuận chiều kim đồng hồ.

Cái này chỉ đúng với đa giác lồi. Còn đa giác lõm thì không còn đúng nữa.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Thuật toán của Giabach hay lắm, Thiep sẽ làm ngay.

Thiệp thử dùng cái này

(defun c:tabcord(/ aCen cAng cCen cPl cRad cReg

fDr it lCnt lLst mSp pCen pT1

pT2 ptLst R tHt tLst vlaPl vlaTab

vLst cTxt oldCol nPl clFlg actDoc

tPt1 tPt2 cAng tiPt oSnp *error*

mType mHt oZin cAcu dHead hStr

hHt w1 w2 w3 isPer isAre pMul aMul

lWrt aVal xVal yVal)

 

 

;;; ****************************************************************

;;; *************************** ADJUSTMENT *************************

;;; ****************************************************************

 

(setq mType nil) ; Markups mode. T - digits, NIL - letters

 

(setq tHt -1.0) ; Table text size. Positive - absolute,

; negative multiplayer to TEXTSIZE variable

 

(setq mHt -2.0) ; Markups text size. Positive - absolute,

; negative - multiplayer to TEXTSIZE variable

 

(setq cAcu 4) ; Precision of coordinates (from 0 to 8)

 

(setq dHead nil) ; If T delete table header, if NIL not delete

 

(setq hStr "Land # ") ; Standard header (if dHead not equal T)

 

(setq hHt -1.25) ; Header text size. Positive - absolute,

; negative - multiplayer to TEXTSIZE variable

 

(setq w1 -10.0) ; 'Point' column width. Positive - absolute,

; negative - multiplayer to TEXTSIZE variable

 

(setq w2 -20.0) ; 'X' and 'Y' colums width. Positive - absolute,

; negative - multiplayer to TEXTSIZE variable

 

(setq w3 -12.0) ; 'Radius' column width. Positive - absolute,

; negative - multiplayer to TEXTSIZE variable

 

(setq isPer T) ; if T adds perimeter row

 

(setq isAre T) ; if T adds area row

 

(setq isGCen T) ; if T adds center of gravity row

 

(setq pMul 0.001) ; perimeter multiplayer

 

(setq aMul 0.000001) ; area multiplayer

 

;;; ****************************************************************

;;; ************************* END ADJUSTMENT ***********************

;;; ****************************************************************

 

(if(minusp tHt)

(setq tHt(getvar "TEXTSIZE"))

); end if

 

(if(minusp mHt)

(setq mHt(*(abs mHt)(getvar "TEXTSIZE")))

); end if

 

(if(minusp hHt)

(setq hHt(*(abs hHt)(getvar "TEXTSIZE")))

); end if

 

(if(minusp w1)

(setq w1(*(abs w1)(getvar "TEXTSIZE")))

); end if

 

(if(minusp w2)

(setq w2(*(abs w2)(getvar "TEXTSIZE")))

); end if

 

(if(minusp w3)

(setq w3(*(abs w3)(getvar "TEXTSIZE")))

); end if

 

(vl-load-com)

 

(defun Get_Acad_Ver(Gen_Only)

(if Gen_Only

(substr(getvar "ACADVER") 1 2)

(substr(getvar "ACADVER") 1 4)

); end if

); and of Get_Acad_Ver

 

(defun Extract_DXF_Values(Ent Code)

(mapcar 'cdr

(vl-remove-if-not

'(lambda(a)(=(car a)Code))

(entget Ent)))

); end of

 

 

(defun *error*(msg)

(setvar "CMDECHO" 1)

(if oSnp(setvar "OSMODE" oSnp))

(if oZin(setvar "DIMZIN" oZin))

(if mSp(vla-EndUndoMark actDoc))

(princ)

); end of *error*

 

(defun Alph_Num(Counter / lLst cRes)

(setq lLst '("A" "B" "C" "D" "E" "F" "G" "H" "I" "J"

"K" "L" "M" "N" "O" "P" "Q" "R" "S" "T"

"U" "V" "W" "X" "Y" "Z"))

(if(<= 1.0(setq cRes(/ Counter 26.0)))

(strcat(itoa(fix cRes))

(nth(- Counter(* 26(fix cRes)))lLst))

(nth Counter lLst)

); end if

); end of Alph_Num

 

 

(if(<= 16.1(atof(Get_Acad_Ver nil)))

(progn

(if

(and

(setq cPl(entsel "\nSelect LwPoliline > "))

(= "LWPOLYLINE"(car(Extract_DXF_Values(car cPl)0)))

); end and

(progn

(princ "\nPlease Wait... \n")

(setq vlaPl(vlax-ename->vla-object(car cPl))

ptLst(mapcar 'append

(setq vLst(Extract_DXF_Values(car cPl)10))

(mapcar 'list(Extract_DXF_Values(car cPl)42)))

r 2 lCnt 0

tLst '((1 0 "Point")(1 1 "X")(1 2 "Y")(1 3 "Radius"))

actDoc(vla-get-ActiveDocument

(vlax-get-acad-object))

mSp(vla-get-ModelSpace actDoc)

); end setq

(setvar "CMDECHO" 0)

(setq oSnp(getvar "OSMODE"))

(setq oZin(getvar "DIMZIN"))

(setvar "DIMZIN" 0)

(vla-StartUndoMark actDoc)

(foreach vert ptLst

(setq vert(trans vert 0 1)

tLst(append tLst

(list(list r 0(if mType

(itoa(1+ lCnt))

(Alph_Num lCnt)))

(list r 1(rtos(car vert)2 cAcu))

(list r 2(rtos(cadr vert)2 cAcu))

(list r 3 ""))))

(if(and

(/= 0.0(last vert))

(setq pt1(vlax-curve-GetPointAtParam vlaPl lCnt))

(setq pt2(vlax-curve-GetPointAtParam vlaPl(1+ lCnt)))

); end and

(setq r(1+ r)

cRad(abs(/(distance pt1 pt2)

2(sin(/(* 4(atan(abs(last vert))))2))))

aCen(vlax-curve-GetPointAtParam vlaPl(+ 0.5 lCnt))

fDr(vlax-curve-getFirstDeriv vlaPl

(vlax-curve-getParamAtPoint vlaPl aCen))

pCen(trans

(polar aCen(-(if(minusp(last vert)) pi(* 2 pi))

(atan(/(car fDr)(cadr fDr))))cRad)0 1)

tLst(append tLst(list

(list r 0 "center")

(list r 1(rtos(car pCen)2 cAcu))

(list r 2(rtos(cadr pCen)2 cAcu))

(list r 3(rtos cRad 2 cAcu))))

); end setq

); end if

(setq r(1+ r) lCnt(1+ lCnt))

); end foreach

(setq vlaTab(vla-AddTable mSp (vlax-3D-point '(0 0 0))

(+ 1(/(length tLst)4)) 4 (* 3 tHt)w2))

(foreach i tLst

(vl-catch-all-apply 'vla-SetText(cons vlaTab i))

(vla-SetCellTextHeight vlaTab(car i)(cadr i)tHt)

(vla-SetCellAlignment vlaTab(car i)(cadr i)acMiddleCenter)

); end foreach

(if(or isPer isAre)

(progn

(vla-InsertRows vlaTab r(* 0.05 tHt)1)

(vla-SetCellTextHeight vlaTab r 0(* 0.05 tHt))

(setq r(1+ r))

); end progn

); end if

(if isPer

(progn

(if(= :vlax-true(vla-get-Closed vlaPl))

(setq lWrt "Perimeter")

(setq lWrt "Length")

); end if

(vla-InsertRows vlaTab r tHt 1)

(vla-SetText vlaTab r 0 lWrt)

(vla-SetText vlaTab r 1

(rtos(*(vla-get-Length vlaPl)pMul)2 cAcu))

(vla-SetCellTextHeight vlaTab r 0 tHt)

(vla-SetCellTextHeight vlaTab r 1 tHt)

(setq r(1+ r))

); end progn

); end if

(if isAre

(progn

(if(= :vlax-true(vla-get-Closed vlaPl))

(setq aVal (rtos(*(vla-get-Area vlaPl)aMul)2 cAcu))

(setq aVal "Not closed contour")

); end if

(vla-InsertRows vlaTab r tHt 1)

(vla-SetText vlaTab r 0 "Area")

(vla-SetText vlaTab r 1 aVal)

(vla-SetCellTextHeight vlaTab r 0 tHt)

(vla-SetCellTextHeight vlaTab r 1 tHt)

(setq r(1+ r))

); end progn

); end if

(if(= :vlax-true(vla-get-Closed vlaPl))

(progn

(setq nPl(vla-Copy vlaPl))

(command "_.region" (entlast) "")

(setq cCen(vlax-get(setq cReg

(vlax-ename->vla-object(entlast)))'Centroid))

(vla-Delete cReg)

(setq clFlg T)

); end progn

); end if

(if isAre

(progn

(if cCen

(setq xVal(rtos(car cCen)2 cAcu)

yVal (rtos(cadr cCen)2 cAcu))

(setq xVal "-"

yVal "-")

); end if

(vla-InsertRows vlaTab r tHt 1)

(vla-SetText vlaTab r 0 "Gravity Center")

(vla-SetText vlaTab r 1 xVal)

(vla-SetText vlaTab r 2 yVal)

(vla-SetCellTextHeight vlaTab r 0 tHt)

(vla-SetCellTextHeight vlaTab r 1 tHt)

(vla-SetCellTextHeight vlaTab r 2 tHt)

(setq r(1+ r))

); end progn

); end if

(vla-put-VertCellMargin vlaTab (* 0.75 tHt))

(vla-SetColumnWidth vlaTab 0 w1)

(vla-SetColumnWidth vlaTab 3 w3)

(if(vlax-property-available-p vlaTab 'RepeatTopLabels)

(vla-put-RepeatTopLabels vlaTab :vlax-true)

); end if

(if(vlax-property-available-p vlaTab 'BreakSpacing)

(vla-put-BreakSpacing vlaTab (* 3 tHt))

); end if

(if dHead

(vla-DeleteRows vlaTab 0 1)

(progn

(vla-SetText vlaTab 0 0 hStr)

(vla-SetCellTextHeight vlaTab 0 0 hHt)

); end progn

); end if

(vla-put-Height vlaTab(* 1.75(/(length tLst)4)))

(princ "\n<<< Place Table >>> ")

(command "_.copybase" (trans '(0 0 0)0 1)(entlast) "")

(command "_.erase" (entlast) "")

(command "_.pasteclip" pause)

(setq lCnt 0)

(foreach v vLst

(if clFlg

(setq cAng(angle cCen(trans v 0 1))

iPt(polar v cAng (* 2 mHt)))

(setq tPt1(vlax-curve-GetPointAtParam vlaPl

(- lCnt 0.0000001))

tPt2(vlax-curve-GetPointAtParam vlaPl

(+ lCnt 0.0000001))

iPt(polar v(+(* pi 0.5)(if(minusp

(setq cAng(angle tPt1(if tPt2 tPt2

(polar tPt1(* 0.5 pi)0.0000001)))))

cAng(- cAng)))(* 2 mHt))

); end setq

); end if

(setvar "OSMODE" 0)

(setq cTxt(vla-AddText mSp

(if mType(itoa(1+ lCnt))(Alph_Num lCnt))

(vlax-3d-point iPt) mHt)

tiPt(vla-get-InsertionPoint cTxt)

lCnt(1+ lCnt)

); end setq

(vla-put-Alignment cTxt 10)

(vla-put-TextAlignmentPoint cTxt tiPt)

(setq oldCol(getvar "CECOLOR"))

(setvar "CECOLOR" "1")

(command "_.circle"(trans v 0 1) (/ mHt 4))

(setvar "CECOLOR" oldCol)

); end foreach

(setvar "DIMZIN" oZin)

(setvar "OSMODE" oSnp)

(setvar "CMDECHO" 1)

(vla-EndUndoMark actDoc)

); end progn

(princ "\n It isn't LwPolyline! Quit. ")

); end if

); end progn

(princ "\n This program works in AutoCAD 2005+ only! " )

);end if

(gc)

(princ)

); end of c:tabcord

 

(princ "\n http:\\\\www.AsmiTools.com ")

(princ "\n Type TABCORD to fill table of LwPolyline coordinates ")

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Bạn hãy dùng công thức tính diện tích bằng tọa độ. Nếu kq quả là dương là ngược chiều kim đồng hồ. kq âm là thuận chiều kim đồng hồ

Công thức tính diện tích bằng tọa độ viết bằng lisp hình như là vậy, bạn kiểm tra lại, mình kg nhớ rõ

.......

TRUNGNGAMY, cảm ơn bạn.

Thuật toán này thật tuyệt và đơn giản, Thiệp đã áp dụng thành công:

;| Lisp xac dinh Lwpolyline duoc tao co cac dinh theo thu tu
  thuan chieu hay nguoc chieu kim dong ho
  Yeu cau: Express tools duoc cai dat day du|;
(defun tinhdientich (lis / dt i)
 (setq dt 0.0)
 (setq i 0)
 (setq lis (append lis (list (car lis))))
 (repeat (- (length lis) 1)
   (setq dt (+	dt
	(- (* (car (nth i lis)) (cadr (nth (1+ i) lis)))
	   (* (cadr (nth i lis)) (car (nth (1+ i) lis)))
	)
     )
   )
   (setq i (1+ i))
 )
 (/ dt 2.0)
)
(defun c:clockwise (/ en lstp dt)
 (setq	en   (ssname (ssget '((0 . "LWPOLYLINE"))) 0)
lstp (ACET-GEOM-VERTEX-LIST en)
 )
 (If (minusp (tinhdientich lstp))
   (princ
     "\LWP duoc tao co thu tu dinh NGUOC chieu kim dong ho"
   )
   (princ
     "\LWP duoc tao co thu tu dinh THUAN chieu kim dong ho"
   )
 )
 (princ)
)

Thiệp thử dùng cái này

(defun c:tabcord(/ aCen cAng cCen cPl cRad cReg

(princ "\n Type TABCORD to fill table of LwPolyline coordinates ")

tivanteo, Cảm ơn bạn.

Lisp của bạn cho thiep rất tuyệt, rất có ích cho các nhà Địa chính, trắc đạc. Nó tạo ra 1 TABLE tọa độ các góc ranh, và rất tuyệt khi đưa các tên điểm ranh ra ngoài ranh.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Khách
Chủ đề này bây giờ đã bị đóng lại để trả lời thêm.

×