Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
41 replies to this topic

#21 nguyentan1991

nguyentan1991

    biết vẽ pline

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

Đã gửi 11 May 2014 - 09:39 AM

sao bác ơi, lệnh này chỉ rải đc đường vuông góc theo 1 bên của SPL thôi à


  • 0

#22 nguyentan1991

nguyentan1991

    biết vẽ pline

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

Đã gửi 11 May 2014 - 09:42 AM

sao bác ơi, lisp chỉ rải đối tượng vuông góc theo 1 bên của PL thôi à


  • 0

#23 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 11 May 2014 - 09:47 AM

Bạn muốn rải 2 bên như thế nào? nếu cần thì đưa file mẫu.


  • 0

#24 hieuhx68

hieuhx68

    biết vẽ circle

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

Đã gửi 10 June 2014 - 09:28 AM

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 lips rất hay nhưng bác giúp em chỉnh sửa lại 1 tí được ko ạ:

- bác cho thêm lựa chọn chọn 1lúc nhiều đối tượng chứ ko chỉ 1 đối tượng

- đến chỗ lựa chọn theo em nghĩ nếu đã có bước rải thì thôi lựa chọn số cọc cần rải. Tuy nhiên em thấy lips bắt nhập cả nếu ko nhập sẽ bị lỗi. Chỗ này bác cho độc lập thì hay vẫn sẽ hỏi như vậy nhưng nếu muốn nhập số cọc cần rải thì ko nhập vào bước cần rải.

 

Thanks bác nhiều ạ.


  • 0

#25 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 10 June 2014 - 02:05 PM

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

  • 1

#26 hieuhx68

hieuhx68

    biết vẽ circle

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

Đã gửi 10 June 2014 - 03:19 PM

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


  • 0

#27 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 10 June 2014 - 03:33 PM

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


  • 1

#28 hieuhx68

hieuhx68

    biết vẽ circle

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

Đã gửi 10 June 2014 - 04:18 PM

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


  • 0

#29 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 10 June 2014 - 04:26 PM

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?


  • 1

#30 hieuhx68

hieuhx68

    biết vẽ circle

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

Đã gửi 10 June 2014 - 04:44 PM

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


  • 0

#31 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 11 June 2014 - 08:28 AM

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

  • 1

#32 hieuhx68

hieuhx68

    biết vẽ circle

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

Đã gửi 11 June 2014 - 02:17 PM

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.c...oong-dan/page-4


  • 0

#33 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 11 June 2014 - 03:57 PM

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!!


  • 2

#34 hieuhx68

hieuhx68

    biết vẽ circle

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

Đã gửi 12 June 2014 - 10:10 AM

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.


  • 0

#35 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 12 June 2014 - 10:53 AM

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?


  • 1

#36 hieuhx68

hieuhx68

    biết vẽ circle

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

Đã gửi 12 June 2014 - 11:06 AM

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


  • 0

#37 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 13 June 2014 - 10:40 AM

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.c...oong-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)
)
 

  • 2

#38 hieuhx68

hieuhx68

    biết vẽ circle

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

Đã gửi 13 June 2014 - 03:25 PM

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. 


  • 0

#39 pphung183

pphung183

    biết dimstyle

  • Members
  • PipPipPipPipPip
  • 384 Bài viết
Điểm đánh giá: 425 (tốt)

Đã gửi 19 June 2014 - 03:51 PM

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

  • 1

#40 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 19 June 2014 - 04:29 PM

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!!


  • 0