Đến nội dung


Hình ảnh
- - - - -

[Nhờ chỉnh sửa] dùm em lisp


  • Please log in to reply
9 replies to this topic

#1 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 995 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 19 May 2011 - 11:08 AM

Em đang viết lisp kích vào một Polyline thì sẽ lưu ra được một tệp txt hoặc csv, trong tệp đó sẽ có kiểu dữ liệu dạng:

(Số hiệu đỉnh trái 1) (Số hiệu đỉnh giữa 2) (Số hiệu đỉnh phải 3) (Độ) (Phút) (Giây)
...........................................................................
(Số hiệu đỉnh trái (n-2)) (Số hiệu đỉnh giữa (n-1)) (Số hiệu đỉnh phải n) (Độ) (Phút) (Giây)

(Số hiệu đỉnh 1) (Số hiệu đỉnh 2) (Chiều dài cạnh 1_2)
...........................................................................
(Số hiệu đỉnh (n-1)) (Số hiệu đỉnh n) (Chiều dài cạnh (n-1)_n)
File mẫu:
http://www.cadviet.c...les/3/cad_1.dwg
http://www.cadviet.c...3/tepdulieu.rar
Em nói trên đây là nếu các bác quan tâm và giúp đỡ em thực hiện bài toán trên.
Vì trình độ có hạn và mới mò mẫm trên con đường Lisp nên em đã làm thủ công từng bước một.
Tạm thời em đang viết thực hiện tính góc hợp với trục X (hướng Đông làm chuẩn) theo chiều kim đồng hồ để tính góc tạo bởi 2 điểm kích trên màn hình nhưng nó vẫn bị lỗi tại chỗ nào đó.
Các bác quan tâm thì giúp em chỉnh sửa lisp này với. Em chân thành cảm ơn.
http://www.cadviet.c...kim_dong_ho.lsp

(defun c:dogoc (/ p1 p2 x1 x2 y1 y2 dx dy Goc DoPG)
(setvar "OSMODE" 1)
(setq p1 (getpoint "\n Chon diem thu nhat : ")
p2 (getpoint "\n Chon diem thu hai : ")
x1 (car p1)
y1 (cadr p1)
x2 (car p2)
y2 (cadr p2)
dx (- x2 x1)
dy (- y2 y1)
)
(setq Goc (Atan2 (dx dy)))
(setq DoPG (R2DPG Goc))
(princ (strcat (rtos (car DoPG) 2 0) " " (rtos (cadr DoPG) 2 0) (rtos (caddr DoPG) 2 2)))
)
;;;;;;;;;;=========================================
(defun Atan2 (dx dy / gocAtan B)
(setq gocAtan (list))
(cond
(((and (= dx 0) (> dy 0) ))
(setq gocAtan (/ pi 2))
)
(((and (= dx 0) (< dy 0) ))
(setq gocAtan (/ (* 3 pi) 2))
)
((/= dx 0)
(progn
(setq b (atan (/ dy dx)))
(cond
((and (> dx 0) (>= dy 0))
(setq gocAtan B)
)
((and (< dx 0) (> dy 0))
(setq gocAtan (+ pi B))
)
((and (< dx 0) (< dy 0))
(setq gocAtan (+ pi B))
)
((and (> dx 0) (< dy 0))
(setq gocAtan (+ (* pi 2) B))
)
)
)
)
)
gocAtan
)
;;;;;;;;;;;;;;;;;;;;===========================================
(defun Rad_to_Do(radian / Do)
(setq Do (/ (* radian 180) pi))
)
;;;;;;;;;;;;;;;;;;;;===========================================
(defun R2DPG (gocR / DPG Toando Do Phut1 Phut Giay DPG)
(setq DPG (list))
(setq Toando (Rad_to_Do gocR))
(setq Do (fix Toando))
(setq Phut1 (* (- Toando Do) 60))
(setq Phut (fix Phut1))
(setq Giay (* (- phut1 phut) 60))
(setq DPG (list Do Phut giay))
DPG
)

  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#2 nguyentuyen6

nguyentuyen6

    biết lệnh chamfer

  • Advance Member
  • PipPipPipPip
  • 213 Bài viết
Điểm đánh giá: 124 (tàm tạm)

Đã gửi 19 May 2011 - 11:50 AM

