tìm point của spl

Tháng 10 10, 2009

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 ạ

Tháng 10 10, 2009

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 ạ

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.

Tháng 10 11, 2009

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))

Tháng 10 16, 2009

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

Tháng 10 16, 2009

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

Tháng 10 16, 2009

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)
)

Tháng 10 16, 2009

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!

Tháng 10 16, 2009

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)
)

Tháng 10 16, 2009

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)
)

Tháng 10 16, 2009

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))

Tháng 10 16, 2009

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

Tháng 10 16, 2009

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?

Tháng 10 16, 2009

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:

Tháng 10 16, 2009

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:

Tháng 10 16, 2009

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...

Tháng 10 16, 2009

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

- Khi dh Điều kiện của k là k=0

Chúc anh Duy xây dựng thành công Code này

Đăng nhập

tìm point của spl

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

daknong 25

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

Nguyen Hoanh 4664

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

tivanteo 18

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

daknong 25

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

daknong 25

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

thiep 365

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

duy782006 1559

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

thiep 365

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

ssg 1102

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

gia_bach 1553

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

ssg 1102

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

thiep 365

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

duy782006 1559

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

ssg 1102

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

thiep 365

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

Tue_NV 3912

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

Tạo một tài khoản hoặc đăng nhập để nhận xét

Tạo tài khoản

Đăng nhập

Diễn đàn

Download

Đào tạo CADViet

Browse