Chuyển đến nội dung
Diễn đàn CADViet
duy782006

[Đã xong] Lisp rải đối tượng theo đơờng dẩn.

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

*Lâu nay dùng cái MEASURE và DIVIDE của cad thấy có vài hạn chế:

-Chỉ rải được point và block.

-Block thỉ phải gỏ tên và được chèn ra với tỉ lệ 1/1.

-Bỏ qua không chèn vào vị trí xuất phát của đường dẩn.

*Dựa trên cái lisp xác định điểm của bác SSG cho mình cải tạo và nhập chung thành 1 lệnh tác dụng tương đương và cải thiện các nhược điểm mình nêu trên: (à nghe bảo cad12 đã kết hợp array theo đường dẩn nhưng mình chưa tiếp xúc nên ko biết có bị dẩm lên đó ko nhưng đây là thử nghiệm vì mình tính cho xác định điểm bắt đầu và hướng rải nửa nhưng chưa nghỉ ra kịch bản vì có quá nhiều thường hợp muốn)

-Tên lệnh: RDT (rải đối tượng)

-Hỏi chọn đối tượng muốn rải: Bạn chọn thoải mái bằng các kiểu (đối tượng gì cũng được) kết thúc chọn bằng enter.

+Nếu bạn chọn hơn 1 đối tượng thì sẽ hỏi bạn chọn điểm chuẩn cho nhóm đối tượng này (dùng để làm điểm đặt trên đường dẩn í).

+Nếu bạn chọn 1 đối tượng thì sẽ xem nếu đối tượng không phải là block thì vẩn hỏi chọn điểm chuẩn, Nếu đối tượng là block thì bỏ qua phần hỏi chọn điểm chuẩn mà lấy điểm chèn của block đó làm điểm chuẩn.

-Hỏi chọn đường dẩn dùng để rải.

-Hỏi “Kieu rai theo: So luong/<Khoang cach>” :

+Rải theo số lượng thì nhập S enter.

+Rải theo khoảng cách thì nhập K enter hoặc enter không (thực chất cứ nhập vào khác S thì nhận là khoảng cách).

-Tùy theo lựa chọn mà hỏi khoảng cách rải hay số lượng rải.

-Hỏi“Co quay doi tuong vuong goc voi duong dan khong: Khong/<Co>") :

+Không quay đối tượng cho vuông gó với đường dẩn thì nhập K enter.

+Có quay thì nhập C en ter hoặc enter không (thực chất cứ nhập vào khác K thì nhận là có).

*Xong rồi. Bác nào có nhu cầu thì dùng không có thì dòm. Mong không ném đá hoặc dè bỉu. :P

 

 