Tạm thời em đang viết thực hiện tính góc hợp với trục X (hướng Đông làm chuẩn) theo chiều kim đồng hồ để tính góc tạo bởi 2 điểm kích trên màn hình nhưng nó vẫn bị lỗi tại chỗ nào đó.

Mình xem qua thấy chỗ này:
(setq Goc (Atan2 (dx dy))) >>>>>(setq Goc (Atan2 dx dy)) (thừa ngoặc)
Đoạn này cũng thấy thừa ngoặc ở hàm AND
(cond
(((and (= dx 0) (> dy 0) ))
(setq gocAtan (/ pi 2))
)
(((and (= dx 0) (< dy 0) ))
(setq gocAtan (/ (* 3 pi) 2))
)
chuyển thành:
(cond
((and (= dx 0) (> dy 0) )
(setq gocAtan (/ pi 2))
)
((and (= dx 0) (< dy 0) )
(setq gocAtan (/ (* 3 pi) 2))
)
Bạn cũng nên sửa đoạn này 1 chút nhìn cho nó trực quan:
p2 (getpoint "\n Chon diem thu hai : ")
thành
p2 (getpoint p1 "\n Chon diem thu hai : ")
  • 1

Lisp In bản vẽ hàng loạt:
http://www.cadviet.c...ndpost&p=139860


#3 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 995 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 19 May 2011 - 12:00 PM

Mình xem qua thấy chỗ này:
(setq Goc (Atan2 (dx dy))) >>>>>(setq Goc (Atan2 dx dy)) (thừa ngoặc)
Đoạn này cũng thấy thừa ngoặc ở hàm AND

(cond
(((and (= dx 0) (> dy 0) ))
(setq gocAtan (/ pi 2))
)
(((and (= dx 0) (< dy 0) ))
(setq gocAtan (/ (* 3 pi) 2))
)
chuyển thành:
(cond
((and (= dx 0) (> dy 0) )
(setq gocAtan (/ pi 2))
)
((and (= dx 0) (< dy 0) )
(setq gocAtan (/ (* 3 pi) 2))
)

Vâng.Cảm ơn bác đã quan tâm. Em mần nó tiếp đây. Có gì mong bác xem dùm tiếp hộ em.
P/s: Em đã sửa lại và chạy ngon. Cảm ơn bác nguyentuyen6 nhiều.
Em đang mần cái bài toán trên, mong bác có thể gợi ý hoặc làm giúp em với. Em chưa biết các phương phức của lisp là mấy nên làm theo kiểu thủ công thế bác ạ. Cảm ơn bác nhiều.
  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#4 nguyentuyen6

nguyentuyen6

    biết lệnh chamfer

  • Advance Member
  • PipPipPipPip
  • 213 Bài viết
Điểm đánh giá: 124 (tàm tạm)

Đã gửi 19 May 2011 - 12:14 PM

Vâng.Cảm ơn bác đã quan tâm. Em mần nó tiếp đây. Có gì mong bác xem dùm tiếp hộ em.
P/s: Em đã sửa lại và chạy ngon. Cảm ơn bác nguyentuyen6 nhiều.
Em đang mần cái bài toán trên, mong bác có thể gợi ý hoặc làm giúp em với. Em chưa biết các phương phức của lisp là mấy nên làm theo kiểu thủ công thế bác ạ. Cảm ơn bác nhiều.

Viết kiểu này đỡ phúc tạp hơn bạn nhỉ:
(defun c:goc ()
(setq p1 (getpoint "\n Chon diem thu nhat : ")
goc (getangle p1 "\n Chon diem thu hai : ")
)
(Rad_to_Do goc )
)
(defun Rad_to_Do(radian / Do)
(setq Do (/ (* radian 180) pi))
)

  • 1

Lisp In bản vẽ hàng loạt:
http://www.cadviet.c...ndpost&p=139860


#5 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 995 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 19 May 2011 - 12:20 PM

Viết kiểu này đỡ phúc tạp hơn bạn nhỉ:

(defun c:goc ()
(setq p1 (getpoint "\n Chon diem thu nhat : ")
goc (getangle p1 "\n Chon diem thu hai : ")
)
(Rad_to_Do goc )
)
(defun Rad_to_Do(radian / Do)
(setq Do (/ (* radian 180) pi))
)

Không phải ngẫu nhiên em viết dài thế đâu bác. hàm Atan của lisp chưa đầy đủ và nó chỉ trả về từ + pi/2 đến - pi/2. Em viết hàm Atan2 để khắc phục điều đó và làm theo ý muốn. Cảm ơn bác đã góp ý.
P/s: Cách của bác rất ngắn và ngon. Hề hề hề. Thanks bác nhiều.
  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#6 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1436 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 19 May 2011 - 01:48 PM

..........
Tạm thời em đang viết thực hiện tính góc hợp với trục X (hướng Đông làm chuẩn) theo chiều kim đồng hồ để tính góc tạo bởi 2 điểm ..............

thanhduan2407 tham khảo đoạn Lisp Tính chiều dài các phân đoạn và góc của chúng
(defun c:APL (/ ang ent chcao obj dc dd dg param spc)
(vl-load-com)
(defun LM:GetLeftAngle ( p1 p2 p3 )
(rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi)))
;main
(if (and (setq Ent (car (entsel "\nSelect Polyline: ")))
(wcmatch (cdr (assoc 0 (entget Ent))) "*POLYLINE" ) )
(progn
(if (not (setq chcao (getreal (strcat "\nNhap chieu cao Text <" (rtos (getvar "TEXTSIZE") 2 1) "> :")) ))
(setq chcao (getvar "TEXTSIZE") ) )
(setq param 1
obj(vlax-ename->vla-object Ent)
dd (vlax-curve-getStartPoint obj)
dg (vlax-curve-getPointAtParam obj 0.5)
spc (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-Acad-Object))))
(while (< param (vlax-curve-getEndParam obj))
(setq dg (vlax-curve-getPointAtParam obj param)
dc (vlax-curve-getPointAtParam obj (1+ param))
ang (LM:GetLeftAngle dd dg dc) )
(vla-AddText spc (rtos(distance dg dd)) (vlax-3D-point(vlax-curve-getPointAtParam obj (- param 0.5))) chcao)
(vla-AddText spc (angtos ang 1) (vlax-3D-point dg) chcao)
(setq dd dg param (1+ param )) )
(vla-AddText spc
(rtos(distance (vlax-curve-getPointAtParam obj param) dd))
(vlax-3D-point(vlax-curve-getPointAtParam obj (- param 0.5))) chcao) )
(princ "\n<< No Polyline Selected >>"))
(princ))

  • 0

#7 pdle

pdle

    biết lệnh mtext

  • Members
  • PipPipPipPip
  • 286 Bài viết
Điểm đánh giá: 124 (tàm tạm)

Đã gửi 19 May 2011 - 01:52 PM

Không phải ngẫu nhiên em viết dài thế đâu bác. hàm Atan của lisp chưa đầy đủ và nó chỉ trả về từ + pi/2 đến - pi/2. Em viết hàm Atan2 để khắc phục điều đó và làm theo ý muốn. Cảm ơn bác đã góp ý.
P/s: Cách của bác rất ngắn và ngon. Hề hề hề. Thanks bác nhiều.

Sao anh không dùng hàm acet-geom-vertex-list lấy hết các đỉnh của polyline, sau đó xử lý với vòng lặp?
  • 0
Share your knowledge. It is a way to achieve immortality !

***

PS: Nếu bài viết của mình có ích, xin hãy "Bình chọn cho bài viết này" nhé :D

#8 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 995 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 19 May 2011 - 02:43 PM

thanhduan2407 tham khảo đoạn Lisp Tính chiều dài các phân đoạn và góc của chúng

(defun c:APL (/ ang ent chcao obj dc dd dg param spc)
(vl-load-com)
(defun LM:GetLeftAngle ( p1 p2 p3 )
(rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi)))
;main
(if (and (setq Ent (car (entsel "\nSelect Polyline: ")))
(wcmatch (cdr (assoc 0 (entget Ent))) "*POLYLINE" ) )
(progn
(if (not (setq chcao (getreal (strcat "\nNhap chieu cao Text <" (rtos (getvar "TEXTSIZE") 2 1) "> :")) ))
(setq chcao (getvar "TEXTSIZE") ) )
(setq param 1
obj(vlax-ename->vla-object Ent)
dd (vlax-curve-getStartPoint obj)
dg (vlax-curve-getPointAtParam obj 0.5)
spc (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-Acad-Object))))
(while (< param (vlax-curve-getEndParam obj))
(setq dg (vlax-curve-getPointAtParam obj param)
dc (vlax-curve-getPointAtParam obj (1+ param))
ang (LM:GetLeftAngle dd dg dc) )
(vla-AddText spc (rtos(distance dg dd)) (vlax-3D-point(vlax-curve-getPointAtParam obj (- param 0.5))) chcao)
(vla-AddText spc (angtos ang 1) (vlax-3D-point dg) chcao)
(setq dd dg param (1+ param )) )
(vla-AddText spc
(rtos(distance (vlax-curve-getPointAtParam obj param) dd))
(vlax-3D-point(vlax-curve-getPointAtParam obj (- param 0.5))) chcao) )
(princ "\n<< No Polyline Selected >>"))
(princ))

