Đến nội dung


Hình ảnh
- - - - -

tìm point của spl


  • Please log in to reply
15 replies to this topic

#1 daknong

daknong

    biết vẽ ellipse

  • Members
  • PipPip
  • 54 Bài viết
Điểm đánh giá: 25 (tàm tạm)

Đã gửi 10 October 2009 - 07:07 AM

em có 1 spl AC dài 50m chẳng hạn bây giờ em muốn tìm điểm B trên spl thì làm như thế nào ạ ví dụ AB dài 15m ,bác nào có lisp thì cho em .Em cảm ơn ạ
Hình đã gửi
  • 0

#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 10 October 2009 - 08:35 AM

em có 1 spl AC dài 50m chẳng hạn bây giờ em muốn tìm điểm B trên spl thì làm như thế nào ạ ví dụ AB dài 15m ,bác nào có lisp thì cho em .Em cảm ơn ạ
Hình đã gửi

Nếu là đoạn cong AB=50m thì bạn thử dùng lệnh MEASURE xem sao?
Còn nếu là đoạn thẳng AB=50m bạn hãy dùng lệnh CIRCLE, tâm là A, bán kính 50.
  • 0

#3 tivanteo

tivanteo

    biết vẽ circle

  • Members
  • PipPip
  • 36 Bài viết
Điểm đánh giá: 17 (tàm tạm)

Đã gửi 11 October 2009 - 03:35 PM

