Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Người theo dõi 0
soluuhuong2903

[ YÊU CẦU] : Lisp chèn đối tượng theo lý trình

Bởi soluuhuong2903 , trong AutoLisp

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

ketxu    2.984

ketxu
Đã đăng

Đề bài không khó nhưng yêu cầu chưa đủ rõ ràng. Ảnh minh họa của bạn đâu ? Đầu vào đầu ra như thế nào ? Điểm đầu - cuối của đường dẫn lisp xác định như thế nào? Xác định xong rồi thì chặt đối tượng gốc hay copy đối tượng gốc ra chỗ mới rồi chặt ? Chặt đối tượng thì phần còn lại có giữ không ? Copy ra cái mới thì chọn điểm đặt mốc ntn ? Có phải ghi text ghi chú 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

soluuhuong2903    22

soluuhuong2903
Đã đăng

thank ketxtu.hi. yêu cầu của mình như sau:

Chọn đường bất kì.

Xác định điểm đầu A hoặc không (theo mặc định của đường mình vẽ trong cad).

Nhập lý trình của các điểm D1, D2, D3...

Kết quả: ---> Đánh dấu các điểm D1, D2, D3 bằng circle hoặc insert block tại các điểm đó.

PS: nếu được xuất 2 cột text ghi chú như sau cho e thống kê:

Tên Điểm Lý trình

D1 d1

D2 d2

.......

Ko move, ko xóa, ko chặt j đường AB bác ketxu 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

ketxu    2.984

ketxu
Đã đăng

Trên hình của bạn lại không có điểm D mới dở chứ :) Rồi điền lý trình thì điền vào đâu ?

Với lại, mình là dân ngoại đạo, bạn tiện thì giải thích luôn cho mình Lý trình điểm D1 bằng khoảng cách A-> D1, còn từ điểm D2 thì ....? :)

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

ketxu    2.984

ketxu
Đã đăng

OK :) Tối về nếu chưa ai viết giùm bạn thì mình viết. Giờ mình phải đi công trường rồi. Gluck :)

  • 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

duy782006    1.549

duy782006
Đã đăng

Theo mình thì cái lisp này của bác ssg dùng linh hoạt cho mọi trường hợp rất chi là ok đấy.

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

Theo mình thì cái lisp này của bác ssg dùng linh hoạt cho mọi trường hợp rất chi là ok đấy.

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

  • 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

soluuhuong2903    22

soluuhuong2903
Đã đăng

thank bác duy và bác ssg. Lisp này e dùng thấy cũng ok rồi.Mong các bác edit sao cho nhập liên tục được lý trình thì hay quá. Cứ 1 điểm lại nhập 1 lần lệnh thì cũng căng ghê. Tại số lượng điểm của e rất lớn. thank các bác.Hehe. Và xin các bác đánh dấu các điềm đó bằng circle hoặc line dùm e. Dùng point như trong lisp Poc thế là lisp format luôn point có sẳn của em luôn.:D

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

ketxu    2.984