Cảm ơn bác Gia_Bach và bác pdle. Vậy là em lại được ngâm mấy thằng vla-, vlx- của các bác rồi. Hii.Trong lúc chờ đợi em cũng viết gần xong cái lisp ấy rồi. Bây giờ chỉ cần nối lại là xong. Hii. Có gì mong các bác chỉ giáo cho em.

(defun c:gcdPL ()
(vl-load-com)
(command "undo" "be")
(setq en (entsel "\n Chon pline "))
(if en
(progn
(setq fn (getfiled "Point Export File" "" "csv" 1))
(if (/= fn nil)
(progn
(setq fh (open fn "w")
ob (vlax-ename->vla-object (car en))
n (vlax-curve-getEndParam ob)
i 1
)
(while (<= i n)
(progn
(setq p (vlax-curve-getPointAtParam ob i)
p0 (vlax-curve-getPointAtParam ob (+ i 1))
x0 (car p)
y0 (cadr p)
pt0 (list x0 y0)
x1 (car p0)
y1 (cadr p0)
pt1 (list x1 y1)
kc (distance pt0 pt1)
)
(write-line (strcat (rtos i 2 0) "," (rtos (+ i 1) 2 0) "," (rtos kc 2 3)) fh)
)
(setq i (+ i 1))
)
(close fh)
)
)
)
)
(princ)
)
(defun Atan2 (dx dy / gocAtan B)
(setq gocAtan (list))
(cond
((and (= dx 0) (> dy 0) )
(setq gocAtan (/ pi 2))
)
((and (= dx 0) (< dy 0) )
(setq gocAtan (/ (* 3 pi) 2))
)
((and (< dx 0) (= dy 0) )
(setq gocAtan pi)
)
((and (> dx 0) (= dy 0) )
(setq gocAtan 0)
)
((and (= dx 0) (= dy 0) )
(setq gocAtan 0)
)
((/= dx 0)
(progn
(setq b (atan (/ dy dx)))
(cond
((and (> dx 0) (>= dy 0))
(setq gocAtan B)
)
((and (< dx 0) (> dy 0))
(setq gocAtan (+ pi B))
)
((and (< dx 0) (< dy 0))
(setq gocAtan (+ pi B))
)
((and (> dx 0) (< dy 0))
(setq gocAtan (+ (* pi 2) B))
)
)
)
)
)
gocAtan
)
;;;;;;;;;;;;;;;;;;;;===========================================
(defun Rad_to_Do(radian / Do)
(setq Do (/ (* radian 180) pi))
)
;;;;;;;;;;;;;;;;;;;;===========================================
(defun R2DPG (gocR / DPG Toando Do Phut1 Phut Giay DPG)
(setq DPG (list))
(setq Toando (Rad_to_Do gocR))
(setq Do (fix Toando))
(setq Phut1 (* (- Toando Do) 60))
(setq Phut (fix Phut1))
(setq Giay (* (- phut1 phut) 60))
(setq DPG (list Do Phut giay))
DPG
)