bạn thử lisp này xem
;; free lisp from cadviet.com
(defun c:test(/ vl ov Ent isClosed dis dis0 pt dis_pt dis_max pt1 pt2)
 (vl-load-com)
(if (and (setq Ent (car (entsel "\nChon doi tuong :")))
(wcmatch (cdr (assoc 0 (entget ent))) "*LINE,ARC")
(not (setq isClosed (vlax-curve-isClosed ent)))
)
(progn
(command "undo" "be")
(setq vl '("osmode" "orthomode" "cmdecho") ; Sys Var list
ov (mapcar 'getvar vl)) ; Get Old values
(setvar "osmode" 0)
(setvar "orthomode" 0) (setvar "cmdecho" 0)
(setq pt (getpoint (vlax-curve-getStartPoint Ent) "\nChon diem goc :") )
(if (vlax-curve-getDistAtPoint ent pt)
(progn
(setq dis_pt (vlax-curve-getDistAtPoint Ent pt)
dis0 (vlax-curve-getDistAtParam Ent (vlax-curve-getEndParam Ent))
dis_max (max (- dis0 dis_pt) dis_pt)
dis (getreal (strcat "\nNhap chieu dai <" (rtos dis_max) "> :") )
)
(if (<= dis dis_max)
(progn
(if (setq pt1 (vlax-curve-getPointAtDist Ent (- dis_pt dis)))
(progn
(princ (strcat "\n Point X = " (rtos(car pt1)) "; Y = " (rtos(cadr pt1))))
(entmake (list '(0 . "POINT")(cons 10 pt1)) ) ))
(if (setq pt2 (vlax-curve-getPointAtDist Ent (+ dis_pt dis)))
(progn
(princ (strcat "\n Point X = " (rtos(car pt2)) "; Y = " (rtos(cadr pt2))))
(entmake (list '(0 . "POINT")(cons 10 pt2)) )) )
)
(alert "Khong ton tai diem voi thong so da nhap !")
)
)
)
(mapcar 'setvar vl ov) ; reset Sys Vars
(command "undo" "e")
)
(if isClosed
(alert "List khong chay duoc tren doi tuong kin ")
(alert "Khong chon duoc doi tuong !")))
(princ))
  • 0

#4 daknong

daknong

    biết vẽ ellipse

  • Members
  • PipPip
  • 54 Bài viết
Điểm đánh giá: 25 (tàm tạm)

Đã gửi 16 October 2009 - 07:12 AM

bạn thử lisp này xem
;; free lisp from cadviet.com
(defun c:test(/ vl ov Ent isClosed dis dis0 pt dis_pt dis_max pt1 pt2)
 (vl-load-com)
(if (and (setq Ent (car (entsel "\nChon doi tuong :")))
(wcmatch (cdr (assoc 0 (entget ent))) "*LINE,ARC")
(not (setq isClosed (vlax-curve-isClosed ent)))
)
(progn
(command "undo" "be")
(setq vl '("osmode" "orthomode" "cmdecho") ; Sys Var list
ov (mapcar 'getvar vl)) ; Get Old values
(setvar "osmode" 0)
(setvar "orthomode" 0) (setvar "cmdecho" 0)
(setq pt (getpoint (vlax-curve-getStartPoint Ent) "\nChon diem goc :") )
(if (vlax-curve-getDistAtPoint ent pt)
(progn
(setq dis_pt (vlax-curve-getDistAtPoint Ent pt)
dis0 (vlax-curve-getDistAtParam Ent (vlax-curve-getEndParam Ent))
dis_max (max (- dis0 dis_pt) dis_pt)
dis (getreal (strcat "\nNhap chieu dai <" (rtos dis_max) "> :") )
)
(if (<= dis dis_max)
(progn
(if (setq pt1 (vlax-curve-getPointAtDist Ent (- dis_pt dis)))
(progn
(princ (strcat "\n Point X = " (rtos(car pt1)) "; Y = " (rtos(cadr pt1))))
(entmake (list '(0 . "POINT")(cons 10 pt1)) ) ))
(if (setq pt2 (vlax-curve-getPointAtDist Ent (+ dis_pt dis)))
(progn
(princ (strcat "\n Point X = " (rtos(car pt2)) "; Y = " (rtos(cadr pt2))))
(entmake (list '(0 . "POINT")(cons 10 pt2)) )) )
)
(alert "Khong ton tai diem voi thong so da nhap !")
)
)
)
(mapcar 'setvar vl ov) ; reset Sys Vars
(command "undo" "e")
)
(if isClosed
(alert "List khong chay duoc tren doi tuong kin ")
(alert "Khong chon duoc doi tuong !")))
(princ))



lisp bạn dùng không đượcc rồi
  • 0

#5 daknong

daknong

    biết vẽ ellipse

  • Members
  • PipPip
  • 54 Bài viết
Điểm đánh giá: 25 (tàm tạm)

Đã gửi 16 October 2009 - 07:16 AM

Nếu là đoạn cong AB=50m thì bạn thử dùng lệnh MEASURE xem sao?
Còn nếu là đoạn thẳng AB=50m bạn hãy dùng lệnh CIRCLE, tâm là A, bán kính 50.

không ý mình là mình từ A fình tìm được điểm B cách đó 15 m,sau đó từ điểm B mình tìm dưọc điểm C cách đó 35m .Làm sao có thể tìm được điểm trên Spl mà khoảng cách mỗi điểm là không = nhau cơ mà .Chứ bằng nhau thì tìm = mesure thì mình biết rồi .dù sao cũng cảm ơn bạn
  • 0

#6 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 16 October 2009 - 09:28 AM

không ý mình là mình từ A fình tìm được điểm B cách đó 15 m,sau đó từ điểm B mình tìm dưọc điểm C cách đó 35m .Làm sao có thể tìm được điểm trên Spl mà khoảng cách mỗi điểm là không = nhau cơ mà .Chứ bằng nhau thì tìm = mesure thì mình biết rồi .dù sao cũng cảm ơn bạn

Gởi bạn đoạn lisp này:
(defun c:dpo (/ po dis en len)
(setq olos (getvar "osmode"))
(setvar "osmode" 8)
(setvar "pdmode" 34)
(setvar "pdsize" 1)
(prompt "\nSelect a cuver: ")
(setq en (ssname (ssget '((0 . "*LINE"))) 0))
(command ".LENGTHEN" en "")
(setq len (getvar "perimeter"))
(setq dis (getreal "\nEnter distance: "))
(if (<= dis len)
(progn
(setq po (vlax-curve-getpointAtdist en dis))
(entmake (list (cons 0 "POINT") (cons 10 po)))
(princ po)
)
(princ (strcat "\nKhoang cach dua vao > chieu dai cua curve vua chon (= "
(rtos len 2 2)
")"
)
)
)
(setvar "osmode" olos)
(princ)
)

  • 0

#7 duy782006

duy782006

    PHẠM QUỐC DUY

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

Đã gửi 16 October 2009 - 10:30 AM

Mình cũng đang lấn cấn cái vụ này nên xin đưa ra yêu cầu mang tích tổng quát nhất mọi người có thể giúp mình viết lisp với.
-Chọn đối tượng (spline, line, lpine, arc....).
-Chọn 1 điễm cơ sở (thuộc đối tượng do mình pick).
-Hỏi khoảng cách muốn xác định.
-Hỏi hướng cần xác định.
-Vẽ 1 point tại điểm đó.
Cám ơn!
  • 0

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#8 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 16 October 2009 - 01:47 PM

Mình cũng đang lấn cấn cái vụ này nên xin đưa ra yêu cầu mang tích tổng quát nhất mọi người có thể giúp mình viết lisp với.
-Chọn đối tượng (spline, line, lpine, arc....).
-Chọn 1 điễm cơ sở (thuộc đối tượng do mình pick).
-Hỏi khoảng cách muốn xác định.
-Hỏi hướng cần xác định.
-Vẽ 1 point tại điểm đó.
Cám ơn!

Chào bác duy782006, Lisp dpo.lsp Thiep viết gần đáp ứng yêu cầu của bác. Thiep đề nghị một số ý như sau:
- Chọn 1 điểm cơ sở (thuộc đối tượng do mình pick) cũng chính là điểm pick khi chọn đối tượng, và cũng dùng điểm này để xác định vị trí đầu curve (từ endpoint hay từ startpoint) từ đó để đo khoảng cách để cần xác định điểm point (giống như trong lệnh ME). Đây là lisp Thiep đã chỉnh sửa:
(defun c:dpo (/ po dis en len dis dis1 pick)
(setq olos (getvar "osmode"))
(setvar "osmode" 8)
(setvar "pdmode" 34)
(setvar "pdsize" 1)
(setq pick (entsel "\nPick a curve: "))
(while (null pick)
(princ "\nIncorect curve, Pick a curve again:")
(setq pick (entsel "\nPick a curve:: "))
)
(setq en (car pick)
dis1 (vlax-curve-getDistAtPoint
en
(vlax-curve-getClosestPointTo en (cadr pick))
)
)
(command ".LENGTHEN" en "")
(setq len (getvar "perimeter"))
(setq dis (getreal "\nEnter distance: "))
(if (<= dis len)
(progn
(if (> dis1 (/ len 2))
(setq dis (- len dis))
)
(setq po (vlax-curve-getpointAtdist en dis))
(entmake (list (cons 0 "POINT") (cons 10 po)))
(princ po)
)
(princ (strcat "\nKhoang cach dua vao > chieu dai cua curve vua chon (= "
(rtos len 2 2)
")"
)
)
)
(setvar "osmode" olos)
(princ)
)

  • 0

#9 ssg

ssg

    biết lệnh adcenter

  • Vip
  • PipPipPipPipPipPipPip
  • 1228 Bài viết
Điểm đánh giá: 1087 (rất tốt)

Đã gửi 16 October 2009 - 02:19 PM

Mình cũng đang lấn cấn cái vụ này nên xin đưa ra yêu cầu mang tích tổng quát nhất mọi người có thể giúp mình viết lisp với.
-Chọn đối tượng (spline, line, lpine, arc....).
-Chọn 1 điễm cơ sở (thuộc đối tượng do mình pick).
-Hỏi khoảng cách muốn xác định.
-Hỏi hướng cần xác định.
-Vẽ 1 point tại điểm đó.
Cám ơn!

Hình như bạn Thiep chưa hiểu đúng ý Duy? Duy tham khảo code sau và hoàn thiện thêm (kiểm tra giá trị user nhập vượt quá phạm vi curve...):

(defun C:POC( / c p1 oldos ph k d1 dh p2) ;;;Point On Curve
(vl-load-com)
(setq
c (car (entsel "\nChon curve:"))
p1 (getpoint "\nDiem chuan tren curve:")
oldos (getvar "osmode")
)
(entmake (list (cons 0 "POINT") (cons 10 p1)))
(setvar "osmode" 512)
(setvar "pdmode" 34)
(setq
ph (getpoint p1 "\nDiem dinh huong tren curve:")
k (getreal "\nKhoang cach:")
d1 (vlax-curve-getDistAtPoint c p1)
dh (vlax-curve-getDistAtPoint c ph)
)
(if (> dh d1) (setq d2 (+ d1 k)) (setq d2 (- d1 k)))
(setq p2 (vlax-curve-getPointAtDist c d2))
(entmake (list (cons 0 "POINT") (cons 10 p2)))
(setvar "osmode" oldos)
(princ)
)

  • 2

#10 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 16 October 2009 - 02:33 PM

Xin góp thêm 1 đoạn LISP
(defun c:DC(/ ent khcach len len0 ov pt pt1 vl); DC -> Divide Curve
(defun *error* (msg)
(if ov (mapcar 'setvar vl ov))
(if Ent (redraw Ent 4))
(if (not(wcmatch (strcase msg) "*BREAK,*EXIT*,*CANCEL*"))
(princ (strcat "\n** Error: " msg " **")))
(princ))

(if (and (setq Ent (car (entsel "\nChon Curve :")))
(wcmatch (cdr (assoc 0 (entget ent))) "*LINE,ARC,CIRCLE,ELLIPSE")
)
(progn
(command "undo" "be")
(setq vl '("osmode" "orthomode" "cmdecho" "pdmode") ; Sys Var list
ov (mapcar 'getvar vl)) ; Get Old values
(mapcar 'setvar vl '(63 0 0 34))
(or *khcach* (setq *khcach* 250))
(redraw ent 3)
(setq len (vlax-curve-getDistAtParam Ent (vlax-curve-getEndParam Ent))
pt (getpoint (vlax-curve-getPointAtDist Ent (/ len 2))"\nDiem goc :"))
(while (not (setq len0 (vlax-curve-getDistAtPoint Ent pt)))
(princ "\nDiem khong thuoc Curve. Chon lai :" )
(setq pt (getpoint (vlax-curve-getPointAtDist Ent (/ len 2))"\nDiem goc :") )
)
(entmake (list (cons 0 "POINT") (cons 10 pt)))
(setq khcach (getreal (strcat"\nNhap khoang cach Max= " (rtos (max len0(- len len0))) " <" (rtos *khcach*) ">:")) )
(while (>= khcach (max len0(- len len0)))
(princ (strcat"\nKhoang cach phai <= " (rtos (max len0(- len len0))) " . Nhap lai :" ))
(setq khcach (getreal (strcat"\nNhap khoang cach Max= " (rtos (max len0(- len len0))) " <" (rtos *khcach*) ">:")) )
)
(if khcach (setq *khcach* khcach) (setq khcach *khcach*))
(if (setq pt1 (vlax-curve-getPointAtDist Ent (+ len0 khcach)) )
(progn
(entmake (list (cons 0 "POINT") (cons 10 pt1)))
(princ "\nVi tri : ") (princ pt1)
) )
(if (setq pt1 (vlax-curve-getPointAtDist Ent (- len0 khcach)) )
(progn
(entmake (list (cons 0 "POINT") (cons 10 pt1)))
(princ "\nVi tri : ") (princ pt1)
) )
(redraw ent 4)
(mapcar 'setvar vl ov) ; reset Sys Vars
(command "undo" "e")
)
)
(princ))


  • 0

#11 ssg

ssg

    biết lệnh adcenter

  • Vip
  • PipPipPipPipPipPipPip
  • 1228 Bài viết
Điểm đánh giá: 1087 (rất tốt)

Đã gửi 16 October 2009 - 02:37 PM

Diễn giải thêm
Không hiểu sao up hình lên diễn đàn không được, giải thích "chay" vậy:
Curve có điểm đầu (startpoint) và điểm cuối (endpoint). Các điểm này được Acad xác định theo trình tự khi user tạo nó. Với 1 curve có sẵn, nhìn vào đó ta không thể nào biết được đầu nào là start, đầu nào là end.
(setq d1 (vlax-curve-getDistAtPoint c p1)) xác định chiều dài dọc theo curve từ điểm start đến p1. Tương tự, dh là chiều dài từ start đến điểm ph. Gọi d2 là khoảng cách từ start đến điểm cần xác định khoảng cách k (điểm p2)
Nếu dh > d1 -> điểm p1 gần start hơn ph -> d2 = d1 + k
Nếu dh < d1 -> điểm p1 xa start hơn ph -> d2 = d1 - k
  • 0

#12 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 16 October 2009 - 03:06 PM

Hình như bạn Thiep chưa hiểu đúng ý Duy? Duy tham khảo code sau và hoàn thiện thêm (kiểm tra giá trị user nhập vượt quá phạm vi curve...):


(defun C:POC( / c p1 oldos ph k d1 dh p2) ;;;Point On Curve
(vl-load-com)
(setq
c (car (entsel "\nChon curve:"))
p1 (getpoint "\nDiem chuan tren curve:")
oldos (getvar "osmode")
)
(entmake (list (cons 0 "POINT") (cons 10 p1)))
(setvar "osmode" 512)
(setvar "pdmode" 34)
(setq
ph (getpoint p1 "\nDiem dinh huong tren curve:")
k (getreal "\nKhoang cach:")
d1 (vlax-curve-getDistAtPoint c p1)
dh (vlax-curve-getDistAtPoint c ph)
)
(if (> dh d1) (setq d2 (+ d1 k)) (setq d2 (- d1 k)))
(setq p2 (vlax-curve-getPointAtDist c d2))
(entmake (list (cons 0 "POINT") (cons 10 p2)))
(setvar "osmode" oldos)
(princ)
)

Chào bác SSG, cảm ơn bác, vâng Thiep đã hiểu sai về điểm chuẩn trên curve, do bác Duy782006 không nói rõ đó là mốc 0,0 từ đó bắt đầu đo khoảng cách. Tuy nhiên lisp của bác đôi khi nó báo lỗi: ; error: bad DXF group: (10)... Thiep chưa rõ lỗi này?
  • 0

#13 duy782006

duy782006

    PHẠM QUỐC DUY

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

Đã gửi 16 October 2009 - 03:09 PM

Chào bác SSG, cảm ơn bác, vâng Thiep đã hiểu sai về điểm chuẩn trên curve, do bác Duy782006 không nói rõ đó là mốc 0,0 từ đó bắt đầu đo khoảng cách. Tuy nhiên lisp của bác đôi khi nó báo lỗi: ; error: bad DXF group: (10)... Thiep chưa rõ lỗi này?

Bạn xem load lại xem thế nào chứ mình đã thử trên: pline, spline, line, arc, circle điều đúng cả. Cách giải quyết của bác ssg đơn giản mà dể hiểu mình có thể chôm để làm nhiều việc khác :bigsmile:
  • 0

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#14 ssg

ssg

    biết lệnh adcenter

  • Vip
  • PipPipPipPipPipPipPip
  • 1228 Bài viết
Điểm đánh giá: 1087 (rất tốt)

Đã gửi 16 October 2009 - 03:17 PM

Chào bác SSG, cảm ơn bác, vâng Thiep đã hiểu sai về điểm chuẩn trên curve, do bác Duy782006 không nói rõ đó là mốc 0,0 từ đó bắt đầu đo khoảng cách. Tuy nhiên lisp của bác đôi khi nó báo lỗi: ; error: bad DXF group: (10)... Thiep chưa rõ lỗi này?

; error: bad DXF group: (10) là do p2 nil, xảy ra khi user nhập khoảng cách vượt quá phạm vi curve. Chỗ này ssg... chừa lại cho bạn Duy ấy mà :bigsmile:
  • 0

#15 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 16 October 2009 - 03:22 PM

Bạn xem load lại xem thế nào chứ mình đã thử trên: pline, spline, line, arc, circle điều đúng cả. Cách giải quyết của bác ssg đơn giản mà dể hiểu mình có thể chôm để làm nhiều việc khác :bigsmile:

Lỗi ở chỗ khi User chọn khoảng cách vượt quá chiều dài curve tính từ điểm mốc 0,0 theo hướng đo! Như vậy phải thêm:
Nếu: k> d (chiều dài curve tính từ điểm mốc 0,0 theo hướng đo) thì thông báo ....
còn không thì thực hiện tìm điểm p2...
  • 0

#16 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 16 October 2009 - 03:56 PM

Lỗi ở chỗ khi User chọn khoảng cách vượt quá chiều dài curve tính từ điểm mốc 0,0 theo hướng đo! Như vậy phải thêm:
Nếu: k> d (chiều dài curve tính từ điểm mốc 0,0 theo hướng đo) thì thông báo ....
còn không thì thực hiện tìm điểm p2...

Để Tue_NV nói rõ ràng ý này nhé :
Để Lisp không bị lỗi ta phải khống chế giá trị của k
Gọi L là chiều dài của Curve
- Khi dh > d1 => Điều kiện của k là k<= (L - d1) hay (d2=d1+k) <=L
- Khi dh < d1 => Điều kiện của k là k<= d1 hay (d2= d1 - k) >=0
Chúc anh Duy xây dựng thành công Code này
  • 0