(Defun c:rdt (/ ss)
(command "undo" "be")
(chonnhomdoituong)
(choncuver)
(hoikieurai)
(command "undo" "end")
 (princ)
)
;;;;;;;;;;;;;;;;;
(Defun chonnhomdoituong ()
 (princ "\nChon doi tuong rai:")
 (setq ss (ssget))

(cond 
     ((= ss nil) (princ "\nChua chon duoc doi tuong nao:") (chonnhomdoituong))
     ((/= ss nil) 
(setq dsl (sslength ss))
           (cond 
           ((= dsl 1) 
(setq doituong (ssname SS 0))
(setq doituong (entget doituong))
(setq KIEUDOITUONG (cdr (assoc 0 doituong)))
                  (cond 
                  ((= KIEUDOITUONG "INSERT") (setq dc (cdr (assoc 10 doituong))))
                  ((/= KIEUDOITUONG "INSERT") (setq dc (getpoint "\nChon diem goc: ")))
                  );ketthuccondxemblock
                );kethucdsl1
           ((/= dsl 1) (setq dc (getpoint "\nChon diem goc: ")))
           );ketthuccondnho

);ketthucsetqdsl
);ketthuccondtong  
 (princ)
)
;;;;;;;;;;;;;;;;;
(Defun choncuver ()

(setq ddd (entsel "\nChon duong dan:"))
(while
(or
(null ddd)
(or (= "TEXT" (cdr (assoc 0 (entget (car ddd))))) (= "MTEXT" (cdr (assoc 0 (entget (car ddd))))) (= "HATCH" (cdr (assoc 0 (entget (car ddd))))) (= "INSERT" (cdr (assoc 0 (entget (car ddd))))) (= "REGION" (cdr (assoc 0 (entget (car ddd))))) (= "DIMENSION" (cdr (assoc 0 (entget (car ddd)))))
)
)
(setq ddd (entsel "\nDoi tuong khong the lam duong dan! Chon lai"))
)

(setq chondd (car ddd))
(setq luubatdiem (getvar "osmode"))
 (setvar "osmode" 0)
(setq chieudaicuver (vlax-curve-getDistAtParam chondd (vlax-curve-getEndParam chondd)))
(setq diemdau (vlax-curve-getPointAtDist chondd 0))
(setq diemcuoi (vlax-curve-getPointAtDist chondd chieudaicuver))
(setvar "osmode"luubatdiem)
 (princ)
)
;;;;;;;;;;;;;;;;;
(Defun hoikieurai (/ kieurai)
 (setq krai (strcase (getstring "\nKieu rai theo: So luong/<Khoang cach>")))
(Cond
((= krai "S") (raisoluong))
((/= krai "S")(raikhoangcach))
) 
 (princ)
)
;;;;;;;;;;;;;;
(Defun raikhoangcach ()
  (setq chieudaidoan (GETDIST "\nKhoang cach doan chia: "))
  (setq sol (+ (/ chieudaicuver chieudaidoan) 1))
   (setq sl (fix sol))
   (setq sl (fix sl))
(thuchienrai)
 (princ)
)
;;;;;;;;;;;;;;
(Defun raisoluong ()
(setq slc (getreal "\nChia duong dan thanh may lan:"))
(setq chieudaidoan (/ chieudaicuver slc))
(setq sl (fix (+ 1 slc)))
(thuchienrai)
 (princ)
)
;;;;;;;;;;;;;;
(Defun thuchienrai (/ quaykhong)

 (setq quaykhong (strcase (getstring "\nCo quay doi tuong vuong goc voi duong dan khong: Khong/<Co>")))
(Cond
((= quaykhong "K") (setq copygiua copykoquay))
((/= quaykhong "K")(setq copygiua copyquay))
) 

(setq index -1)

 (repeat sl
(setq index (1+ index))
(setq d2 (* chieudaidoan index))
(setq luubatdiem (getvar "osmode"))
 (setvar "osmode" 0)
(setq p2 (vlax-curve-getPointAtDist chondd d2))
(setvar "osmode"luubatdiem)
(copygiua)
 )
 (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun copycuoiquay()
(setq luubatdiem (getvar "osmode"))
 (setvar "osmode" 0)
(setq d5 (- chieudaicuver 0.001))
(setq p5 (vlax-curve-getPointAtDist chondd d5))
(setq L 0)
(setq M (sslength ss))
(while (< L M)
  (setq DT (ssname ss L))
  (command ".copy" DT "" dc p5)
  (command ".rotate" "last" "" diemcuoi p5)
  (command ".rotate" "last" "" diemcuoi 180)
  (setq L (1+ L))
)
(setvar "osmode"luubatdiem)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun COPYQUAY(/ p3)
(setq luubatdiem (getvar "osmode"))
 (setvar "osmode" 0)
(setq d3 (+ (* chieudaidoan index) 0.001))
(setq p3 (vlax-curve-getPointAtDist chondd d3))
(setvar "osmode"luubatdiem)
(Cond
((= p3 nil) (copycuoiquay))
((/= p3 nil) 
(setq L 0)
(setq M (sslength ss))
(setq luubatdiem (getvar "osmode"))
 (setvar "osmode" 0)
(while (< L M)
  (setq DT (ssname ss L))
  (command ".copy" DT "" dc p2)
  (command ".rotate" "last" "" p2 p3)
  (setq L (1+ L))
)
(setvar "osmode"luubatdiem)
)
) 


(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun COPYKOQUAY()
(setq luubatdiem (getvar "osmode"))
 (setvar "osmode" 0)
(command ".copy" ss "" dc p2 "")
(setvar "osmode"luubatdiem)
(princ)
)
;;;;;;;;;;;;;;

 

Khi mình xem bài này với vai trò khách thì thấy có hộp code đàng hoàng nhưng đăng nhập vào thì không hiển thị hộp code (chỉ với bài này thôi còn các bài của các bác khác thì vẩn hiển thị bình thường)!

  • Like 1
  • Vote tăng 17

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

em vừa dùng lisp của anh xong.Sau khi thử em có nhận xét như sau:

1.Lệnh này chậm hơn me.

2. Sau khi rải sao đối tượng mình rải lại lệch sơ với đối tượng gốc ( đối tượng rải bị dịch chuyển)- Cái này ko biêt do em thao tác hay sao nữa, mong anh chỉ rõ cho em hoặc cải tiến lại nếu lisp thực hiện như vậy thì tốt quá anh.

Untitled-13.png[/img]

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

em vừa dùng lisp của anh xong.Sau khi thử em có nhận xét như sau:

1.Lệnh này chậm hơn me.

2. Sau khi rải sao đối tượng mình rải lại lệch sơ với đối tượng gốc ( đối tượng rải bị dịch chuyển)- Cái này ko biêt do em thao tác hay sao nữa, mong anh chỉ rõ cho em hoặc cải tiến lại nếu lisp thực hiện như vậy thì tốt quá anh.

Untitled-13.png[/img]

Hu hu cái hình "to" quá nhìn o thấy gì hết. Bạn lưu ý chọn cái điểm dùng để chèn cho chính xác. Bạn làm thử với 3 hay 4 đối tượng to to tí chi dể kiểm tra!

Đây là hình mình kiểm tra nè. Còn việc chậm thì chắc phải sống chung với lũ thôi bạn. :D

rau.jpg

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

*Lâu nay dùng cái MEASURE và DIVIDE của cad thấy có vài hạn chế:

-Chỉ rải được point và block.

-Block thỉ phải gỏ tên và được chèn ra với tỉ lệ 1/1.

-Bỏ qua không chèn vào vị trí xuất phát của đường dẩn.

.......

*Xong rồi. Bác nào có nhu cầu thì dùng không có thì dòm. Mong không ném đá hoặc dè bỉu. :P

................

Bác Duy cho "dòm" 1 chút. Không dám "ném đá" đâu ! :rolleyes:

Lisp đã khắc phục vài hạn chế của CAD.

(tuy nhiên lisp chưa hoàn thiện khi quay đối tượng gốc.)

rdt.jpg

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

Bác Duy cho "dòm" 1 chút. Không dám "ném đá" đâu ! :rolleyes:

Lisp đã khắc phục vài hạn chế của CAD.

(tuy nhiên lisp chưa hoàn thiện khi quay đối tượng gốc.)

rdt.jpg

-Thêm phần góc quay nửa cũng được nhưng em nghỉ bác quay cái SOURCE lộn ngược lại trước khi rải (nếu bị ngược thao tác này nhanh mà) thì nhàn hơn nên thôi.

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

Sau khi thử e có vài ý kiến sau:

- nếu rải trên đường thẳng thi khi quay tượng gốc, nó ko thấy quay .

- Rải trên đường cong, làm giống bác Gia_bạch hình cuối cùng ko tài nào làm giống đc, chữ cứ bị nghiêng đi.

 

Lisp rất hay mong các bác ra tay xử lý dùm

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

Sau khi thử e có vài ý kiến sau:

- nếu rải trên đường thẳng thi khi quay tượng gốc, nó ko thấy quay .

- Rải trên đường cong, làm giống bác Gia_bạch hình cuối cùng ko tài nào làm giống đc, chữ cứ bị nghiêng đi.

 

Lisp rất hay mong các bác ra tay xử lý dùm

-Muốn text không bị xiên thì chọn không quay. Muốn như bác Gia_bach thì chọn điểm gốc ở tâm hình tròn í.

-Hình thử các trường hợp cho bạn dể hình dung đây.

quayko.jpg

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

-Thêm phần góc quay nửa cũng được nhưng em nghỉ bác quay cái SOURCE lộn ngược lại trước khi rải (nếu bị ngược thao tác này nhanh mà) thì nhàn hơn nên thôi.

Hề hề hề,

Đá thì hổng dám ném chớ gạch thì có đây....

Cái ni (choncuver) chắc ý bác nói (chonCurve) phải không ạ??? Curve nghe dễ hiểu hơn là Cuver bác ạ.

Hề hề hề,

  • 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

Hu hu cái hình "to" quá nhìn o thấy gì hết. Bạn lưu ý chọn cái điểm dùng để chèn cho chính xác. Bạn làm thử với 3 hay 4 đối tượng to to tí chi dể kiểm tra!

Đây là hình mình kiểm tra nè. Còn việc chậm thì chắc phải sống chung với lũ thôi bạn. :D

rau.jpg

Em cũng không biết sao cứ bị vậy nè.Em gửi anh file cad a kiểm tra giùm em với

http://www.cadviet.com/upfiles/3/cam_cong_hoan_thien.rar

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

Em cũng không biết sao cứ bị vậy nè.Em gửi anh file cad a kiểm tra giùm em với

http://www.cadviet.com/upfiles/3/cam_cong_hoan_thien.rar

File của bạn đang để hệ tọa độ UCS -> Lisp chạy chưa đúng.

trong khi chờ đợi bác Duy fix lỗi này, bạn chuyển hệ tọa độ về WCS là chạy đuợc.

  • 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

File của bạn đang để hệ tọa độ UCS -> Lisp chạy chưa đúng.

trong khi chờ đợi bác Duy fix lỗi này, bạn chuyển hệ tọa độ về WCS là chạy đuợc.

Sao em chuyển vể WCS mà vẫn chưa được anh gia_bach ah

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

Hề hề hề,

Đá thì hổng dám ném chớ gạch thì có đây....

Cái ni (choncuver) chắc ý bác nói (chonCurve) phải không ạ??? Curve nghe dễ hiểu hơn là Cuver bác ạ.

Hề hề hề,

Hu hu bác ném trúng viên tấp lô luôn chớ hông phải gạch. Nói chơi chứ tiếng Anh em dốt kinh (bác bắt trúng rồi í). Nhưng nó là hàm con ko thể hiện ra ngoài khi chạy chắc ít người thấy. :lol:

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

File của bạn đang để hệ tọa độ UCS -> Lisp chạy chưa đúng.

trong khi chờ đợi bác Duy fix lỗi này, bạn chuyển hệ tọa độ về WCS là chạy đuợc.

 

Fix kiểu gì bác ới. Quay trục tọa độ xong thực hiện lệnh, rồi trả lại à bác. Chứ dùng trans thì chình hông nổi do lỡ viết dài quá :ph34r:

 

Sao em chuyển vể WCS mà vẫn chưa được anh gia_bach ah

Mình chuyển trục tọa độ xong làm phát ăn ngay mà bạn. Nhớ chọn điểm chèn cho nó gần cái text í. :excl:

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

hề hề, mọi nguời không ném kệ mọi nguời. Em là em fải ném. Đá to cho Bác Duy đây:

Bác đặt tên biến rất ngắn, mà rất nhiều biến của bác chưa định nghĩa là biến cục bộ. điều này dễ gây xung đột với các lisp khác của người dùng bác ah. Em test fát là có lệnh của em bị dính lun :rolleyes:

  • 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

- Tks bác Duy vì lisp dựa trên hướng đi khác biệt ^^ Mà e thấy nó có lựa chọn cho chèn khác tỉ lệ 1/1 đâu hè

- Tuy nhiên, nếu là em, e sẽ giải quyết bài toán này theo cách :

+ Tạo temp-block từ tập ss

+ Measure/Divide block này theo đường dẫn + làm 2 em ở đầu và cuối đường dẫn

+ Explode tập vừa tạo ra và purge Block đó đi

Như vậy thì cải thiện được chút chút nhược điểm bác nêu + cải thiện tốc độ so với command copy, code cũng có vẻ ngắn hơn chăng (tận dụng ACET)?

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

- Tks bác Duy vì lisp dựa trên hướng đi khác biệt ^^ Mà e thấy nó có lựa chọn cho chèn khác tỉ lệ 1/1 đâu hè

- Tuy nhiên, nếu là em, e sẽ giải quyết bài toán này theo cách :

+ Tạo temp-block từ tập ss

+ Measure/Divide block này theo đường dẫn + làm 2 em ở đầu và cuối đường dẫn

+ Explode tập vừa tạo ra và purge Block đó đi

Như vậy thì cải thiện được chút chút nhược điểm bác nêu + cải thiện tốc độ so với command copy, code cũng có vẻ ngắn hơn chăng (tận dụng ACET)?

-Tỉ lệ khác 1/1 ý mình là block được chọn nếu đã scale rồi thì khi rải vẩn đảm bảo giống chứ ko chèn theo tên với tỉ lệ 1/1 như cad.

-Mình đã nói trước là tính đi theo hướng cho chọn điểm gốc và hướng rải (xuất phát từ thực tế của nghề) nhưng nhiều "muốn" quá nên chưa xây dựng đc kịch bả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

hề hề, mọi nguời không ném kệ mọi nguời. Em là em fải ném. Đá to cho Bác Duy đây:

Bác đặt tên biến rất ngắn, mà rất nhiều biến của bác chưa định nghĩa là biến cục bộ. điều này dễ gây xung đột với các lisp khác của người dùng bác ah. Em test fát là có lệnh của em bị dính lun :rolleyes:

Ok tiếp thu ý bác. Nhưng mình các hàm con nằm trong vòng lặp nhiều quá nên đặt biến cục bộ nó bị mất sinh lỗi hoài nên để tạm thế. Mình sẽ chỉnh cho biến dài thooooooooooòng ra để khỏi đánh nhau với lisp cảu bác thai nhá.

  • 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

lisp rất hay nhưng thiếu mất cái hàm (vl-load-com) máy mình ko load lisp nào hết nên ra lỗi no function definition: VLAX-CURVE-GETENDPARAM

(setq KIEUDOITUONG (cdr (assoc 0 doituong)))
  				(cond 
  				((= KIEUDOITUONG "INSERT") (setq dc (cdr (assoc 10 doituong))))
  				((/= KIEUDOITUONG "INSERT") (setq dc (getpoint "\nChon diem goc: ")))
  				);ketthuccondxemblock
				);kethucdsl1
       	((/= dsl 1) (setq dc (getpoint "\nChon diem goc: ")))
       	);ketthuccondnho