(defun c:taotep ()
(vl-load-com)
(command "undo" "be")
(setq en (entsel "\n Chon pline "))
(if en
(progn
(setq fn (getfiled "Point Export File" "" "csv" 1))
(if (/= fn nil)
(progn
(setq fh (open fn "w")
ob (vlax-ename->vla-object (car en))
n (vlax-curve-getEndParam ob)
i 1
)
(while (< i n)
(progn
(setq p1 (vlax-curve-getPointAtParam ob i)
p2 (vlax-curve-getPointAtParam ob (- i 1))
p3 (vlax-curve-getPointAtParam ob (+ i 1))
x1 (car p1)
y1 (cadr p1)
x2 (car p2)
y2 (cadr p2)
x3 (car p3)
y3 (cadr p3)
dx12 (- x2 x1)
dy12 (- y2 y1)
dx13 (- x3 x1)
dy13 (- y3 y1)
goc12 (Atan2 dx12 dy12)
goc13 (Atan2 dx13 dy13)
DPGiay1 (R2DPG goc12)
DPGiay2 (R2DPG goc13)
)
(if (> (car DPGiay1) (car DPGiay2))
(setq goc213 (- goc12 goc13))
(setq goc213 (+ (* 2 pi) (- goc12 goc13) ))
)
(setq DPGiay (R2DPG goc213))
(write-line (strcat ( rtos (- i 1) 2 0) "," ( rtos i 2 0) "," ( rtos (+ i 1) 2 0) "," ( rtos (car DPGiay) 2 0) "," ( rtos (cadr DPGiay) 2 0) "," ( rtos (caddr DPGiay) 2 2)) fh)
)
(setq i (+ i 1))
)
(close fh)
)
)
)
)
(princ)
)




  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#9 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5682 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 19 May 2011 - 07:08 PM