ketxu
Đã đăng 
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=62370&hl=&fromsearch=1
(defun c:lt(/ lst lt pt curve txtsiz msp i)
(grtext -1 "Free from Cadviet @Ketxu")
(command "undo" "be")
(vl-load-com)
(mapcar 'set '(curve pt) (nentselp "\nPick start point:"))
(setq isFirst (< (distance (vlax-curve-getStartPoint curve) pt)(distance (vlax-curve-getEndPoint curve) pt)) i 0
 ln (vlax-curve-getDistAtParam curve (vlax-curve-getEndParam curve ))
)
(while (and (setq lt (getreal (strcat "\nNhap ly trinh diem thu " (itoa (setq i (1+ i))) " : "))) (< lt ln))
 (entmake
  (list (cons 0 "CIRCLE")
 (cons 10  (vlax-curve-getPointAtDist curve (if isFirst lt (- ln lt))))
 (cons 40 0.1) ;Kich thuoc vong tron
  )
 )
 (setq lst (cons (cons i lt) lst))
)
(setq  pt (getpoint "\nDiem dat bang thong ke:")
 txtsiz (* (getvar "dimtxt")(getvar "dimscale"))
 msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(foreach e (reverse lst)
(vla-addtext msp (itoa (car e)) (vlax-3d-point pt) txtsiz)
(vla-addtext msp (rtos (cdr e) 2 2) (vlax-3d-point (polar pt 0 (* 5 txtsiz))) txtsiz )
(setq pt (polar pt (/ pi -2) (* 1.5 txtsiz)))
)
(command "undo" "en")
)

  • 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

ketxu    2.984

ketxu
Đã đăng

Bác ketxu nhiệt tình ghê.12h đêm vẫn làm việc.thank bác.mà bác ơi lisp LT này ko chạy được với các đường cong như spline hay arc thì phải.bác fix lại dùm e cái.

Không sao, vì yêu cầu này nói chung cũng có nhiều cái na ná rồi, mình copy paste 10p là xong ý mà. Đã sửa lại bên trên, bạn down lại nhé (do đêm qua gà gật k nhớ SPLINE k có property Length)

 

Lưu ý là mình code nhanh, k bắt lỗi. Phương pháp chọn vừa là pick điểm đầu + chọn đối tượng luôn trong 1 thao tác, nếu bạn không thích thì có thể tách ra :)

  • 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

soluuhuong2903    22

soluuhuong2903
Đã đăng

Phiền bác ketxu lần nữa quá.bác mod lại dùm em.chả là số lượng điểm lớn quá mà mark bằng circle ko thì chỉ cần lơ đãng tí thôi là e lộn hết.Hic.ở mỗi điểm ngoài mark bằng circle bác có thể thêm text ghi chú là D1 d1 ... giống như phần thống kê ấy.hi.xin lỗi vì yêu càu nhỏ giọt quá.lúc làm mới thấy phát sinh nhiều vấ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

ketxu    2.984

ketxu
Đã đăng

Mình đã hỏi là nó đánh vào đâu ? Trái phải trên giữa hay chính tâm cái vòng tròn ?

  • 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

ketxu    2.984

