Đến nội dung


Hình ảnh
- - - - -

[Yêu cầu] Lisp sắp xếp đối tượng theo đường cong


  • Please log in to reply
12 replies to this topic

#1 amateurday

amateurday

    biết lệnh break

  • Members
  • PipPipPipPip
  • 228 Bài viết
Điểm đánh giá: 4 (bình thường)

Đã gửi 06 June 2012 - 09:10 AM

Em có yêu cầu này nhờ các bác xem qua tí???
http://www.cadviet.c...49_drawing1.dwg
  • 0

#2 cd2k44

cd2k44

    Edu level: li5

  • Members
  • PipPipPipPipPipPipPip
  • 648 Bài viết
Điểm đánh giá: 121 (tàm tạm)

Đã gửi 06 June 2012 - 09:23 AM

bạn tìm lisp rải đối tượng theo đường dẫn của bác Duy đã làm.Rất ok
  • 0

#3 amateurday

amateurday

    biết lệnh break

  • Members
  • PipPipPipPip
  • 228 Bài viết
Điểm đánh giá: 4 (bình thường)

Đã gửi 06 June 2012 - 09:39 AM

cái này không phải rải đối tượng đâu, nó là sắp xếp đối tượng mà bác!!!
  • 0

#4 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 06 June 2012 - 10:40 AM

cái này không phải rải đối tượng đâu, nó là sắp xếp đối tượng mà bác!!!

Bạn y/c Lisp nhiều rồi, sao lại ném file cad lên mà không có vài lời diễn giải nhỉ?
Tôi đã đọc file của bạn, nhưng thấy bạn y/c chưa rõ ràng lắm. Tôi đoán như thế này:
Có 1 số đối tượng đủ các kiểu, đang nằm dọc theo 1 line nằm ngang. Bây giờ copy một đối tượng nào đó đến 1 điểm được chỉ định trên curve, sao cho vị trí tương đối của tiếp tuyến với curve tại điểm đó so với đối tượng cũng giống như vị trí tương đối của line so với đối tượng. Tức là vừa copy vừa rotate.
Nếu không đúng thì bạn bổ sung.
  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#5 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 06 June 2012 - 10:53 AM

Lần sau những bài yêu cầu theo phong cách "vừa đủ" sẽ bị phạt nhé a ma tơ. Nội quy có rõ ràng rồi mà. File là để minh họa :)
  • 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


#6 amateurday

amateurday

    biết lệnh break

  • Members
  • PipPipPipPip
  • 228 Bài viết
Điểm đánh giá: 4 (bình thường)

Đã gửi 06 June 2012 - 10:54 AM

Trước tiên xin nhận lời góp ý của các bác, vì em nghĩ có bản vẽ sẽ dễ hình dung nên em không ghi lên dd. Em sẽ rút kinh nghiệm lần sau (lâu lâu sơ sót vài tí)!!!
Cách giải thích của bác thì em không hiểu lắm, ý của em là các đối tượng sẽ được dời về polyline và được xoay theo hướng polyline (như hình vẽ). Và Khoảng cách từ đối tượng đó đến điểm đầu của đường thẳng = khoảng cách từ đối tượng đó đến điểm đầu của đường cong polyline. Không biết như vậy có giống với cách hiểu của bác không???
  • 0

#7 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 06 June 2012 - 11:00 AM

Thấy chưa? Tôi và bạn cùng diễn giải mà vẫn chưa hiểu hết nghĩa.
Tóm lại: Move + Rotate?
Nhưng khái niệm khoảng cách vẫn chưa rõ: khoảng cách trên line thì dễ, nhưng khoảng cách trên curve là khoảng cách máy bay bay hay khoảng cách ô tô chạy?
  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#8 mathan

mathan

    biết vẽ rectang

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

Đã gửi 06 June 2012 - 11:13 AM

Bạn yêu cầu mọi người giúp đỡ thì hãy thật rõ ràng yêu cầu và thật xúc tích nội dung
Như vậy yêu cầu của bạn sẽ sớm có đáp án hơn
  • 0
-----------
Hình đã gửi Hãy chia sẻ để thấy có được nhiều hơn điều mình muốn!
Best regard,

#9 amateurday

amateurday

    biết lệnh break

  • Members
  • PipPipPipPip
  • 228 Bài viết
Điểm đánh giá: 4 (bình thường)

Đã gửi 06 June 2012 - 11:38 AM

Hic. Diễn giải cho người khác hiểu quả là 1 nghệ thuật, phải đúc kết nhiều lần mới được.
Về yêu cầu của em thì: Khoảng cách là theo lý trình bác à. Đường polyline đó kiểu như đường thẳng mà mình bẻ cong đi ấy mà, các đối tượng cứ thế mà dính theo.
Hy vọng vậy là súc tích. Hic hic
  • 0

#10 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 06 June 2012 - 04:39 PM

Lisp sắp xếp các đối tượng dọc theo Curve. Đã test thấy OK. Bạn test lại giùm nhé.