Chúc mừng bác. Tuy có hơi dài nhưng cứ như thế thì chẳng có gì k giải quyết được cả ^^
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#10 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 995 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 19 May 2011 - 09:03 PM

Chúc mừng bác. Tuy có hơi dài nhưng cứ như thế thì chẳng có gì k giải quyết được cả ^^

Anh đã hoàn thành và đạt chỉ tiêu lúc đầu đưa ra. hề hề hề.
Đưa lên anh em cùng tham khảo nè. Hề hề hề.

(defun Atan2 (dx dy / gocAtan B)
(setq gocAtan (list))
(cond
((and (= dx 0) (> dy 0) )
(setq gocAtan (/ pi 2))
)
((and (= dx 0) (< dy 0) )
(setq gocAtan (/ (* 3 pi) 2))
)
((and (< dx 0) (= dy 0) )
(setq gocAtan pi)
)
((and (> dx 0) (= dy 0) )
(setq gocAtan 0)
)
((and (= dx 0) (= dy 0) )
(setq gocAtan 0)
)
((/= dx 0)
(progn
(setq b (atan (/ dy dx)))
(cond
((and (> dx 0) (>= dy 0))
(setq gocAtan B)
)
((and (< dx 0) (> dy 0))
(setq gocAtan (+ pi B))
)
((and (< dx 0) (< dy 0))
(setq gocAtan (+ pi B))
)
((and (> dx 0) (< dy 0))
(setq gocAtan (+ (* pi 2) B))
)
)
)
)
)
gocAtan
)
;;;;;;;;;;;;;;;;;;;;===========================================
(defun Rad_to_Do(radian / Do)
(setq Do (/ (* radian 180) pi))
)
;;;;;;;;;;;;;;;;;;;;===========================================
(defun R2DPG (gocR / DPG Toando Do Phut1 Phut Giay DPG)
(setq DPG (list))
(setq Toando (Rad_to_Do gocR))
(setq Do (fix Toando))
(setq Phut1 (* (- Toando Do) 60))
(setq Phut (fix Phut1))
(setq Giay (* (- phut1 phut) 60))
(setq DPG (list Do Phut giay))
DPG
)