ketxu
Đã đăng 
(defun c:lt(/ lst lt pt curve txtsiz msp i cen r tmp)
(grtext -1 "Free from Cadviet @Ketxu")
(command "undo" "be")
(vl-load-com)
(setq  txtsiz (cond ((zerop (setq tmp (* (getvar "dimtxt")(getvar "dimscale")))) 1)
 	(T tmp))  
 msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) 
(mapcar 'set '(curve pt) (nentselp "\nPick start point:"))
(setq isFirst (< (distance (vlax-curve-getStartPoint curve) pt)(distance (vlax-curve-getEndPoint curve) pt)) i 0
 ln (vlax-curve-getDistAtParam curve (vlax-curve-getEndParam curve ))
)
(while (and (setq lt (getreal (strcat "\nNhap ly trinh diem thu " (itoa (setq i (1+ i))) " : "))) (< lt ln))
 (entmake
  (list (cons 0 "CIRCLE")
 (cons 10  (setq cen (vlax-curve-getPointAtDist curve (if isFirst lt (- ln lt)))))
 (cons 40 (setq r 0.1)) ;Kich thuoc vong tron
  )
 )
 (vla-addtext msp (strcat (itoa i) " " (rtos lt 2 2)) (vlax-3d-point (mapcar '+ cen (list 0 (* 2 r) 0))) txtsiz)
 (setq lst (cons (cons i lt) lst))
)
(setq  pt (getpoint "\nDiem dat bang thong ke:"))

(foreach e (reverse lst)
(vla-addtext msp (itoa (car e)) (vlax-3d-point pt) txtsiz)
(vla-addtext msp (rtos (cdr e) 2 2) (vlax-3d-point (polar pt 0 (* 5 txtsiz))) txtsiz )
(setq pt (polar pt (/ pi -2) (* 1.5 txtsiz)))
)
(command "undo" "en")
)

  • Vote tăng 3

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

hoacomay70    4

hoacomay70
Đã đăng
Vào lúc 5/3/2012 tại 14:42, ketxu đã nói: 

(defun c:lt(/ lst lt pt curve txtsiz msp i cen r tmp)
(grtext -1 "Free from Cadviet @Ketxu")
(command "undo" "be")
(vl-load-com)
(setq  txtsiz (cond ((zerop (setq tmp (* (getvar "dimtxt")(getvar "dimscale")))) 1)
 	(T tmp))  
 msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) 
(mapcar 'set '(curve pt) (nentselp "\nPick start point:"))
(setq isFirst (< (distance (vlax-curve-getStartPoint curve) pt)(distance (vlax-curve-getEndPoint curve) pt)) i 0
 ln (vlax-curve-getDistAtParam curve (vlax-curve-getEndParam curve ))
)
(while (and (setq lt (getreal (strcat "\nNhap ly trinh diem thu " (itoa (setq i (1+ i))) " : "))) (< lt ln))
 (entmake
  (list (cons 0 "CIRCLE")
 (cons 10  (setq cen (vlax-curve-getPointAtDist curve (if isFirst lt (- ln lt)))))
 (cons 40 (setq r 0.1)) ;Kich thuoc vong tron
  )
 )
 (vla-addtext msp (strcat (itoa i) " " (rtos lt 2 2)) (vlax-3d-point (mapcar '+ cen (list 0 (* 2 r) 0))) txtsiz)
 (setq lst (cons (cons i lt) lst))
)
(setq  pt (getpoint "\nDiem dat bang thong ke:"))

(foreach e (reverse lst)
(vla-addtext msp (itoa (car e)) (vlax-3d-point pt) txtsiz)
(vla-addtext msp (rtos (cdr e) 2 2) (vlax-3d-point (polar pt 0 (* 5 txtsiz))) txtsiz )
(setq pt (polar pt (/ pi -2) (* 1.5 txtsiz)))
)
(command "undo" "en")
)
 

 

Bác ơi có thể chỉnh sửa giúp em lisp này bằng cách thay circle bằng block ko ạ (block xoay vuông góc với tuyến luôn ạ). Ngoài ra lisp có thể nhận được lý trình và tên block cần chèn từ bảng cel ngoài như mẫu dưới được không ạ. Cảm ơn bác rất nhiều.

Capture.PNG

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

ketxu    2.984

ketxu
Đã đăng
7 giờ trước, hoacomay70 đã nói:

Bác ơi có thể chỉnh sửa giúp em lisp này bằng cách thay circle bằng block ko ạ (block xoay vuông góc với tuyến luôn ạ). Ngoài ra lisp có thể nhận được lý trình và tên block cần chèn từ bảng cel ngoài như mẫu dưới được không ạ. Cảm ơn bác rất nhiều.

Capture.PNG

Làm được nhưng tên Block của bạn có tiếng Việt có dấu k ^^ Mình nhớ là có bác gợi ý viết giúp bạn rồi mà 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

alisp    72

alisp
Đã đăng

Bác @hoacomay có vẻ không biết topic này chấm dứt 9  năm trước rồi sao, bây giờ kiếm người viết tiếp chắc là khó lắm!

  • Like 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

hoacomay70    4

hoacomay70
Đã đăng
12 giờ trước, alisp đã nói:

Bác @hoacomay có vẻ không biết topic này chấm dứt 9  năm trước rồi sao, bây giờ kiếm người viết tiếp chắc là khó lắm!

☹️ Thế ạ buồn quá, cảm ơn bá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

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

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay
Đăng nhập để thực hiện theo  
Người theo dõi 0
Về Đầu Trang AutoLisp
×