;Doan Van Ha - CADViet.com - Ngay 06/6/2012
;Muc dich: sap xep cac doi tuong doc theo curve.
(defun C:HA( / z ent pt pg ptc pdh cur d1 dh d2 p lst)
(vl-load-com) (command "undo" "be") (setq osm (getvar "osmode"))
(setq z 1)
(while
(and
(setq ent (car (entsel (strcat "\nChon doi tuong thu " (itoa z) ": "))))
(setq pt (getpoint (strcat "\nChon diem goc cua doi tuong thu " (itoa z) ": "))))
(if (= z 1) (setq pg pt))
(setq lst (cons (list ent pt (distance pg pt)) lst))
(setq z (1+ z)))
(setq lst (reverse lst))
(setq ptc (getpoint "\nChon diem dat cua doi tuong thu 1 tren Curve: "))
(setq pdh (getpoint ptc "\nChon 1 diem tren Curve de xac dinh huong: "))
(setq cur (car (nentselp ptc)))
(setq d1 (vlax-curve-getDistAtPoint cur ptc))
(setq dh (vlax-curve-getDistAtPoint cur pdh))
(setvar "osmode" 0)
(foreach n lst
(if (> dh d1)
(setq d2 (+ d1 (caddr n)))
(setq d2 (- d1 (caddr n))))
(setq p (vlax-curve-getPointAtDist cur d2))
(command "move" (car n) "" (cadr n) p)
(command "rotate" (car n) "" p (/ (* 180 (angle '(0 0 0) (vlax-curve-getFirstDeriv cur (vlax-curve-getParamAtPoint cur p)))) pi)))
(command "undo" "end") (setvar "osmode" osm) (princ))

  • 3

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#11 amateurday

amateurday

    biết lệnh break

  • Members
  • PipPipPipPip
  • 228 Bài viết
Điểm đánh giá: 4 (bình thường)

Đã gửi 06 June 2012 - 05:05 PM

OK rồi bác. Thanks bác nhiều!!!
Thiếu 1 dòng (vl-load-com), em bổ sung luôn.

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=64524
;Doan Van Ha - CADViet.com - Ngay 06/6/2012
;Muc dich: sap xep cac doi tuong doc theo curve.
(defun C:HA( / z ent pt pg ptc pdh cur d1 dh d2 p lst)
(vl-load-com)
(command "undo" "be") (setq osm (getvar "osmode"))
(setq z 1)
(while
(and
(setq ent (car (entsel (strcat "\nChon doi tuong thu " (itoa z) ": "))))
(setq pt (getpoint (strcat "\nChon diem goc cua doi tuong thu " (itoa z) ": "))))
(if (= z 1) (setq pg pt))
(setq lst (cons (list ent pt (distance pg pt)) lst))
(setq z (1+ z)))
(setq lst (reverse lst))
(setq ptc (getpoint "\nChon diem dat cua doi tuong thu 1 tren Curve: "))
(setq pdh (getpoint ptc "\nChon 1 diem tren Curve de xac dinh huong: "))
(setq cur (car (nentselp ptc)))
(setq d1 (vlax-curve-getDistAtPoint cur ptc))
(setq dh (vlax-curve-getDistAtPoint cur pdh))
(setvar "osmode" 0)
(foreach n lst
(if (> dh d1)
(setq d2 (+ d1 (caddr n)))
(setq d2 (- d1 (caddr n))))
(setq p (vlax-curve-getPointAtDist cur d2))
(command "move" (car n) "" (cadr n) p)
(command "rotate" (car n) "" p (/ (* 180 (angle '(0 0 0) (vlax-curve-getFirstDeriv cur (vlax-curve-getParamAtPoint cur p)))) pi)))
(command "undo" "end") (setvar "osmode" osm) (princ))

  • 0

#12 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 06 June 2012 - 11:53 PM

OK rồi bác. Thanks bác nhiều!!! Thiếu 1 dòng (vl-load-com), em bổ sung luôn.

Hề hề hề,
Tiện thể bạn test thử cái củ chuối này xem có chát không nhé:

(defun c:mrd (/ oldos obj obj1 ent ent1 plst ssdt ssmr p p1 p2 l1 v1 v2 g1 g2)
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(command "undo" "be")
(setq obj (vlax-ename->vla-object (setq ent (car (entsel "\n Chon duong lwpolyline chuan"))))
plst (acet-geom-vertex-list ent)
ssdt (acet-ss-to-list (ssget "f" plst))
ssmr (list)
)
(foreach en ssdt
(setq p (cdr (assoc 10 (entget en)))
p1 (vlax-curve-getclosestpointto obj p)
l1 (vlax-curve-getdistatpoint obj p1)
v1 (vlax-curve-getfirstderiv obj (vlax-curve-getparamatpoint obj p1))
g1 (atan (/ (cadr v1) (car v1))) )
(if (and (equal (distance p p1) 0 0.000001) (not (equal en ent)) )
(setq ssmr (append (list (list en l1 p1 g1)) ssmr))
)
)
(setq obj1 (vlax-ename->vla-object (setq ent1 (car (entsel "\n Chon duong lwpolyline dich")))))
(foreach en1 ssmr
(setq p2 (vlax-curve-getpointatdist obj1 (cadr en1))
v2 (vlax-curve-getfirstderiv obj1 (vlax-curve-getparamatpoint obj1 p2))
g2 (atan (/ (cadr v2) (car v2))) )
(command "copy" (car en1) "" (caddr en1) p2 "rotate" (entlast) "" p2 (/ (* 180 (- g2 (cadddr en1))) pi) )
)
(command "undo" "e")
(setvar "osmode" oldos)
(princ)
)

  • 3
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#13 amateurday

amateurday

    biết lệnh break

  • Members
  • PipPipPipPip
  • 228 Bài viết
Điểm đánh giá: 4 (bình thường)

Đã gửi 07 June 2012 - 07:40 AM

Quá "củ chuối", em thích "củ chuối" này lắm, 1 lisp manual và 1 lisp automatic, cái nào cũng quyến rũ cả. Hehe, thanks các bác!!!!!!!
  • 0