(defun c:tt ()
(vl-load-com)
(command "undo" "be")
(setq tenct (getstring "\nNhap ten luoi: "))
(setq en (entsel "\n Chon pline "))
(if en
(progn
(setq fn (getfiled "Point Export File" "" "csv" 1))
(if (/= fn nil)
(progn
(setq fh (open fn "w")
ob (vlax-ename->vla-object (car en))
n (vlax-curve-getEndParam ob)
i 1
j 0
k 1
dd (vlax-curve-getPointAtParam ob 0)
dc (vlax-curve-getPointAtParam ob n)
xd (car dd)
yd (cadr dd)
zd (caddr dd)
xc (car dc)
yc (cadr dc)
zc (caddr dc)
)
(write-line (strcat tenct) fh)
(write-line (strcat ( rtos (- n 1) 2 0) "," ( rtos n 2 0) "," ( rtos 0 2 0) "," ( rtos (- n 1) 2 0) "," ( rtos 2 2 0)) fh)
(write-line (strcat ( rtos 5 2 0) "," ( rtos 0.3) "," ( rtos 0.2) "," ( rtos 0.1)) fh)
(write-line (strcat ( rtos n 2 0) "," ( rtos xd 2 3) "," ( rtos yd 2 3) "," ( rtos zd 2 3)) fh)
(write-line (strcat ( rtos (+ n 1) 2 0) "," ( rtos xc 2 3) "," ( rtos yc 2 3) "," ( rtos zc 2 3)) fh)
(while (<= k (+ n 1))
(write-line (strcat (rtos k 2 0) ) fh)
(setq k (+ k 1))
)
(while (< i n)
(progn
(setq p1 (vlax-curve-getPointAtParam ob i)
p2 (vlax-curve-getPointAtParam ob (- i 1))
p3 (vlax-curve-getPointAtParam ob (+ i 1))
x1 (car p1)
y1 (cadr p1)
x2 (car p2)
y2 (cadr p2)
x3 (car p3)
y3 (cadr p3)
dx12 (- x2 x1)
dy12 (- y2 y1)
dx13 (- x3 x1)
dy13 (- y3 y1)
goc12 (Atan2 dx12 dy12)
goc13 (Atan2 dx13 dy13)
DPGiay1 (R2DPG goc12)
DPGiay2 (R2DPG goc13)
)
(if (> (car DPGiay1) (car DPGiay2))
(setq goc213 (- goc12 goc13))
(setq goc213 (+ (* 2 pi) (- goc12 goc13) ))
)
(setq DPGiay (R2DPG goc213))
(if (= (- i 1) 0)
(write-line (strcat ( rtos 1 2 0) "," ( rtos n 2 0) "," ( rtos 1 2 0) "," ( rtos 2 2 0) "," ( rtos (car DPGiay) 2 0) "," ( rtos (cadr DPGiay) 2 0) "," ( rtos (caddr DPGiay) 2 2)) fh)
)
(if (and (> (- i 1) 0) (< i (- n 1)))
(write-line (strcat ( rtos i 2 0) "," ( rtos (- i 1) 2 0) "," ( rtos i 2 0) "," ( rtos ( + i 1) 2 0) "," ( rtos (car DPGiay) 2 0) "," ( rtos (cadr DPGiay) 2 0) "," ( rtos (caddr DPGiay) 2 2)) fh)
)
(if (= (+ i 1) n)
(write-line (strcat ( rtos (- n 1) 2 0) "," ( rtos (- n 2) 2 0) "," ( rtos (- n 1) 2 0) "," ( rtos ( + n 1) 2 0) "," ( rtos (car DPGiay) 2 0) "," ( rtos (cadr DPGiay) 2 0) "," ( rtos (caddr DPGiay) 2 2)) fh)
)
)
(setq i (+ i 1))
)

(while (< j n)
(progn
(setq p (vlax-curve-getPointAtParam ob j)
p0 (vlax-curve-getPointAtParam ob (+ j 1))
x0 (car p)
y0 (cadr p)
pt0 (list x0 y0)
x1 (car p0)
y1 (cadr p0)
pt1 (list x1 y1)
kc (distance pt0 pt1)
)
(if (= j 0)
(write-line (strcat ( rtos 1 2 0) "," ( rtos n 2 0) "," ( rtos 1 2 0) "," (rtos kc 2 3)) fh)
)
(if (and (> j 0) (< j (- n 1)))
(write-line (strcat ( rtos (+ j 1) 2 0) "," ( rtos j 2 0) "," ( rtos (+ j 1) 2 0) "," (rtos kc 2 3)) fh)
)
(if (= j (- n 1))
(write-line (strcat ( rtos n 2 0) "," ( rtos (- n 1) 2 0) "," ( rtos (+ n 1) 2 0) "," (rtos kc 2 3)) fh)
)
)
(setq j (+ j 1))
)
(close fh)
)
)
)
)
(princ)
)




  • 1



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn