[ Yêu cầu ] Nhờ viết lisp vẽ đường thẳng vuông góc với Pline

[hieuhx68 1]

Lisp trên là theo yêu cầu của hoacomay70 cho nên nó vẽ (chứ không phải copy) đường vuông góc, do đó chỉ chọn 1 line để lấy điểm đầu, và nhập số cọc rải để hạn chế số lần rải, nếu không sẽ rải tới cuối đường pline.

Còn nếu bạn chọn nhiều đt tức là bạn muốn copy, rải và xoay theo hướng vuông góc với pline thì dùng cái lisp dưới đây.

 

(defun c:test(/ cd pl obj dd dait cl sl n os ki )  
  (defun thgoc (ent pt / param)
    (if (setq param (vlax-curve-getParamAtPoint ent pt))
      (- (angle '(0 0 0) (vlax-curve-getFirstDeriv ent param)) (/ pi 2))
      nil)
  )
  
  (setq pl (car (entsel "\nChon Polyline:")))
  (prompt "\nChon doi tuong can rai:")
  (setq ss (ssget)
        dd (getpoint "\nDiem bat dau rai (nam tren Polyline) :")
        dc (getpoint "\nDiem cuoi cung rai (nam tren Polyline) :")
        cd (getreal "\nNhap buoc rai:")
sl (fix (/ (- (vlax-curve-getDistAtPoint pl dc) (vlax-curve-getDistAtPoint pl dd)) cd))
        os (getvar "OSMODE"))  
 
 (setvar "OSMODE" 0)
 (repeat sl
   (setq el (entlast)
ang (thgoc pl dd))
   (command "copy" ss "" dd (setq dd1 (vlax-curve-getPointAtDist pl (+ cd (vlax-curve-getDistAtPoint pl dd)))))
   (setq ss (ssadd)
dd dd1
ang1 (thgoc pl dd))
   (while (setq en (entnext el))
      (ssadd en ss)
      (setq el en))
   (command "rotate" ss "" dd "r" dd (polar dd ang 1) (polar dd ang1 1))
 )  
 (setvar "OSMODE" os)
 (princ)
)

Lips gốc thì em dùng được, lips này em dùng ko thấy hiện kết quả, bác xem lại giúp em với ạ.

[Tot77 508]

Không thấy hiện kết quả là sao? có báo lỗi gì không?

[hieuhx68 1]

Không thấy hiện kết quả là sao? có báo lỗi gì không?

Em sorry bác, do em thao tác sai bác ạ. tại lúc đầu đoạn chọn PL em nhầm. Nhưng cái này bác giúp em tí nữa được không? bác cho em thêm lựa chọn 1 là cho nhập số đoạn rải; 2 là khoảng cách rải. chứ có mình số đoạn muốn rải nhiều lúc cũng khó ạ. Thanks bác nhiều

 

PS: Em định lập topic mới nhưng nhân tiện bác ở đây em nhờ bác viết giúp em luôn 1 cho em 1lips cho phép chọn nhiều đường line và đường PL có sẵn move vào vuông góc với đường line hay Pline có sẵn. thanks bác một nghiền lần nữa ạ.

[Tot77 508]

Lisp chỉ yêu cầu nhập khoảng cách rải chứ làm gì có số đoạn rải? Khoảng cách rải đương nhiên phải có rồi, ý bạn là muốn thêm số đoạn rải phải không?

[hieuhx68 1]

Lisp chỉ yêu cầu nhập khoảng cách rải chứ làm gì có số đoạn rải? Khoảng cách rải đương nhiên phải có rồi, ý bạn là muốn thêm số đoạn rải phải không?

Dạ vâng. Ý em bjo là thế này ạ. Một là lips cho chọn số khoảng rải, 2 là lips cho chọn khoảng cách rải. Ví dụ có đoạn thẳng 10m em muốn rải 3 đoạn cũng được mà em nhập mỗi khoảng rải 3m thì kết quả đều dải cho em 3 đối tượng. Và bác thêm cho lựa chọn thêm đối tượng từ text và block nữa thì sẽ hoàn hảo ạ.

[Tot77 508]

Bạn thử cái dưới đây, nếu không muốn nhập khoảng cách rải thì enter để nhập số khoảng rải.

Bạn có thể chọn bất cứ đối tượng nào kể cả text, block... Nhưng chú ý đến góc ban đầu của nó với điểm đầu, các bản sao kế tiếp cũng có góc tương tự so với điểm copy.

 

(defun c:test(/ pl ss dd dc cd tm sl el en ang dd1 ang1 os)
  (defun thgoc (ent pt / param)
    (if (setq param (vlax-curve-getParamAtPoint ent pt))
      (- (angle '(0 0 0) (vlax-curve-getFirstDeriv ent param)) (/ pi 2))
      nil)
  )
  
  (setq pl (car (entsel "\nChon Polyline:")))
  (prompt "\nChon doi tuong can rai:")
  (setq ss (ssget)
        dd (getpoint "\nDiem bat dau rai (nam tren Polyline) :")
        dc (getpoint "\nDiem cuoi cung rai (nam tren Polyline) :")
        cd (getreal "\nNhap buoc rai <Enter neu nhap so khoang rai>:")
tm (- (vlax-curve-getDistAtPoint pl dc) (vlax-curve-getDistAtPoint pl dd)))
  (if (not cd)
    (setq sl (getint "\nNhap so khoang rai:")
 cd (/ tm sl))
    (setq sl (fix (/ tm cd))))
 
 (setq os (getvar "OSMODE"))  
 (setvar "OSMODE" 0)
 (repeat sl
   (setq el (entlast)
ang (thgoc pl dd))
   (command "copy" ss "" dd (setq dd1 (vlax-curve-getPointAtDist pl (+ cd (vlax-curve-getDistAtPoint pl dd)))))
   (setq ss (ssadd)
dd dd1
ang1 (thgoc pl dd))
   (while (setq en (entnext el))
      (ssadd en ss)
      (setq el en))
   (command "rotate" ss "" dd "r" dd (polar dd ang 1) (polar dd ang1 1))
 )  
 (setvar "OSMODE" os)
 (princ)
)

[hieuhx68 1]

Bạn thử cái dưới đây, nếu không muốn nhập khoảng cách rải thì enter để nhập số khoảng rải.

Bạn có thể chọn bất cứ đối tượng nào kể cả text, block... Nhưng chú ý đến góc ban đầu của nó với điểm đầu, các bản sao kế tiếp cũng có góc tương tự so với điểm copy.

 

(defun c:test(/ pl ss dd dc cd tm sl el en ang dd1 ang1 os)
  (defun thgoc (ent pt / param)
    (if (setq param (vlax-curve-getParamAtPoint ent pt))
      (- (angle '(0 0 0) (vlax-curve-getFirstDeriv ent param)) (/ pi 2))
      nil)
  )
  
  (setq pl (car (entsel "\nChon Polyline:")))
  (prompt "\nChon doi tuong can rai:")
  (setq ss (ssget)
        dd (getpoint "\nDiem bat dau rai (nam tren Polyline) :")
        dc (getpoint "\nDiem cuoi cung rai (nam tren Polyline) :")
        cd (getreal "\nNhap buoc rai <Enter neu nhap so khoang rai>:")
tm (- (vlax-curve-getDistAtPoint pl dc) (vlax-curve-getDistAtPoint pl dd)))
  (if (not cd)
    (setq sl (getint "\nNhap so khoang rai:")
 cd (/ tm sl))
    (setq sl (fix (/ tm cd))))
 
 (setq os (getvar "OSMODE"))  
 (setvar "OSMODE" 0)
 (repeat sl
   (setq el (entlast)
ang (thgoc pl dd))
   (command "copy" ss "" dd (setq dd1 (vlax-curve-getPointAtDist pl (+ cd (vlax-curve-getDistAtPoint pl dd)))))
   (setq ss (ssadd)
dd dd1
ang1 (thgoc pl dd))
   (while (setq en (entnext el))
      (ssadd en ss)
      (setq el en))
   (command "rotate" ss "" dd "r" dd (polar dd ang 1) (polar dd ang1 1))
 )  
 (setvar "OSMODE" os)
 (princ)
)

Bác ơi. em chỉ có thể nói một câu nữa. Là quá tuyệt vời bác ạ. Em nghĩ không thể làm tốt hơn được nữa. Em chân thành cảm ơn bác.

 

Bác ơi. em chỉ có thể nói một câu nữa. Là quá tuyệt vời bác ạ. Em nghĩ không thể làm tốt hơn được nữa. Em chân thành cảm ơn bác.

 

PS: bác ơi bác giúp em thêm lựa chọn cho phép rải cả block vào lips ##66 của bác Pham quoc Duy được không ạ? em chờ đợi

mà ko thấy mọi người trả lời.

http://www.cadviet.com/forum/topic/42771-da-xong-lisp-rai-doi-tuong-theo-doong-dan/page-4

[Tot77 508]

Lisp của bác Duy dài quá, cụ thể là bạn muốn nhờ tôi sửa lệnh nào, vì trong đó có 4,5 lệnh khác nhau và hơn 20 hàm!!

[hieuhx68 1]

Lisp của bác Duy dài quá, cụ thể là bạn muốn nhờ tôi sửa lệnh nào, vì trong đó có 4,5 lệnh khác nhau và hơn 20 hàm!!

Bác ơi. ở lips trên em chỉ mong bác sửa giúp em là có thể chọn được cả block để rải ạ, vì hiện giờ ko rải được block chỉ rải được point, line, pline. Em chân thành cảm ơn.

[Tot77 508]

Tôi chưa đọc hết lisp cuả bác Duy, mà cũng chưa hiểu ý của bác ấy lắm. Nhưng nếu rải block theo đường dẫn thì có thể dùng các lệnh measure hay divide của cad với các thông số nhập vào (để xoay block hay không) được mà, cần gì xài lisp làm chi?

[hieuhx68 1]

Tôi chưa đọc hết lisp cuả bác Duy, mà cũng chưa hiểu ý của bác ấy lắm. Nhưng nếu rải block theo đường dẫn thì có thể dùng các lệnh measure hay divide của cad với các thông số nhập vào (để xoay block hay không) được mà, cần gì xài lisp làm chi?

 

Tôi chưa đọc hết lisp cuả bác Duy, mà cũng chưa hiểu ý của bác ấy lắm. Nhưng nếu rải block theo đường dẫn thì có thể dùng các lệnh measure hay divide của cad với các thông số nhập vào (để xoay block hay không) được mà, cần gì xài lisp làm chi?

Hic. Em dùng lips rồi tạo phím tắt thao tác nhanh hơn, và hơn nữa lips kia dùng hay quá, chỉ có ko chọn được block thôi ạ. Bác giúp em được thì tốt quá ạ, chỉ thêm chọn được block nữa là qua tuyệt ak

[Tot77 508]

Bác ơi. em chỉ có thể nói một câu nữa. Là quá tuyệt vời bác ạ. Em nghĩ không thể làm tốt hơn được nữa. Em chân thành cảm ơn bác.

 

PS: bác ơi bác giúp em thêm lựa chọn cho phép rải cả block vào lips ##66 của bác Pham quoc Duy được không ạ? em chờ đợi

mà ko thấy mọi người trả lời.

http://www.cadviet.com/forum/topic/42771-da-xong-lisp-rai-doi-tuong-theo-doong-dan/page-4

Hôm nay test lại cái lisp ở #31 thì có vấn đề nảy sinh là nếu rải từ cuối pline ngược lên đầu pline sẽ bị lỗi hoặc không làm gì cả. Cho nên sửa lại như dưới đây (tên lệnh rvx).

Đồng thời hôm qua có thấy bác Duy xuất hiện, có nhờ bác ấy sửa. Trong lúc chờ đợi thì bạn xài tạm cái lisp dưới đây (tên lệnh tmp)

 

(defun c:rvx(/ pl ss dd dc cd tm sl el en ang dd1 ang1 os)
(defun thgoc (ent pt / param)
(if (setq param (vlax-curve-getParamAtPoint ent pt))
(- (angle '(0 0 0) (vlax-curve-getFirstDeriv ent param)) (/ pi 2))
nil)
)
(setq pl (car (entsel "\nChon Polyline:")))
(prompt "\nChon doi tuong can rai:")
(setq ss (ssget)
dd (getpoint "\nDiem bat dau rai (nam tren Polyline) :")
dc (getpoint "\nDiem cuoi cung rai (nam tren Polyline) :")
cd (getreal "\nNhap buoc rai <Enter neu nhap so khoang rai>:")
tm (- (vlax-curve-getDistAtPoint pl dc) (vlax-curve-getDistAtPoint pl dd)))
(if (< tm 0) (setq lenh '-) (setq lenh '+))
(if (not cd)
(setq sl (getint "\nNhap so khoang rai:")
cd (/ (abs tm) sl))
(setq sl (fix (/ (abs tm) cd))))
 
(setq os (getvar "OSMODE"))  
(setvar "OSMODE" 0)
(repeat sl
(setq el (entlast)
ang (thgoc pl dd))
(command "copy" ss "" dd (setq dd1 (vlax-curve-getPointAtDist pl ((eval lenh) (vlax-curve-getDistAtPoint pl dd) cd))))
(setq ss (ssadd)
dd dd1
ang1 (thgoc pl dd))
(while (setq en (entnext el))
(ssadd en ss)
(setq el en))
(command "rotate" ss "" dd "r" dd (polar dd ang 1) (polar dd ang1 1))
)  
(setvar "OSMODE" os)
(princ)
)
 
(defun c:tmp(/)
(defun ttuyen(ent pt / param) 
(if (setq param (vlax-curve-getParamAtPoint ent pt))
(angle '(0 0 0) (vlax-curve-getFirstDeriv ent param))
nil
)
)
(setq pl (car (entsel "\nChon duong dan:"))
en (car (entsel "\nChon block can rai:"))
tt10 (cdr (assoc 10 (entget en)))
ang (cdr (assoc 50 (entget en)))
dd (getpoint "\nDiem bat dau rai (nam tren duong dan) :")
dc (getpoint "\nDiem cuoi cung rai (nam tren duong dan) :")
cd (getreal "\nNhap buoc rai <Enter neu nhap so khoang rai>:")
tm (- (vlax-curve-getDistAtPoint pl dc) (vlax-curve-getDistAtPoint pl dd)))
(if (< tm 0) (setq lenh '-) (setq lenh '+))
(if (not cd)
(setq sl (getint "\nNhap so khoang rai:")
cd (/ (abs tm) sl))
(setq sl (fix (/ (abs tm) cd))))
 
(setq os (getvar "OSMODE")
ck (getkword "\nCo xoay block theo duong dan khong? <Enter = co / K= khong> :"))
 
(setvar "OSMODE" 0)
(command "copy" en "" tt10 dd) (setq tm (entlast) n 0)
(if (not ck) (command "rotate" tm "" dd "r" dd (polar dd ang 1) (polar dd (ttuyen pl dd) 1)))
(repeat sl    
(command "copy" tm "" dd (setq dd1 (vlax-curve-getPointAtDist pl ((eval lenh) (vlax-curve-getDistAtPoint pl dd) (* (setq n (1+ n)) cd)))))
(if (not ck) (command "rotate" (entlast) "" dd1 "r" dd1 (polar dd1 (cdr (assoc 50 (entget (entlast)))) 1) (polar dd1 (ttuyen pl dd1) 1)))
)
(setvar "OSMODE" os)
(princ)
)
 

[hieuhx68 1]

 

Hôm nay test lại cái lisp ở #31 thì có vấn đề nảy sinh là nếu rải từ cuối pline ngược lên đầu pline sẽ bị lỗi hoặc không làm gì cả. Cho nên sửa lại như dưới đây (tên lệnh rvx).

Đồng thời hôm qua có thấy bác Duy xuất hiện, có nhờ bác ấy sửa. Trong lúc chờ đợi thì bạn xài tạm cái lisp dưới đây (tên lệnh tmp)

 

(defun c:rvx(/ pl ss dd dc cd tm sl el en ang dd1 ang1 os)
(defun thgoc (ent pt / param)
(if (setq param (vlax-curve-getParamAtPoint ent pt))
(- (angle '(0 0 0) (vlax-curve-getFirstDeriv ent param)) (/ pi 2))
nil)
)
(setq pl (car (entsel "\nChon Polyline:")))
(prompt "\nChon doi tuong can rai:")
(setq ss (ssget)
dd (getpoint "\nDiem bat dau rai (nam tren Polyline) :")
dc (getpoint "\nDiem cuoi cung rai (nam tren Polyline) :")
cd (getreal "\nNhap buoc rai <Enter neu nhap so khoang rai>:")
tm (- (vlax-curve-getDistAtPoint pl dc) (vlax-curve-getDistAtPoint pl dd)))
(if (< tm 0) (setq lenh '-) (setq lenh '+))
(if (not cd)
(setq sl (getint "\nNhap so khoang rai:")
cd (/ (abs tm) sl))
(setq sl (fix (/ (abs tm) cd))))
 
(setq os (getvar "OSMODE"))  
(setvar "OSMODE" 0)
(repeat sl
(setq el (entlast)
ang (thgoc pl dd))
(command "copy" ss "" dd (setq dd1 (vlax-curve-getPointAtDist pl ((eval lenh) (vlax-curve-getDistAtPoint pl dd) cd))))
(setq ss (ssadd)
dd dd1
ang1 (thgoc pl dd))
(while (setq en (entnext el))
(ssadd en ss)
(setq el en))
(command "rotate" ss "" dd "r" dd (polar dd ang 1) (polar dd ang1 1))
)  
(setvar "OSMODE" os)
(princ)
)
 
(defun c:tmp(/)
(defun ttuyen(ent pt / param) 
(if (setq param (vlax-curve-getParamAtPoint ent pt))
(angle '(0 0 0) (vlax-curve-getFirstDeriv ent param))
nil
)
)
(setq pl (car (entsel "\nChon duong dan:"))
en (car (entsel "\nChon block can rai:"))
tt10 (cdr (assoc 10 (entget en)))
ang (cdr (assoc 50 (entget en)))
dd (getpoint "\nDiem bat dau rai (nam tren duong dan) :")
dc (getpoint "\nDiem cuoi cung rai (nam tren duong dan) :")
cd (getreal "\nNhap buoc rai <Enter neu nhap so khoang rai>:")
tm (- (vlax-curve-getDistAtPoint pl dc) (vlax-curve-getDistAtPoint pl dd)))
(if (< tm 0) (setq lenh '-) (setq lenh '+))
(if (not cd)
(setq sl (getint "\nNhap so khoang rai:")
cd (/ (abs tm) sl))
(setq sl (fix (/ (abs tm) cd))))
 
(setq os (getvar "OSMODE")
ck (getkword "\nCo xoay block theo duong dan khong? <Enter = co / K= khong> :"))
 
(setvar "OSMODE" 0)
(command "copy" en "" tt10 dd) (setq tm (entlast) n 0)
(if (not ck) (command "rotate" tm "" dd "r" dd (polar dd ang 1) (polar dd (ttuyen pl dd) 1)))
(repeat sl    
(command "copy" tm "" dd (setq dd1 (vlax-curve-getPointAtDist pl ((eval lenh) (vlax-curve-getDistAtPoint pl dd) (* (setq n (1+ n)) cd)))))
(if (not ck) (command "rotate" (entlast) "" dd1 "r" dd1 (polar dd1 (cdr (assoc 50 (entget (entlast)))) 1) (polar dd1 (ttuyen pl dd1) 1)))
)
(setvar "OSMODE" os)
(princ)
)
 

Thanks bác nhiều ah. Lips này ngon rồi ạh. Bác mà ko nói em cũng ko rõ là nó bị lộn như vậy. 

[pphung183 428]

Tot77 xem lại lisp rải Block nhé! chỉ có Enter là rải thôi nhé, còn  K là không được. Nên chăng sửa lại chút

 (initget "C K")
(setq os (getvar "OSMODE")
ck (getkword "\nCo xoay block theo duong dan khong [C/K]? <C> :"))
 
(setvar "OSMODE" 0)
(command "copy" en "" tt10 dd) (setq tm (entlast) n 0)
(if (= ck "C") (command "rotate" tm "" dd "r" dd (polar dd ang 1) (polar dd (ttuyen pl dd) 1)))
(repeat sl    
(command "copy" tm "" dd (setq dd1 (vlax-curve-getPointAtDist pl ((eval lenh) (vlax-curve-getDistAtPoint pl dd) (* (setq n (1+ n)) cd)))))
(if (= ck "C") (command "rotate" (entlast) "" dd1 "r" dd1 (polar dd1 (cdr (assoc 50 (entget (entlast)))) 1) (polar dd1 (ttuyen pl dd1) 1)))
)

[Tot77 508]

NGhe cách bạn nói chuyện giống như bạn là giám đốc nói chuyện với nhân viên vậy!!

[pphung183 428]

Mình chỉ là KS già 20 năm nghề XD thôi bạn ah. Lâu lâu ghé CAdViet để học hỏi và góp ý chút ít. Sorry vì góp ý của mình đã làm bạn Tot77 tự ái … :(

[hoacomay70 4]

 

Của bạn đây.

(defun c:test(/ cd pl obj dd dait cl sl n os ki )
  (defun ad(v p1 p2 / a1)
    (abs (- (vlax-curve-getDistAtPoint (setq a1 (vlax-ename->vla-object v)) (vlax-curve-getClosestPointTo a1 p2))
  (vlax-curve-getDistAtPoint a1 (vlax-curve-getClosestPointTo a1 p1)))))
  
  (defun getp(v dis)
     (vlax-curve-getPointAtDist (vlax-ename->vla-object v) dis))
  
  (defun thgoc (ent pt / param obj) 
    (if (setq param (vlax-curve-getParamAtPoint (setq obj (vlax-ename->vla-object ent)) pt))
      (- (angle '(0 0 0) (vlax-curve-getFirstDeriv obj param))  (/ pi 2))
      nil))
  
  (defun daitc(v / obj)    
      (vlax-curve-getDistAtParam (setq obj (vlax-ename->vla-object v)) (vlax-curve-getEndParam obj)))
  
  ;;;
  
  (setq pl (car (entsel "\nChon Polyline:"))
li (car (entsel "\nChon duong thang vuong goc voi Polyline:"))
dail (daitc li)
dd (getpoint "\nDiem cuoi cua Polyline:")
cd (getreal "\nNhap buoc de rai:")
obj (vlax-ename->vla-object pl) 
dg (vlax-curve-getClosestPointTo obj (acet-dxf 10 (entget li)))
sl (getint "\nSo luong coc rai")
ct (vlax-curve-getDistAtPoint obj dg)
n 0
os (getvar "OSMODE"))
  (if (< (distance dd (vlax-curve-getStartPoint obj)) (distance dd (vlax-curve-getEndPoint obj)))
    (setq ki nil) (setq ki t))
  (setvar "OSMODE" 0)
  (repeat sl         
    (command "line"
    (setq dg1 (if ki (getp pl (+ ct (* (setq n (1+ n)) cd)))
     (getp pl (- ct (* (setq n (1+ n)) cd)))))   
    (polar dg1 (thgoc pl dg1) dail) ""))
  (setvar "OSMODE" os)
  (princ)
)

Bác ơi có thể giúp em thêm một chút là không phải chọn điểm đầu hoặc cuối của pline, lisp tu vẽ ra duong vuông goc ve hai phia duoc khong a, em hay lam tren layout, moi lan rai lai phai quay qua model de chon diem dau va diem cuoi kho qua.