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.
Đăng nhập để thực hiện theo  
soluuhuong2903

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

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

ketxu    2.649

Đề 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

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

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

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

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

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

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

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

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

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  

×