Đoạn này nếu enter trong trường hợp ko phải Block thì biến dc sẽ bị sai,

lisp hay, vote cho bác 1 phiếu :rolleyes:

  • 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

Đã chỉnh lại:

-Quay và trả trục tọa độ.

-Không chọn điểm chuẩn thì hỏi chọn miết chừng nào chọn thì mới thôi.

-Định nghĩa biến cục bộ cho khỏi đá.

-Thêm dòng (vl-load-com).

 

 

(Defun c:rdt (/ ss doituong dsl dc ddd chondd chieudaicuver diemdau krai chieudaidoan slc sl index d2 p2 d5 p5 d3 p3 dt l m)
(vl-load-com)
(command "undo" "be")
(command "ucs" "")
(chonnhomdoituong)
(choncuver)
(hoikieurai)
(command "ucs" "p")
(command "undo" "end")
 (princ)
)
;;;;;;;;;;;;;;;;;
(Defun chonnhomdoituong ()
 (princ "\nChon doi tuong rai:")
 (setq ss (ssget))

(cond 
     ((= ss nil) (princ "\nChua chon duoc doi tuong nao:") (chonnhomdoituong))
     ((/= ss nil) 
(setq dsl (sslength ss))
           (cond 
           ((= dsl 1) 
(setq doituong (ssname SS 0))
(setq doituong (entget doituong))
(setq KIEUDOITUONG (cdr (assoc 0 doituong)))
                  (cond 
                  ((= KIEUDOITUONG "INSERT") (setq dc (cdr (assoc 10 doituong))))
                  ((/= KIEUDOITUONG "INSERT") (chondiemchuandoituong))
                  );ketthuccondxemblock
                );kethucdsl1
           ((/= dsl 1) (chondiemchuandoituong))
           );ketthuccondnho

);ketthucsetqdsl
);ketthuccondtong  
 (princ)
)
;;;;;;;;;;;;;;;;;
(Defun chondiemchuandoituong ()
(setq dc (getpoint "\nChon diem goc: "))
(cond 
     ((= dc nil) (princ "\nChua chon duoc diem goc:") (chondiemchuandoituong))
     ((/= ss nil))) 
 (princ)
)
;;;;;;;;;;;;;;;;;
(Defun choncuver ()

(setq ddd (entsel "\nChon duong dan:"))
(while
(or
(null ddd)
(or (= "TEXT" (cdr (assoc 0 (entget (car ddd))))) (= "MTEXT" (cdr (assoc 0 (entget (car ddd))))) (= "HATCH" (cdr (assoc 0 (entget (car ddd))))) (= "INSERT" (cdr (assoc 0 (entget (car ddd))))) (= "REGION" (cdr (assoc 0 (entget (car ddd))))) (= "DIMENSION" (cdr (assoc 0 (entget (car ddd)))))
)
)
(setq ddd (entsel "\nDoi tuong khong the lam duong dan! Chon lai"))
)

(setq chondd (car ddd))
(setq luubatdiem (getvar "osmode"))
 (setvar "osmode" 0)
(setq chieudaicuver (vlax-curve-getDistAtParam chondd (vlax-curve-getEndParam chondd)))
(setq diemdau (vlax-curve-getPointAtDist chondd 0))
(setvar "osmode"luubatdiem)
 (princ)
)
;;;;;;;;;;;;;;;;;
(Defun hoikieurai ()
 (setq krai (strcase (getstring "\nKieu rai theo: So luong/<Khoang cach>")))
(Cond
((= krai "S") (raisoluong))
((/= krai "S")(raikhoangcach))
) 
 (princ)
)
;;;;;;;;;;;;;;
(Defun raikhoangcach ()
  (setq chieudaidoan (GETDIST "\nKhoang cach doan chia: "))
  (setq sol (+ (/ chieudaicuver chieudaidoan) 1))
   (setq sl (fix sol))
   (setq sl (fix sl))
(thuchienrai)
 (princ)
)
;;;;;;;;;;;;;;
(Defun raisoluong ()
(setq slc (getreal "\nChia duong dan thanh may lan:"))
(setq chieudaidoan (/ chieudaicuver slc))
(setq sl (fix (+ 1 slc)))
(thuchienrai)
 (princ)
)
;;;;;;;;;;;;;;
(Defun thuchienrai (/ quaykhong)

 (setq quaykhong (strcase (getstring "\nCo quay doi tuong vuong goc voi duong dan khong: Khong/<Co>")))
(Cond
((= quaykhong "K") (setq copygiua copykoquay))
((/= quaykhong "K")(setq copygiua copyquay))
) 

(setq index -1)

 (repeat sl
(setq index (1+ index))
(setq d2 (* chieudaidoan index))
(setq luubatdiem (getvar "osmode"))
 (setvar "osmode" 0)
(setq p2 (vlax-curve-getPointAtDist chondd d2))
(setvar "osmode"luubatdiem)
(copygiua)
 )
 (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun copycuoiquay()
(setq luubatdiem (getvar "osmode"))
 (setvar "osmode" 0)
(setq d5 (- chieudaicuver 0.001))
(setq p5 (vlax-curve-getPointAtDist chondd d5))
(setq L 0)
(setq M (sslength ss))
(while (< L M)
  (setq DT (ssname ss L))
  (command ".copy" DT "" dc p2)
  (command ".rotate" "last" "" p2 p5)
  (command ".rotate" "last" "" p2 180)
  (setq L (1+ L))
)
(setvar "osmode"luubatdiem)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun COPYQUAY(/ p3)
(setq luubatdiem (getvar "osmode"))
 (setvar "osmode" 0)
(setq d3 (+ (* chieudaidoan index) 0.001))
(setq p3 (vlax-curve-getPointAtDist chondd d3))
(setvar "osmode"luubatdiem)
(Cond
((= p3 nil) (copycuoiquay))
((/= p3 nil) 
(setq L 0)
(setq M (sslength ss))
(setq luubatdiem (getvar "osmode"))
 (setvar "osmode" 0)
(while (< L M)
  (setq DT (ssname ss L))
  (command ".copy" DT "" dc p2)
  (command ".rotate" "last" "" p2 p3)
  (setq L (1+ L))
)
(setvar "osmode"luubatdiem)
)
) 


(princ)
)

 

P/S : sửa lần 2, bác Duy cho code vào thẻ code nhé :angry:

 

Mình đã cho vào thẻ code nhưng sao nó vẩn dài thòng thế nhỉ. Mình đã xem mấy bài bên viết lisp theo yêu cầu nhấn nào trả lời để xem thì thấy cú pháp thẻ codecủa mình đúng nhưng sao không hiển thị được nhỉ!

  • 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

e là e rất thích những lips rải với xoay đối tượng như thế này, nhưng e ko sao dùng được cho đối tượng là block, có ai bị lỗi giống như em ko ạ, ko dùng được lips này, e cứ phải ngồi xoay từng cái một, huhu

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

e là e rất thích những lips rải với xoay đối tượng như thế này, nhưng e ko sao dùng được cho đối tượng là block, có ai bị lỗi giống như em ko ạ, ko dùng được lips này, e cứ phải ngồi xoay từng cái một, huhu

-Mình đến khóc thét lên chứ không hu hu nổi nửa khi nghe bạn ngồi "xoay từng cái một".

-Nếu với đối tượng lẻ mà nó được thì về nguyên tắc block nó cũng được <_< . Bạn gửi cái file bạn rải cho mình dòm ngó cái block của bạn tí hen!

  • 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

Em giới thiệu thêm lisp rải đối tượng của alanjt nữa, code cũng ngắn ngắn, nhưng có hàm con mót được ^^, bác Duy thử dùng và hoàn thiện tiếp cái RDT nhé. Bravo

(defun c:CAC (/) (c:CopyAlongCurve))
(defun c:CopyAlongCurve (/ *error* AT:Entsel AT:DrawX AT:ClosestEndPoint _angle _cmr _Points _PLine
                        #SS #Pnt #Ent #PLine #Obj #Num #Seg #Add #Dist #Val #Cnt #TempPnt #TempObj
                        #Temp #List #Rot #Ang
                       )


;;; error handler
 (defun *error* (#Message)
   (redraw)
   (and #PLine
        (if (vl-catch-all-error-p (vl-catch-all-apply (function vla-delete) (list #PLine)))
          (alert "Temporary LWPolyline could not be deleted!")
        ) ;_ if
   ) ;_ and
   (and *AcadDoc* (vla-endundomark *AcadDoc*))
   (and #Message
        (not (wcmatch (strcase #Message) "*BREAK*,*CANCEL*,*QUIT*"))
        (princ (strcat "\nError: " #Message))
   ) ;_ and
 ) ;_ defun




;;; Entsel or NEntsel with options
;;; #Nested - Entsel or Nentsel (T for Nentsel, nil for Entsel)
;;; #Message - Selection message (if nil, "\nSelect object: " is used)
;;; #FilterList - DXF ssget style filtering (nil if not required)
;;;               "V" as first item in list to convert object to VLA-OBJECT (must be in list if no DXF filtering)
;;;               "L" as first item in list to ignore locked layers (must be in list if no DXF filtering)
;;; #Keywords - Keywords to match instead of object selection (nil if not required)
;;; Example: (AT:Entsel nil "\nSelect MText not on 0 layer [settings]: " '("LV" (0 . "MTEXT")(8 . "~0")) "Settings")
;;; Example: (AT:Entsel T "\nSelect object [settings]: " '("LV") "Settings")
;;; Alan J. Thompson, 04.16.09
;;; Updated: Alan J. Thompson, 06.04.09 (changed filter coding to work as ssget style dxf filtering)
;;; Updated: Alan J. Thompson, 09.07.09 (added option to ignore locked layers and convert object to VLA-OBJECT
;;; Updated: Alan J. Thompson, 09.18.09 (fixed 'missed pick' alert)
 (defun AT:Entsel (#Nested #Message #FilterList #Keywords / #Count #Message #Choice #Ent
                   #VLA&Locked #FilterList
                  )
   (vl-load-com)
   (setvar "errno" 0)
   (setq #Count 0)
   ;; fix message
   (or #Message (setq #Message "\nSelect object: "))
   ;; set entsel/nentsel
   (if #Nested
     (setq #Choice nentsel)
     (setq #Choice entsel)
   ) ;_ if
   ;; check if option to convert to vla-object or ignore locked layers in #FilterList variable
   (and (vl-consp #FilterList)
        (eq (type (car #FilterList)) 'STR)
        (setq #VLA&Locked (car #FilterList)
              #FilterList (cdr #FilterList)
        ) ;_ setq
   ) ;_ and
   ;; select object
   (while (and (not #Ent) (/= (getvar "errno") 52))
     ;; if keywords
     (and #Keywords (initget #Keywords))
     (cond
       ((setq #Ent (#Choice #Message))
        ;; if ignore locked layers
        (and #VLA&Locked
             (vl-consp #Ent)
             (wcmatch (strcase #VLA&Locked) "*L*")
             (not
               (zerop
                 (cdr (assoc 70
                             (entget (tblobjname
                                       "layer"
                                       (cdr (assoc 8 (entget (car #Ent))))
                                     ) ;_ tblobjname
                             ) ;_ entget
                      ) ;_ assoc
                 ) ;_ cdr
               ) ;_ zerop
             ) ;_ not
             (setq #Ent nil
                   #Flag T
             ) ;_ setq
        ) ;_ and
        ;; #FilterList check
        (if (and #FilterList (vl-consp #Ent))
          ;; process filtering from #FilterList
          (or
            (not
              (member
                nil
                (mapcar '(lambda (x)
                           (wcmatch
                             (strcase
                               (vl-princ-to-string
                                 (cdr (assoc (car x) (entget (car #Ent))))
                               ) ;_ vl-princ-to-string
                             ) ;_ strcase
                             (strcase (vl-princ-to-string (cdr x)))
                           ) ;_ wcmatch
                         ) ;_ lambda
                        #FilterList
                ) ;_ mapcar
              ) ;_ member
            ) ;_ not
            (setq #Ent nil
                  #Flag T
            ) ;_ setq
          ) ;_ or
        ) ;_ if
       )
     ) ;_ cond
     (and (or (= (getvar "errno") 7) #Flag)
          (/= (getvar "errno") 52)
          (not #Ent)
          (setq #Count (1+ #Count))
          (prompt (strcat "\nNope, keep trying!  "
                          (itoa #Count)
                          " missed pick(s)."
                  ) ;_ strcat
          ) ;_ prompt
     ) ;_ and
   ) ;_ while
   (if (and (vl-consp #Ent)
            #VLA&Locked
            (wcmatch (strcase #VLA&Locked) "*V*")
       ) ;_ and
     (vlax-ename->vla-object (car #Ent))
     #Ent
   ) ;_ if
 ) ;_ defun



;;; Draw and "X" vector at specified point
;;; P - Placement point for "X"
;;; C - Color of "X" (must be integer b/w 1 & 255)
;;; Alan J. Thompson, 10.31.09 / 03.26.10
 (defun AT:DrawX (P C / d)
   (if (and (vl-consp P)
            (setq d (* (getvar "VIEWSIZE") 0.02))
       ) ;_ and
     (progn (grvecs (cons C
                          (mapcar
                            (function (lambda (#) (trans (polar P (* # pi) d) 0 1)))
                            '(0.25 1.25 0.75 1.75)
                          ) ;_ mapcar
                    ) ;_ cons
            ) ;_ grvecs
            P
     ) ;_ progn
   ) ;_ if
 ) ;_ defun



;;; Retrieve closest end point on object
;;; #EntPnt - List with object and point
;;; Alan J. Thompson, 11.10.09
 (defun AT:ClosestEndPoint (#EntPnt)
   (if (vl-consp #EntPnt)
     (car (vl-sort
            (list (vlax-curve-getstartpoint (car #EntPnt))
                  (vlax-curve-getendpoint (car #EntPnt))
            ) ;_ list
            (function
              (lambda (a B)
                (< (distance (trans (cadr #EntPnt) 1 0) a) (distance (trans (cadr #EntPnt) 1 0) B))
              ) ;_ lambda
            ) ;_ function
          ) ;_ vl-sort
     ) ;_ car
   ) ;_ if
 ) ;_ defun



 (setq _angle (lambda (P O / _pt c p2)
                (setq _pt (lambda (s)
                            (vlax-curve-getPointAtDist O (s (vlax-curve-getDistAtPoint O P) 0.00001))
                          ) ;_ lambda
                ) ;_ setq
                (if (and (vl-consp P)
                         (or (setq p2 (_pt +)) (setq p2 (setq c (_pt -))))
                    ) ;_ and
                  (if c
                    (+ pi (angle P p2))
                    (angle P p2)
                  ) ;_ if
                ) ;_ if
              ) ;_ lambda
 ) ;_ setq


 (setq _cmr (lambda (o p2)
              (vla-move (setq #TempObj (vla-copy o)) #Pnt (setq #TempPnt (vlax-3D-point p2)))
              (setq #List (cons (cons #TempObj #TempPnt) #List))
              (and (eq *CAC:Align* "Yes") (vla-rotate #TempObj #TempPnt (_angle p2 #Obj)))
              #TempObj
            ) ;_ lambda
 ) ;_ setq



 (setq _Points (lambda (/ l p)
                 (if (eq "Points" #Ent)
                   (if (car (setq l (list (getpoint "\nSpecify first point: "))))
                     (progn
                       (while (setq p (getpoint (car l) "\nSpecify next point: "))
                         (grdraw (car (setq l (cons p l))) (cadr l) 3 -1)
                       ) ;_ while
                       (and (> (length l) 1) (_PLine l))
                     ) ;_ progn
                   ) ;_ if
                   T
                 ) ;_ if
               ) ;_ lambda
 ) ;_ setq



 (setq _PLine (lambda (l / p)
                (if (vl-consp l)
                  (progn
                    (setq p    (entmakex (append (list '(0 . "LWPOLYLINE")
                                                       '(100 . "AcDbEntity")
                                                       '(100 . "AcDbPolyline")
                                                       '(8 . "0")
                                                       '(62 . 3)
                                                       (cons 90 (length l))
                                                 ) ;_ list
                                                 (mapcar (function (lambda (x) (cons 10 (trans x 1 0)))) l)
                                         ) ;_ append
                               ) ;_ entmakex
                          #Ent (list p (last l))
                    ) ;_ setq
                    (not (vla-highlight (setq #PLine (vlax-ename->vla-object p)) :vlax-true))
                  ) ;_ progn
                ) ;_ if
              ) ;_ lambda
 ) ;_ setq






;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; MAIN ROUTINE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (vl-load-com)

 (or *CAC:Option* (setq *CAC:Option* "Divide"))
 (or *CAC:Align* (setq *CAC:Align* "No"))

 (or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
 (vla-startundomark *AcadDoc*)
 (redraw)

 (initget 0 "Divide dYnamic Measure")
 (cond
   ((and (setq *CAC:Option*
                (cond ((getkword
                         (strcat "\nCopy Along Curve\nSpecify copy option [Divide/dYnamic/Measure] <"
                                 *CAC:Option*
                                 ">: "
                         ) ;_ strcat
                       ) ;_ getkword
                      )
                      (*CAC:Option*)
                ) ;_ cond
         ) ;_ setq
         (princ (strcat "\nSelect object(s) to " *CAC:Option* " along curve: "))
         (setq #SS (ssget "_:L"))
         (setq #Pnt (getpoint "\nSpecify base point: "))
         (setq #Ent (AT:Entsel nil
                               "\nSelect curve or specify points [Points]: "
                               '((0 . "ARC,CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE"))
                               "Points"
                    ) ;_ AT:Entsel
         ) ;_ setq
         (_Points)
         (vl-consp #Ent)
         (setq #Obj (vlax-ename->vla-object (car #Ent)))
    ) ;_ and
    (setq #Len  (vlax-curve-GetDistAtParam #Obj (vlax-curve-GetEndParam #Obj))
          #Pnt  (vlax-3d-point (trans #Pnt 1 0))
          #Dist 0.
    ) ;_ setq
    (if (equal (AT:DrawX (AT:ClosestEndPoint #Ent) 1) (vlax-curve-getStartPoint #Obj))
      (setq #Val 0.)
      (setq #Val #Len)
    ) ;_ if
    (not (initget 0 "Yes No"))
    (setq *CAC:Align*
           (cond
             ((getkword (strcat "\nAlign object(s) along curve? [Yes/No] <" *CAC:Align* ">: ")))
             (*CAC:Align*)
           ) ;_ cond
    ) ;_ setq
    (initget 6)
    (cond

      ;; Divide
      ((and (eq *CAC:Option* "Divide") (setq #Num (getint "\nSpecify number of objects: ")))
       (setq #Cnt 0)
       (if (or (vl-position (vla-get-objectname #Obj) '("AcDbCircle" "AcDbEllipse"))
               (and (eq (vla-get-objectname #Obj) "AcDbPolyline")
                    (eq (vla-get-closed #Obj) :vlax-true)
               ) ;_ and
           ) ;_ or
         (setq #Add 0)
         (setq #Add 1)
       ) ;_ if
       (while (and (<= #Dist (- #Len (/ #Len (+ #Add #Num)))) (> #Num #Cnt))
         (setq #Dist (+ #Dist (/ #Len (+ #Add #Num)))
               #Cnt  (1+ #Cnt)
         ) ;_ setq
         (vlax-for x (setq #SS (vla-get-activeselectionset *AcadDoc*))
           (_cmr x (vlax-curve-getpointatdist #Obj #Dist))
         ) ;_ vlax-for
       ) ;_ while
      )

      ;; Measure
      ((and (eq *CAC:Option* "Measure") (setq #Seg (getdist "\nSpecify length of segment: ")))
       (while (<= #Dist (- #Len #Seg))
         (setq #Dist (+ #Dist #Seg))
         (vlax-for x (setq #SS (vla-get-activeselectionset *AcadDoc*))
           (_cmr x (vlax-curve-getpointatdist #Obj (abs (- #Val #Dist))))
         ) ;_ vlax-for
       ) ;_ while
      )

      ;; Dynamic
      ((and (eq *CAC:Option* "dYnamic") (setq #Seg 0.))
       (while (and (numberp #Seg) (<= #Dist #Len))
         (princ "\n*")
         (initget 6 "Exit X")
         (and
           (setq #Seg (cond ((getdist (strcat "\nTotal Dist: "
                                              (rtos #Len)
                                              " - Length left: "
                                              (rtos (- #Len #Dist))
                                              "\nDistance to copy [Exit] <"
                                              (rtos #Seg)
                                              ">: "
                                      ) ;_ strcat
                             ) ;_ getdist
                            )
                            (#Seg)
                      ) ;_ cond
           ) ;_ setq
           (numberp #Seg)
           (not (zerop #Seg))
           (setq #Temp (vlax-curve-getpointatdist #Obj (abs (- #Val (setq #Dist (+ #Dist #Seg))))))
           (vlax-for x (setq #SS (vla-get-activeselectionset *AcadDoc*)) (_cmr x #Temp))
         ) ;_ and
       ) ;_ while
      )

    ) ;_ cond

    ;; additional rotation for objects: 90°, 180°, 270°
    (and
      #List
      (eq *CAC:Align* "Yes")
      (while
        (and (not (initget "Yes No 1 2 3"))
             (setq #Rot (getkword "\nAdditional rotation? 1=90°, 2=180°, 3=270° [1/2/3/No] <No>: "))
             (not (eq #Rot "No"))
        ) ;_ and
         (if (cond ((eq #Rot "1") (setq #Ang (* pi 0.5)))
                   ((vl-position #Rot '("2" "Yes")) (setq #Ang pi))
                   ((eq #Rot "3") (setq #Ang (* pi 1.5)))
             ) ;_ cond
           (foreach x #List (vla-rotate (car x) (cdr x) #Ang))
         ) ;_ if
      ) ;_ while
    ) ;_ and

    (vl-catch-all-apply 'vla-delete (list #SS))
   )
 ) ;_ cond
 (*error* nil)
 (princ)
) ;_ defun

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

-Mình đến khóc thét lên chứ không hu hu nổi nửa khi nghe bạn ngồi "xoay từng cái một".

-Nếu với đối tượng lẻ mà nó được thì về nguyên tắc block nó cũng được <_< . Bạn gửi cái file bạn rải cho mình dòm ngó cái block của bạn tí hen!

 

dạ, mấy đại ca e xoay từng cái một từ lúc biết vẽ cad đến bây giờ ý anh ạ, mà chỉ khoảng mấy trăm cái mỗi lần làm thôi ạ?

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

dạ, mấy đại ca e xoay từng cái một từ lúc biết vẽ cad đến bây giờ ý anh ạ, mà chỉ khoảng mấy trăm cái mỗi lần làm thôi ạ?

Bảo gửi file cho dòm ngó block tí thì không gửi mà giọng văn nghe chừng dỗi rồi :blush:

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

×