Đến nội dung


Hình ảnh
* * * * - 2 Bình chọn

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


  • Please log in to reply
88 replies to this topic

#61 cd2k44

cd2k44

    Edu level: li5

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

Đã gửi 21 June 2011 - 04:08 PM

Vì bạn không đưa file CAD, nên còn có nhiều điều chưa rõ về Format Text của bạn.
vd : Text có định dạng số và chữ lẫn lộn "No : 3" hay "Km +4.530" ...

Truớc mắt bạn dùng thử LISP ghi Text tại giao điểm của các đường thẳng, cung tròn, Pline, đuờng tròn, elíp với đường dẫn.
+ text rải sẽ tăng dần đều với buớc là 1.
+ tuơng tự lệnh Divide của CAD, phụ thuộc vào điểm pick khi chọn đường dẫn, chiều tăng của Text sẽ đi từ điểm đầu tới điểm cuối hoặc nguợc lại.

(defun c:ATIC(/ ent ov pts ss vl h num); ATIC -> Add Text at Intersect with Curve
;; By : Gia_Bach, www.CadViet.com 2011 ;;
(vl-load-com)
(command "undo" "be")
(setq vl '("osmode" "orthomode" "cmdecho") ; Sys Var list
ov (mapcar 'getvar vl)) ; Get Old values
(mapcar 'setvar vl '(545 0 0))
(if (and (setq eEnt (entsel "\nChon Curve :"))
(setq ent (car eEnt) pick (trans (cadr eEnt) 1 0))
(wcmatch (cdr (assoc 0 (entget ent))) "*LINE,ARC")
(princ "\nChon doi tuong lay giao diem :")
(setq ss (ssget (list (cons 0 "*LINE,ARC,CIRCLE,ELLIPSE"))))
(setq pts (ent_ss_interpts (setq ent (vlax-ename->vla-object ent) ) ss))
(>(vl-list-length pts)0) )
(progn
(or *h* (setq *h* (* (getvar "dimtxt")(getvar "dimscale"))))
(initget 6)
(setq h (getdist (strcat "\nChieu cao chu <" (rtos *h*) "> :")))
(if h (setq *h* h))
(or *num* (setq *num* 1))
(setq num (getint (strcat "\nGia tri bat dau <" (rtos *num*) "> :")))
(if num (setq *num* num) )
(or spc (setq spc (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-Acad-Object)))))
(foreach pt (if (> (vlax-curve-getDistAtPoint ent (vlax-curve-getClosestPointTo ent pick))
(/ (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))2))
(reverse pts) pts)
(vla-AddText spc (rtos *num*) (vlax-3D-point pt) *h*)
(setq *num* (1+ *num*)))
(mapcar 'setvar vl ov)
(command "undo" "e") )
(alert "Khong tim duoc giao diem!"))
(princ))

(defun ent_ss_interpts (ent ss / e i intpts lst_pt)
;; By : Gia_Bach, www.CadViet.com 2011 ;;
(defun list->3pair (old / new)
(while (setq new (cons (list (car old) (cadr old) (caddr old)) new)
old (cdddr old)))
(reverse new) )
(setq i -1)
(while (setq e (ssname ss (setq i (1+ i))))
(if (and
(not (equal ent (setq eObj (vlax-Ename->Vla-Object e))))
(setq intpts (vlax-invoke ent 'IntersectWith eObj 0)) )
(foreach pt (list->3pair intpts)
(if (not (vl-position pt lst_pt))
(setq lst_pt (cons pt lst_pt)) ))) )
(vl-sort lst_pt
'(lambda (x y)
(< (vlax-curve-getParamAtPoint ent (vlax-curve-getClosestPointTo ent x))
(vlax-curve-getParamAtPoint ent (vlax-curve-getClosestPointTo ent y))))) )

Cảm ơn anh gia_bach.Nhờ anh chỉnh lại lisp giùm em như sau:
1. Text của em chỉ có số thôi.định đạng của nó là middelcenter và không cần lấy giá trị sau dấu thập phân nha anh ( chương trình của anh đang chạy ra 1.0000 em chỉ cần 1 ( cái này nếu ko chỉnh thì em có thể chỉnh lại trong unit của cad cũng được)).Ý của em là điểm giữa của text trùng với giao điểm của các đồi tượng khác với đường dẫn
2. Rải cả điểm đầu và cuối của đường dẫn.
Em gửi anh file kết quà mong muốn của em.Cảm ơn anh nhiều
http://www.cadviet.c...drawing1_11.rar
  • 1

#62 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 21 June 2011 - 08:20 PM

Cảm ơn anh gia_bach.Nhờ anh chỉnh lại lisp giùm em như sau:
1. Text của em chỉ có số thôi.định đạng của nó là middelcenter và không cần lấy giá trị sau dấu thập phân nha anh ( chương trình của anh đang chạy ra 1.0000 em chỉ cần 1 ( cái này nếu ko chỉnh thì em có thể chỉnh lại trong unit của cad cũng được)).Ý của em là điểm giữa của text trùng với giao điểm của các đồi tượng khác với đường dẫn
2. Rải cả điểm đầu và cuối của đường dẫn.
Em gửi anh file kết quà mong muốn của em.Cảm ơn anh nhiều
http://www.cadviet.c...drawing1_11.rar

Hy vọng lần sau bạn có mục Đỏ ngay từ đầu để các bác nhà mình không cảm thấy khó chịu khi nhận phản hồi, mà lại còn đc finish nhanh hơn nữa, vì các bác ý có đủ dữ kiện mà ^^ :)
  • 2

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


#63 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1431 Bài viết
Điểm đánh giá: 1425 (rất tốt)

Đã gửi 22 June 2011 - 09:30 AM

Cảm ơn anh gia_bach.Nhờ anh chỉnh lại lisp giùm em như sau:
1. Text của em chỉ có số thôi.định đạng của nó là middelcenter và không cần lấy giá trị sau dấu thập phân nha anh ( chương trình của anh đang chạy ra 1.0000 em chỉ cần 1 ( cái này nếu ko chỉnh thì em có thể chỉnh lại trong unit của cad cũng được)).Ý của em là điểm giữa của text trùng với giao điểm của các đồi tượng khác với đường dẫn
2. Rải cả điểm đầu và cuối của đường dẫn.
Em gửi anh file kết quà mong muốn của em.Cảm ơn anh nhiều
http://www.cadviet.c...drawing1_11.rar

- yêu cầu 1 : cập nhật.
- yêu cầu 2 : Rải cả điểm đầu và cuối của đường dẫn.
Về mặt lập trình, việc thêm tùy chọn "Rải cả điểm đầu và cuối của đường dẫn (Yes/No):" LISP có thể đáp ứng đuợc. Nhưng theo quan điểm cá nhân tôi, thêm tùy chọn này chỉ làm rối thêm Lisp (trong t/hợp có giao điểm thưc giữa đuờng dẫn và đối tựong lấy giao điểm tại điểm đầu hay[và] điểm cuối).
Do đó trong t/hợp bạn phải dùng Lisp này và muốn "Rải cả điểm đầu và cuối của đường dẫn", vui lòng "vẽ thêm 1 line nối điểm đầu và cuối của đường dẫn" truớc khi chạy lisp này (dĩ nhiên sau đó nhớ xóa line này đi).
(defun c:ATIC(/ ent ov pts ss  h num eEnt pick txt); ATIC -> Add Text at Intersect with Curve
;; By : Gia_Bach, www.CadViet.com 2011 ;;
(vl-load-com)
(command "undo" "be")
(setq ov (getvar "cmdecho") )
(setvar "cmdecho" 0)
(if (and (setq eEnt (entsel "\nChon Curve :"))
(setq ent (car eEnt) pick (trans (cadr eEnt) 1 0))
(wcmatch (cdr (assoc 0 (entget ent))) "*LINE,ARC")
(princ "\nChon doi tuong lay giao diem :")
(setq ss (ssget (list (cons 0 "*LINE,ARC,CIRCLE,ELLIPSE"))))
(setq pts (ent_ss_interpts (setq ent (vlax-ename->vla-object ent) ) ss))
(>(vl-list-length pts)0) )
(progn
(or *h* (setq *h* 1))
(initget 6)
(setq h (getdist (strcat "\nChieu cao chu <" (rtos *h*) "> :")))
(if h (setq *h* h))
(or *num* (setq *num* 1))
(setq num (getint (strcat "\nGia tri bat dau <" (itoa *num*) "> :")))
(if num (setq *num* num) )
(or spc (setq spc (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-Acad-Object)))))
(foreach pt (if (> (vlax-curve-getDistAtPoint ent (vlax-curve-getClosestPointTo ent pick))
(/ (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))2))
(reverse pts) pts)
(setq txt (vla-AddText spc (itoa *num*) (vlax-3D-point pt) *h*)
*num* (1+ *num*))
(vla-put-alignment txt 10)
(vla-put-TextAlignmentPoint txt (vlax-3D-point pt)))
(setvar "cmdecho" ov)
(command "undo" "e") )
(alert "Khong tim duoc giao diem!"))
(princ))

(defun ent_ss_interpts (ent ss / e i intpts lst_pt)
;; By : Gia_Bach, www.CadViet.com 2011 ;;
(defun list->3pair (old / new)
(while (setq new (cons (list (car old) (cadr old) (caddr old)) new)
old (cdddr old)))
(reverse new) )
(setq i -1)
(while (setq e (ssname ss (setq i (1+ i))))
(if (and
(not (equal ent (setq eObj (vlax-Ename->Vla-Object e))))
(setq intpts (vlax-invoke ent 'IntersectWith eObj 0)) )
(foreach pt (list->3pair intpts)
(if (not (vl-position pt lst_pt))
(setq lst_pt (cons pt lst_pt)) ))) )
(vl-sort lst_pt
'(lambda (x y)
(< (vlax-curve-getParamAtPoint ent (vlax-curve-getClosestPointTo ent x))
(vlax-curve-getParamAtPoint ent (vlax-curve-getClosestPointTo ent y))))) )

  • 1

#64 cd2k44

cd2k44

    Edu level: li5

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

Đã gửi 23 June 2011 - 08:43 AM

- yêu cầu 1 : cập nhật.
- yêu cầu 2 : Rải cả điểm đầu và cuối của đường dẫn.
Về mặt lập trình, việc thêm tùy chọn "Rải cả điểm đầu và cuối của đường dẫn (Yes/No):" LISP có thể đáp ứng đuợc. Nhưng theo quan điểm cá nhân tôi, thêm tùy chọn này chỉ làm rối thêm Lisp (trong t/hợp có giao điểm thưc giữa đuờng dẫn và đối tựong lấy giao điểm tại điểm đầu hay[và] điểm cuối).
Do đó trong t/hợp bạn phải dùng Lisp này và muốn "Rải cả điểm đầu và cuối của đường dẫn", vui lòng "vẽ thêm 1 line nối điểm đầu và cuối của đường dẫn" truớc khi chạy lisp này (dĩ nhiên sau đó nhớ xóa line này đi).

(defun c:ATIC(/ ent ov pts ss  h num eEnt pick txt); ATIC -> Add Text at Intersect with Curve
;; By : Gia_Bach, www.CadViet.com 2011 ;;
(vl-load-com)
(command "undo" "be")
(setq ov (getvar "cmdecho") )
(setvar "cmdecho" 0)
(if (and (setq eEnt (entsel "\nChon Curve :"))
(setq ent (car eEnt) pick (trans (cadr eEnt) 1 0))
(wcmatch (cdr (assoc 0 (entget ent))) "*LINE,ARC")
(princ "\nChon doi tuong lay giao diem :")
(setq ss (ssget (list (cons 0 "*LINE,ARC,CIRCLE,ELLIPSE"))))
(setq pts (ent_ss_interpts (setq ent (vlax-ename->vla-object ent) ) ss))
(>(vl-list-length pts)0) )
(progn
(or *h* (setq *h* 1))
(initget 6)
(setq h (getdist (strcat "\nChieu cao chu <" (rtos *h*) "> :")))
(if h (setq *h* h))
(or *num* (setq *num* 1))
(setq num (getint (strcat "\nGia tri bat dau <" (itoa *num*) "> :")))
(if num (setq *num* num) )
(or spc (setq spc (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-Acad-Object)))))
(foreach pt (if (> (vlax-curve-getDistAtPoint ent (vlax-curve-getClosestPointTo ent pick))
(/ (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))2))
(reverse pts) pts)
(setq txt (vla-AddText spc (itoa *num*) (vlax-3D-point pt) *h*)
*num* (1+ *num*))
(vla-put-alignment txt 10)
(vla-put-TextAlignmentPoint txt (vlax-3D-point pt)))
(setvar "cmdecho" ov)
(command "undo" "e") )
(alert "Khong tim duoc giao diem!"))
(princ))

(defun ent_ss_interpts (ent ss / e i intpts lst_pt)
;; By : Gia_Bach, www.CadViet.com 2011 ;;
(defun list->3pair (old / new)
(while (setq new (cons (list (car old) (cadr old) (caddr old)) new)
old (cdddr old)))
(reverse new) )
(setq i -1)
(while (setq e (ssname ss (setq i (1+ i))))
(if (and
(not (equal ent (setq eObj (vlax-Ename->Vla-Object e))))
(setq intpts (vlax-invoke ent 'IntersectWith eObj 0)) )
(foreach pt (list->3pair intpts)
(if (not (vl-position pt lst_pt))
(setq lst_pt (cons pt lst_pt)) ))) )
(vl-sort lst_pt
'(lambda (x y)
(< (vlax-curve-getParamAtPoint ent (vlax-curve-getClosestPointTo ent x))
(vlax-curve-getParamAtPoint ent (vlax-curve-getClosestPointTo ent y))))) )

Cảm ơn anh gia_bach,lisp của an đã làm tốt yêu cầu của em rồi.Nhưng em mong anh có thể kết hợp thêm với lisp của anh Duy vì lúc rải đối tượng em có 2 lựa chọn: 1 là khoảng cách và 2 là tìm giao điểm của các đường giao như lisp của anh.Mong anh và anh Duy cùng các anh khác trên diễn đàn kết hợp 2lisp này giùm em với anh.Em lại được voi đòi tiên rồi.hihi.Cảm ơn anh gia_bach và anh duy nhiều
  • 0

#65 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1360 (rất tốt)

Đã gửi 23 June 2011 - 10:31 AM

Cảm ơn anh gia_bach,lisp của an đã làm tốt yêu cầu của em rồi.Nhưng em mong anh có thể kết hợp thêm với lisp của anh Duy vì lúc rải đối tượng em có 2 lựa chọn: 1 là khoảng cách và 2 là tìm giao điểm của các đường giao như lisp của anh.Mong anh và anh Duy cùng các anh khác trên diễn đàn kết hợp 2lisp này giùm em với anh.Em lại được voi đòi tiên rồi.hihi.Cảm ơn anh gia_bach và anh duy nhiều

Tiên thì không có nhưng có hai bà trưng :blush: .Mình cải tạo cái lisp của mình để rải text tăng dần được. Khi nào thích rải vào giao điểm thì bạn dùng lisp của bác Gia_bach
  • 0

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#66 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1360 (rất tốt)

Đã gửi 04 July 2011 - 08:39 AM

Cảm ơn anh gia_bach,lisp của an đã làm tốt yêu cầu của em rồi.Nhưng em mong anh có thể kết hợp thêm với lisp của anh Duy vì lúc rải đối tượng em có 2 lựa chọn: 1 là khoảng cách và 2 là tìm giao điểm của các đường giao như lisp của anh.Mong anh và anh Duy cùng các anh khác trên diễn đàn kết hợp 2lisp này giùm em với anh.Em lại được voi đòi tiên rồi.hihi.Cảm ơn anh gia_bach và anh duy nhiều

Đã chỉnh lại lisp thêm chức năng rải text thay đổi giá trị.
-Tên lệnh: RT.
-Hỏi chọn đối tượng ko phải text thì hòi miết đến khi nào chọn đúng text thì hỏi tiếp điểm chuẩn, trong dòng hỏi điểm chuần có lồng giá trị thay đổi text mặc định là 1 (nghĩa là giá trị text thay đổi theo kiểu cộng 1 giá trị) nếu muốn thay đổi giá trị này thì đừng chọn điểm chuẩn vội mà gỏ d enter lisp hỏi giá trị cộng thêm bạn nhập vào (nhận cả giá trị âm nhé). Nhập xong lisp tiếp tục hỏi chọn điềm chuẩn.
-Hỏi chọn các đối tượng muốn rải theo các đối tượng này là bất cứ cái gì bạn muốn lisp sẽ rải nhóm đối tượng này và cái text bạn chọn ban đầu (giá trị cái text sẽ thay đổi còn các đối tượng chép theo giữ nguyên) nếu không chép theo cái gì thì enter.
-Các bước tiếp theo giống như cũ.
*Trong này có lệnh chính:
-RTD: rải từ điểm đã trình bày hôm trước.
-RDT: rải đồi tượng đã trình bày hôm trước.
-RT: rải text trình bày hôm nay.
*Và 1 lệnh khuyến mại:
-DTD: đo từ điểm, dùng đo độ dài đối tượng giữa 2 điểm trên đối tượng đó.

(Defun c:rdt (/ ss doituong dsl dc ddd chondd chieudaicuver diemdau diemcuoi krai chieudaidoan slc sl index d2 p2 d5 p5 d3 p3 dt l m)
(vl-load-com)
(command "undo" "be")
(command "ucs" "")
(chonnhomdoituong)
(choncuver)

(setq diemchuan (vlax-curve-getPointAtDist chondd 0))
(setq diemdinhhuong (vlax-curve-getPointAtDist chondd chieudaicuver))

(setq chieudaitinh chieudaicuver)
(setq dautinh +)

(setq thuchienrai raikieukhongtext)
(hoikieuraicd)
(command "ucs" "p")
(command "undo" "end")
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun c:dtd (/ ss doituong dsl dc ddd chondd chieudaicuver diemdau diemcuoi krai chieudaidoan slc sl index d2 p2 d5 p5 d3 p3 dt l m daidendiem)
(vl-load-com)
(command "undo" "be")
(command "ucs" "")
(choncuver)
(cdxuatphatdo)
(cdketthucdo)
(Cond
((< daidendiemdo daidenhuongdo) (setq chieudaidoan (- daidenhuongdo daidendiemdo)))
((> daidendiemdo daidenhuongdo) (setq chieudaidoan (- daidendiemdo daidenhuongdo)))
)
(command "undo" "end")
(princ (strcat "\nChieu dai doan do la: " (rtos chieudaidoan 2 4)))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun c:rt (/ ss doituong dsl dc ddd chondd chieudaicuver diemdau diemcuoi krai chieudaidoan slc sl index d2 p2 d5 p5 d3 p3 dt l m daidendiem)
(vl-load-com)
(command "undo" "be")
(command "ucs" "")
(chonnhomdoituongtext)

(princ "\nChon doi tuong rai kem theo text :")
(setq ss (ssget))
(cond
((= ss nil) (setq thuchienrai raikieutextkokem))
((/= ss nil) (setq thuchienrai raikieutextcokem)))

(choncuver)
(chondiemxuatphat)
;(setq thuchienrai raikieutext)
(hoikieuraicd)
(command "ucs" "p")
(command "undo" "end")
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun c:rtd (/ ss doituong dsl dc ddd chondd chieudaicuver diemdau diemcuoi krai chieudaidoan slc sl index d2 p2 d5 p5 d3 p3 dt l m daidendiem)
(vl-load-com)
(command "undo" "be")
(command "ucs" "")
(chonnhomdoituong)
(choncuver)
(chondiemxuatphat)
(setq thuchienrai raikieukhongtext)
(hoikieuraicd)
(command "ucs" "p")
(command "undo" "end")
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun chondiemchuandoituong ()
(setq dc (getpoint "\nChon diem goc: "))
(cond
((= dc nil) (princ "\nChua chon duoc diem goc:") (chondiemchuandoituong))
((/= ss nil)))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun chonnhomdoituongtext ()
(if (null congthem)(setq congthem "1"))
(setq ddd (entsel "\nChon text mau"))
(while
(or
(null ddd)
(/= "TEXT" (cdr (assoc 0 (entget (car ddd)))))
)
(princ "\nDoi tuong khong phai la text! Chon lai")
(setq ddd (entsel "\nChon text mau"))
)
(setq sst (car ddd))
(setq DTTT (entget sst))
(setq NDTTT (cdr (assoc 1 DTTT)))
(Setq temp T)
(While temp
(setq dc (strcat "\nDon vi cong them la(" congthem "): "))
(Initget "D")
(setq str (getpoint dc))
(Cond
((= str "D") (setq congthem (getstring (strcat"\nDon vi cong them la <" congthem "> :"))))
(Progn
(Setq dc str)
(setq temp nil)
)
)
)
(princ)
)

;;;;;;;;;;;;;;;;;
(Defun dotructiep ()
(cdxuatphatdo)
(cdketthucdo)
(Cond
((< daidendiemdo daidenhuongdo) (setq chieudaidoan (- daidenhuongdo daidendiemdo)))
((> daidendiemdo daidenhuongdo) (setq chieudaidoan (- daidendiemdo daidenhuongdo)))
)
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun cdxuatphatdo ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 545)
(setq diemchuando (getpoint "\nTu diem :"))
(setvar "osmode" 0)
(setq daidendiemdo (vlax-curve-getDistAtPoint chondd diemchuando))
(setvar "osmode"luubatdiem)
(cond
((= daidendiemdo nil) (princ "\nDiem vua chon khong nam tren duong dan, chon lai:") (cdxuatphatdo))
((/= daidendiemdo nil)))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun cdketthucdo ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 545)
(setq diemdinhhuongdo (getpoint diemchuando"\nDen diem :"))
(setvar "osmode" 0)
(setq daidenhuongdo (vlax-curve-getDistAtPoint chondd diemdinhhuongdo))
(setvar "osmode"luubatdiem)
(cond
((= daidenhuongdo nil) (princ "\nDiem vua chon khong nam tren duong dan, chon lai:") (cdketthucdo))
((/= daidenhuongdo nil)))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun cdxuatphat ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 545)
(setq diemchuan (getpoint "\nDiem bat dau rai tren duong dan:"))
(setvar "osmode" 0)
(setq daidendiem (vlax-curve-getDistAtPoint chondd diemchuan))
(setvar "osmode"luubatdiem)
(cond
((= daidendiem nil) (princ "\nDiem vua chon khong nam tren duong dan, chon lai:") (cdxuatphat))
((/= daidendiem nil)))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun cdketthuc ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 545)
(setq diemdinhhuong (getpoint diemchuan"\nDiem ket thuc rai tren duong dan:"))
(setvar "osmode" 0)
(setq daidenhuong (vlax-curve-getDistAtPoint chondd diemdinhhuong))
(setvar "osmode"luubatdiem)
(cond
((= daidenhuong nil) (princ "\nDiem vua chon khong nam tren duong dan, chon lai:") (cdketthuc))
((/= daidenhuong nil)))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun thongbaoketqua ()
(princ (strcat "\nChieu dai doan la: " (rtos chieudaitinh 2 4) doanhienthinoidung))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun chondiemxuatphat ()
(cdxuatphat)
(cdketthuc)
(Cond
((< daidendiem daidenhuong) (setq chieudaitinh (- daidenhuong daidendiem)) (setq dautinh +))
((> daidendiem daidenhuong) (setq chieudaitinh (- daidendiem daidenhuong)) (setq dautinh -))
)
(setq doanxuatphat daidendiem)
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun hoikieuraicd ()
(setq kraicd (strcase (getstring "\nKieu rai theo: Tinh /So luong/")))

(Cond
((= kraicd "T") (raisoluongtinh))
((/= kraicd "T")
(Cond
((= kraicd "S") (raisoluongcd))
((/= kraicd "S") (raikhoangcachcd))
)
)
)
(princ)
)
;;;;;;;;;;;;;;
(Defun raisoluongtinh ()
(setq slrai (getreal "\nRai them may lan khong tinh doi tuong tai diem bat dau rai:"))
(setq chieudaidoan (GETDIST "\nKhoang cach 1 lan rai: "))
(Cond
((= chieudaidoan 0) (dotructiep)))

(setq tongdoan (* slrai chieudaidoan))
(Cond
((> tongdoan chieudaitinh)
(princ (strcat "\nChieu dai doan la: " (rtos chieudaitinh 2 4) ", Yeu cau la: " (rtos chieudaidoan 2 4) "x" (rtos slrai 2 0) "=" (rtos tongdoan 2 4)))
(princ "\nVuot qua chieu dai cho phep, nhap lai:")
(raisoluongtinh))
((< tongdoan chieudaitinh)
(setq sl (fix (+ slrai 1)))
(setq sl (fix sl))
(setq doanhienthinoidung (strcat "\nDa thuc hien rai: " (rtos slrai 2 0) " lan voi khoang cach " (rtos chieudaidoan 2 4)))
(thuchienrai)
)
)
(princ)
)
;;;;;;;;;;;;;;
(Defun raikhoangcachcd ()
(setq chieudaidoan (GETDIST "\nKhoang cach 1 lan rai: "))
(Cond
((= chieudaidoan 0) (dotructiep)))
(Cond
((> chieudaidoan chieudaitinh)
(princ (strcat "\nChieu dai doan la: " (rtos chieudaitinh 2 4) ", Yeu cau la: " (rtos chieudaidoan 2 4)))
(princ "\nVuot qua chieu dai cho phep, nhap lai:")
(raikhoangcachcd))
((< chieudaidoan chieudaitinh)
(setq sol (+ (/ chieudaitinh chieudaidoan) 1))
(setq sl (fix sol))
(setq sl (fix sl))
(setq doanhienthinoidung (strcat "\nDa thuc hien rai: " (rtos sol 2 0) " lan voi khoang cach " (rtos chieudaidoan 2 4)))
(thuchienrai)
)
)
(princ)
)
;;;;;;;;;;;;;;
(Defun raisoluongcd ()
(setq slc (getreal "\nChia duong dan thanh may lan:"))
(setq chieudaidoan (/ chieudaitinh slc))
(setq sl (fix (+ 1 slc)))
(setq doanhienthinoidung (strcat "\nDa thuc hien rai: " (rtos slc 2 0) " lan voi khoang cach " (rtos chieudaidoan 2 4)))
(thuchienrai)
(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 doanxuatphat 0)
(setvar "osmode"luubatdiem)
(princ)
)
;;;;;;;;;;;;;;
(Defun raikieukhongtext (/ quaykhong)

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

(setq index -1)

(repeat sl
(setq index (1+ index))
(setq d2 (dautinh doanxuatphat (* chieudaidoan index)))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq p2 (vlax-curve-getPointAtDist chondd d2))
(setvar "osmode"luubatdiem)
(copygiua)
)
(thongbaoketqua)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun copycuoiquay()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq d5 (- (dautinh doanxuatphat (* chieudaidoan index)) 0.01))
(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 (+ (dautinh doanxuatphat (* 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 raikieutextcokem (/ quaykhong)

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

(setq index -1)

(repeat sl
(setq index (1+ index))
(setq d2 (dautinh doanxuatphat (* chieudaidoan index)))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq p2 (vlax-curve-getPointAtDist chondd d2))
(setvar "osmode"luubatdiem)
(copygiuatext)
(copygiua)
)
(thongbaoketqua)
(princ)
)
;;;;;;;;;;;;;;
(Defun raikieutextkokem (/ quaykhong)

(setq quaykhong (strcase (getstring "\nCo quay doi tuong vuong goc voi duong dan khong: Khong/")))
(Cond
((= quaykhong "K") (setq copygiuatext copykoquaytext))
((/= quaykhong "K")(setq copygiuatext copyquaytext))
)

(setq index -1)

(repeat sl
(setq index (1+ index))
(setq d2 (dautinh doanxuatphat (* chieudaidoan index)))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq p2 (vlax-curve-getPointAtDist chondd d2))
(setvar "osmode"luubatdiem)
(copygiuatext)
)
(thongbaoketqua)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun copycuoiquaytext ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq d5 (- (dautinh doanxuatphat (* chieudaidoan index)) 0.01))
(setq p5 (vlax-curve-getPointAtDist chondd d5))
(command ".copy" sst "" dc p2)
(command ".rotate" "last" "" p2 p5)
(command ".rotate" "last" "" p2 180)
(setq congthems (atoi congthem))
(setq DTDM (entlast))

(if (and (>= (ascii NDTTT) 48) (<= (ascii NDTTT) 57))
(setq NDTTT (itoa (+ (atoi NDTTT) congthems)))
(setq NDTTT (chr (+ (ascii NDTTT) congthems)))
)

(setq Elist (entget DTDM))
(setq Oldlist (assoc 1 Elist))
(setq Oldtext (cdr Oldlist))
(setq Oldtext (strcase Oldtext nil))
(setq Newlist (cons '1 NDTTT))
(setq Elist (subst Newlist Oldlist Elist))
(entmod Elist)
(setvar "osmode"luubatdiem)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun COPYQUAYtext (/ p3)
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq d3 (+ (dautinh doanxuatphat (* chieudaidoan index)) 0.001))
(setq p3 (vlax-curve-getPointAtDist chondd d3))
(setvar "osmode"luubatdiem)
(Cond
((= p3 nil) (copycuoiquaytext))
((/= p3 nil)
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(command ".copy" sst "" dc p2)
(command ".rotate" "last" "" p2 p3)


(setq congthems (atoi congthem))
(setq DTDM (entlast))

(if (and (>= (ascii NDTTT) 48) (<= (ascii NDTTT) 57))
(setq NDTTT (itoa (+ (atoi NDTTT) congthems)))
(setq NDTTT (chr (+ (ascii NDTTT) congthems)))
)

(setq Elist (entget DTDM))
(setq Oldlist (assoc 1 Elist))
(setq Oldtext (cdr Oldlist))
(setq Oldtext (strcase Oldtext nil))
(setq Newlist (cons '1 NDTTT))
(setq Elist (subst Newlist Oldlist Elist))
(entmod Elist)
(setvar "osmode"luubatdiem)
)
)


(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun COPYKOQUAYtext ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(command ".copy" sst "" dc p2 "")
(setq congthems (atoi congthem))
(setq DTDM (entlast))

(if (and (>= (ascii NDTTT) 48) (<= (ascii NDTTT) 57))
(setq NDTTT (itoa (+ (atoi NDTTT) congthems)))
(setq NDTTT (chr (+ (ascii NDTTT) congthems)))
)

(setq Elist (entget DTDM))
(setq Oldlist (assoc 1 Elist))
(setq Oldtext (cdr Oldlist))
(setq Oldtext (strcase Oldtext nil))
(setq Newlist (cons '1 NDTTT))
(setq Elist (subst Newlist Oldlist Elist))
(entmod Elist)
(setvar "osmode"luubatdiem)
(princ)
)
;;;;;;;;;;;;;;


  • 3

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#67 chaytheomay

chaytheomay

    biết vẽ line

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

Đã gửi 04 July 2011 - 10:18 AM

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:

đá tấp lô là đá gì nhỉ.Hình như mình biết đó là hỗn hợp xi măng+cát+nước đúc theo khuôn hình chứ nhật khoảng 300x200x100.eo ui giờ ko biết có còn ai sài nữa không,tại hồi trước năm 1995 nhà mình xây nhà thì sài loại này để xây tường thay cho gạch.Hic cái ngày xưa cũng vất vả nhỉ làm nhà thì tự làm từ A tới Z
  • 0

#68 cd2k44

cd2k44

    Edu level: li5

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

Đã gửi 04 July 2011 - 11:00 AM

Đã chỉnh lại lisp thêm chức năng rải text thay đổi giá trị.
-Tên lệnh: RT.
-Hỏi chọn đối tượng ko phải text thì hòi miết đến khi nào chọn đúng text thì hỏi tiếp điểm chuẩn, trong dòng hỏi điểm chuần có lồng giá trị thay đổi text mặc định là 1 (nghĩa là giá trị text thay đổi theo kiểu cộng 1 giá trị) nếu muốn thay đổi giá trị này thì đừng chọn điểm chuẩn vội mà gỏ d enter lisp hỏi giá trị cộng thêm bạn nhập vào (nhận cả giá trị âm nhé). Nhập xong lisp tiếp tục hỏi chọn điềm chuẩn.
-Hỏi chọn các đối tượng muốn rải theo các đối tượng này là bất cứ cái gì bạn muốn lisp sẽ rải nhóm đối tượng này và cái text bạn chọn ban đầu (giá trị cái text sẽ thay đổi còn các đối tượng chép theo giữ nguyên) nếu không chép theo cái gì thì enter.
-Các bước tiếp theo giống như cũ.
*Trong này có lệnh chính:
-RTD: rải từ điểm đã trình bày hôm trước.
-RDT: rải đồi tượng đã trình bày hôm trước.
-RT: rải text trình bày hôm nay.
*Và 1 lệnh khuyến mại:
-DTD: đo từ điểm, dùng đo độ dài đối tượng giữa 2 điểm trên đối tượng đó.

(Defun c:rdt (/ ss doituong dsl dc ddd chondd chieudaicuver diemdau diemcuoi krai chieudaidoan slc sl index d2 p2 d5 p5 d3 p3 dt l m)
(vl-load-com)
(command "undo" "be")
(command "ucs" "")
(chonnhomdoituong)
(choncuver)

(setq diemchuan (vlax-curve-getPointAtDist chondd 0))
(setq diemdinhhuong (vlax-curve-getPointAtDist chondd chieudaicuver))

(setq chieudaitinh chieudaicuver)
(setq dautinh +)

(setq thuchienrai raikieukhongtext)
(hoikieuraicd)
(command "ucs" "p")
(command "undo" "end")
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun c:dtd (/ ss doituong dsl dc ddd chondd chieudaicuver diemdau diemcuoi krai chieudaidoan slc sl index d2 p2 d5 p5 d3 p3 dt l m daidendiem)
(vl-load-com)
(command "undo" "be")
(command "ucs" "")
(choncuver)
(cdxuatphatdo)
(cdketthucdo)
(Cond
((< daidendiemdo daidenhuongdo) (setq chieudaidoan (- daidenhuongdo daidendiemdo)))
((> daidendiemdo daidenhuongdo) (setq chieudaidoan (- daidendiemdo daidenhuongdo)))
)
(command "undo" "end")
(princ (strcat "\nChieu dai doan do la: " (rtos chieudaidoan 2 4)))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun c:rt (/ ss doituong dsl dc ddd chondd chieudaicuver diemdau diemcuoi krai chieudaidoan slc sl index d2 p2 d5 p5 d3 p3 dt l m daidendiem)
(vl-load-com)
(command "undo" "be")
(command "ucs" "")
(chonnhomdoituongtext)

(princ "\nChon doi tuong rai kem theo text :")
(setq ss (ssget))
(cond
((= ss nil) (setq thuchienrai raikieutextkokem))
((/= ss nil) (setq thuchienrai raikieutextcokem)))

(choncuver)
(chondiemxuatphat)
;(setq thuchienrai raikieutext)
(hoikieuraicd)
(command "ucs" "p")
(command "undo" "end")
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun c:rtd (/ ss doituong dsl dc ddd chondd chieudaicuver diemdau diemcuoi krai chieudaidoan slc sl index d2 p2 d5 p5 d3 p3 dt l m daidendiem)
(vl-load-com)
(command "undo" "be")
(command "ucs" "")
(chonnhomdoituong)
(choncuver)
(chondiemxuatphat)
(setq thuchienrai raikieukhongtext)
(hoikieuraicd)
(command "ucs" "p")
(command "undo" "end")
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun chondiemchuandoituong ()
(setq dc (getpoint "\nChon diem goc: "))
(cond
((= dc nil) (princ "\nChua chon duoc diem goc:") (chondiemchuandoituong))
((/= ss nil)))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun chonnhomdoituongtext ()
(if (null congthem)(setq congthem "1"))
(setq ddd (entsel "\nChon text mau"))
(while
(or
(null ddd)
(/= "TEXT" (cdr (assoc 0 (entget (car ddd)))))
)
(princ "\nDoi tuong khong phai la text! Chon lai")
(setq ddd (entsel "\nChon text mau"))
)
(setq sst (car ddd))
(setq DTTT (entget sst))
(setq NDTTT (cdr (assoc 1 DTTT)))
(Setq temp T)
(While temp
(setq dc (strcat "\nDon vi cong them la(" congthem "): "))
(Initget "D")
(setq str (getpoint dc))
(Cond
((= str "D") (setq congthem (getstring (strcat"\nDon vi cong them la <" congthem "> :"))))
(Progn
(Setq dc str)
(setq temp nil)
)
)
)
(princ)
)

;;;;;;;;;;;;;;;;;
(Defun dotructiep ()
(cdxuatphatdo)
(cdketthucdo)
(Cond
((< daidendiemdo daidenhuongdo) (setq chieudaidoan (- daidenhuongdo daidendiemdo)))
((> daidendiemdo daidenhuongdo) (setq chieudaidoan (- daidendiemdo daidenhuongdo)))
)
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun cdxuatphatdo ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 545)
(setq diemchuando (getpoint "\nTu diem :"))
(setvar "osmode" 0)
(setq daidendiemdo (vlax-curve-getDistAtPoint chondd diemchuando))
(setvar "osmode"luubatdiem)
(cond
((= daidendiemdo nil) (princ "\nDiem vua chon khong nam tren duong dan, chon lai:") (cdxuatphatdo))
((/= daidendiemdo nil)))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun cdketthucdo ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 545)
(setq diemdinhhuongdo (getpoint diemchuando"\nDen diem :"))
(setvar "osmode" 0)
(setq daidenhuongdo (vlax-curve-getDistAtPoint chondd diemdinhhuongdo))
(setvar "osmode"luubatdiem)
(cond
((= daidenhuongdo nil) (princ "\nDiem vua chon khong nam tren duong dan, chon lai:") (cdketthucdo))
((/= daidenhuongdo nil)))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun cdxuatphat ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 545)
(setq diemchuan (getpoint "\nDiem bat dau rai tren duong dan:"))
(setvar "osmode" 0)
(setq daidendiem (vlax-curve-getDistAtPoint chondd diemchuan))
(setvar "osmode"luubatdiem)
(cond
((= daidendiem nil) (princ "\nDiem vua chon khong nam tren duong dan, chon lai:") (cdxuatphat))
((/= daidendiem nil)))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun cdketthuc ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 545)
(setq diemdinhhuong (getpoint diemchuan"\nDiem ket thuc rai tren duong dan:"))
(setvar "osmode" 0)
(setq daidenhuong (vlax-curve-getDistAtPoint chondd diemdinhhuong))
(setvar "osmode"luubatdiem)
(cond
((= daidenhuong nil) (princ "\nDiem vua chon khong nam tren duong dan, chon lai:") (cdketthuc))
((/= daidenhuong nil)))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun thongbaoketqua ()
(princ (strcat "\nChieu dai doan la: " (rtos chieudaitinh 2 4) doanhienthinoidung))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun chondiemxuatphat ()
(cdxuatphat)
(cdketthuc)
(Cond
((< daidendiem daidenhuong) (setq chieudaitinh (- daidenhuong daidendiem)) (setq dautinh +))
((> daidendiem daidenhuong) (setq chieudaitinh (- daidendiem daidenhuong)) (setq dautinh -))
)
(setq doanxuatphat daidendiem)
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun hoikieuraicd ()
(setq kraicd (strcase (getstring "\nKieu rai theo: Tinh /So luong/")))

(Cond
((= kraicd "T") (raisoluongtinh))
((/= kraicd "T")
(Cond
((= kraicd "S") (raisoluongcd))
((/= kraicd "S") (raikhoangcachcd))
)
)
)
(princ)
)
;;;;;;;;;;;;;;
(Defun raisoluongtinh ()
(setq slrai (getreal "\nRai them may lan khong tinh doi tuong tai diem bat dau rai:"))
(setq chieudaidoan (GETDIST "\nKhoang cach 1 lan rai: "))
(Cond
((= chieudaidoan 0) (dotructiep)))

(setq tongdoan (* slrai chieudaidoan))
(Cond
((> tongdoan chieudaitinh)
(princ (strcat "\nChieu dai doan la: " (rtos chieudaitinh 2 4) ", Yeu cau la: " (rtos chieudaidoan 2 4) "x" (rtos slrai 2 0) "=" (rtos tongdoan 2 4)))
(princ "\nVuot qua chieu dai cho phep, nhap lai:")
(raisoluongtinh))
((< tongdoan chieudaitinh)
(setq sl (fix (+ slrai 1)))
(setq sl (fix sl))
(setq doanhienthinoidung (strcat "\nDa thuc hien rai: " (rtos slrai 2 0) " lan voi khoang cach " (rtos chieudaidoan 2 4)))
(thuchienrai)
)
)
(princ)
)
;;;;;;;;;;;;;;
(Defun raikhoangcachcd ()
(setq chieudaidoan (GETDIST "\nKhoang cach 1 lan rai: "))
(Cond
((= chieudaidoan 0) (dotructiep)))
(Cond
((> chieudaidoan chieudaitinh)
(princ (strcat "\nChieu dai doan la: " (rtos chieudaitinh 2 4) ", Yeu cau la: " (rtos chieudaidoan 2 4)))
(princ "\nVuot qua chieu dai cho phep, nhap lai:")
(raikhoangcachcd))
((< chieudaidoan chieudaitinh)
(setq sol (+ (/ chieudaitinh chieudaidoan) 1))
(setq sl (fix sol))
(setq sl (fix sl))
(setq doanhienthinoidung (strcat "\nDa thuc hien rai: " (rtos sol 2 0) " lan voi khoang cach " (rtos chieudaidoan 2 4)))
(thuchienrai)
)
)
(princ)
)
;;;;;;;;;;;;;;
(Defun raisoluongcd ()
(setq slc (getreal "\nChia duong dan thanh may lan:"))
(setq chieudaidoan (/ chieudaitinh slc))
(setq sl (fix (+ 1 slc)))
(setq doanhienthinoidung (strcat "\nDa thuc hien rai: " (rtos slc 2 0) " lan voi khoang cach " (rtos chieudaidoan 2 4)))
(thuchienrai)
(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 doanxuatphat 0)
(setvar "osmode"luubatdiem)
(princ)
)
;;;;;;;;;;;;;;
(Defun raikieukhongtext (/ quaykhong)

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

(setq index -1)

(repeat sl
(setq index (1+ index))
(setq d2 (dautinh doanxuatphat (* chieudaidoan index)))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq p2 (vlax-curve-getPointAtDist chondd d2))
(setvar "osmode"luubatdiem)
(copygiua)
)
(thongbaoketqua)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun copycuoiquay()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq d5 (- (dautinh doanxuatphat (* chieudaidoan index)) 0.01))
(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 (+ (dautinh doanxuatphat (* 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 raikieutextcokem (/ quaykhong)

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

(setq index -1)

(repeat sl
(setq index (1+ index))
(setq d2 (dautinh doanxuatphat (* chieudaidoan index)))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq p2 (vlax-curve-getPointAtDist chondd d2))
(setvar "osmode"luubatdiem)
(copygiuatext)
(copygiua)
)
(thongbaoketqua)
(princ)
)
;;;;;;;;;;;;;;
(Defun raikieutextkokem (/ quaykhong)

(setq quaykhong (strcase (getstring "\nCo quay doi tuong vuong goc voi duong dan khong: Khong/")))
(Cond
((= quaykhong "K") (setq copygiuatext copykoquaytext))
((/= quaykhong "K")(setq copygiuatext copyquaytext))
)

(setq index -1)

(repeat sl
(setq index (1+ index))
(setq d2 (dautinh doanxuatphat (* chieudaidoan index)))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq p2 (vlax-curve-getPointAtDist chondd d2))
(setvar "osmode"luubatdiem)
(copygiuatext)
)
(thongbaoketqua)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun copycuoiquaytext ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq d5 (- (dautinh doanxuatphat (* chieudaidoan index)) 0.01))
(setq p5 (vlax-curve-getPointAtDist chondd d5))
(command ".copy" sst "" dc p2)
(command ".rotate" "last" "" p2 p5)
(command ".rotate" "last" "" p2 180)
(setq congthems (atoi congthem))
(setq DTDM (entlast))

(if (and (>= (ascii NDTTT) 48) (<= (ascii NDTTT) 57))
(setq NDTTT (itoa (+ (atoi NDTTT) congthems)))
(setq NDTTT (chr (+ (ascii NDTTT) congthems)))
)

(setq Elist (entget DTDM))
(setq Oldlist (assoc 1 Elist))
(setq Oldtext (cdr Oldlist))
(setq Oldtext (strcase Oldtext nil))
(setq Newlist (cons '1 NDTTT))
(setq Elist (subst Newlist Oldlist Elist))
(entmod Elist)
(setvar "osmode"luubatdiem)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun COPYQUAYtext (/ p3)
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq d3 (+ (dautinh doanxuatphat (* chieudaidoan index)) 0.001))
(setq p3 (vlax-curve-getPointAtDist chondd d3))
(setvar "osmode"luubatdiem)
(Cond
((= p3 nil) (copycuoiquaytext))
((/= p3 nil)
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(command ".copy" sst "" dc p2)
(command ".rotate" "last" "" p2 p3)


(setq congthems (atoi congthem))
(setq DTDM (entlast))

(if (and (>= (ascii NDTTT) 48) (<= (ascii NDTTT) 57))
(setq NDTTT (itoa (+ (atoi NDTTT) congthems)))
(setq NDTTT (chr (+ (ascii NDTTT) congthems)))
)

(setq Elist (entget DTDM))
(setq Oldlist (assoc 1 Elist))
(setq Oldtext (cdr Oldlist))
(setq Oldtext (strcase Oldtext nil))
(setq Newlist (cons '1 NDTTT))
(setq Elist (subst Newlist Oldlist Elist))
(entmod Elist)
(setvar "osmode"luubatdiem)
)
)


(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun COPYKOQUAYtext ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(command ".copy" sst "" dc p2 "")
(setq congthems (atoi congthem))
(setq DTDM (entlast))

(if (and (>= (ascii NDTTT) 48) (<= (ascii NDTTT) 57))
(setq NDTTT (itoa (+ (atoi NDTTT) congthems)))
(setq NDTTT (chr (+ (ascii NDTTT) congthems)))
)

(setq Elist (entget DTDM))
(setq Oldlist (assoc 1 Elist))
(setq Oldtext (cdr Oldlist))
(setq Oldtext (strcase Oldtext nil))
(setq Newlist (cons '1 NDTTT))
(setq Elist (subst Newlist Oldlist Elist))
(entmod Elist)
(setvar "osmode"luubatdiem)
(princ)
)
;;;;;;;;;;;;;;

Cảm ơn anh Duy đã quan tâm.Lisp đã đáp ứng được yêu cầu của em rồi.Tks anh nhiều
  • 0

#69 nguyentienthanhddksct

nguyentienthanhddksct

    biết vẽ polygon

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

Đã gửi 21 March 2012 - 04:55 PM

Cảm ơn anh Duy đã quan tâm.Lisp đã đáp ứng được yêu cầu của em rồi.Tks anh nhiều


Lisp rtd đúng theo ý của mình nhưng text lại không tăng dần theo ý của mình. còn lệnh rt thì tăng dần nhưng text lại không nằm ở đường pl. bạn có thể sửa lại giúp mình được không bạn.


;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=42771&st=60
(Defun c:rdt (/ ss doituong dsl dc ddd chondd chieudaicuver diemdau diemcuoi krai chieudaidoan slc sl index d2 p2 d5 p5 d3 p3 dt l m)
(vl-load-com)
(command "undo" "be")
(command "ucs" "")
(chonnhomdoituong)
(choncuver)
(setq diemchuan (vlax-curve-getPointAtDist chondd 0))
(setq diemdinhhuong (vlax-curve-getPointAtDist chondd chieudaicuver))
(setq chieudaitinh chieudaicuver)
(setq dautinh +)
(setq thuchienrai raikieukhongtext)
(hoikieuraicd)
(command "ucs" "p")
(command "undo" "end")
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun c:dtd (/ ss doituong dsl dc ddd chondd chieudaicuver diemdau diemcuoi krai chieudaidoan slc sl index d2 p2 d5 p5 d3 p3 dt l m daidendiem)
(vl-load-com)
(command "undo" "be")
(command "ucs" "")
(choncuver)
(cdxuatphatdo)
(cdketthucdo)
(Cond
((< daidendiemdo daidenhuongdo) (setq chieudaidoan (- daidenhuongdo daidendiemdo)))
((> daidendiemdo daidenhuongdo) (setq chieudaidoan (- daidendiemdo daidenhuongdo)))
)
(command "undo" "end")
(princ (strcat "\nChieu dai doan do la: " (rtos chieudaidoan 2 4)))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun c:rt (/ ss doituong dsl dc ddd chondd chieudaicuver diemdau diemcuoi krai chieudaidoan slc sl index d2 p2 d5 p5 d3 p3 dt l m daidendiem)
(vl-load-com)
(command "undo" "be")
(command "ucs" "")
(chonnhomdoituongtext)
(princ "\nChon doi tuong rai kem theo text :")
(setq ss (ssget))
(cond
((= ss nil) (setq thuchienrai raikieutextkokem))
((/= ss nil) (setq thuchienrai raikieutextcokem)))
(choncuver)
(chondiemxuatphat)
;(setq thuchienrai raikieutext)
(hoikieuraicd)
(command "ucs" "p")
(command "undo" "end")
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun c:rtd (/ ss doituong dsl dc ddd chondd chieudaicuver diemdau diemcuoi krai chieudaidoan slc sl index d2 p2 d5 p5 d3 p3 dt l m daidendiem)
(vl-load-com)
(command "undo" "be")
(command "ucs" "")
(chonnhomdoituong)
(choncuver)
(chondiemxuatphat)
(setq thuchienrai raikieukhongtext)
(hoikieuraicd)
(command "ucs" "p")
(command "undo" "end")
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun chondiemchuandoituong ()
(setq dc (getpoint "\nChon diem goc: "))
(cond
((= dc nil) (princ "\nChua chon duoc diem goc:") (chondiemchuandoituong))
((/= ss nil)))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun chonnhomdoituongtext ()
(if (null congthem)(setq congthem "1"))
(setq ddd (entsel "\nChon text mau"))
(while
(or
(null ddd)
(/= "TEXT" (cdr (assoc 0 (entget (car ddd)))))
)
(princ "\nDoi tuong khong phai la text! Chon lai")
(setq ddd (entsel "\nChon text mau"))
)
(setq sst (car ddd))
(setq DTTT (entget sst))
(setq NDTTT (cdr (assoc 1 DTTT)))
(Setq temp T)
(While temp
(setq dc (strcat "\nDon vi cong them la(" congthem "): "))
(Initget "D")
(setq str (getpoint dc))
(Cond
((= str "D") (setq congthem (getstring (strcat"\nDon vi cong them la <" congthem "> :"))))
(Progn
(Setq dc str)
(setq temp nil)
)
)
)
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun dotructiep ()
(cdxuatphatdo)
(cdketthucdo)
(Cond
((< daidendiemdo daidenhuongdo) (setq chieudaidoan (- daidenhuongdo daidendiemdo)))
((> daidendiemdo daidenhuongdo) (setq chieudaidoan (- daidendiemdo daidenhuongdo)))
)
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun cdxuatphatdo ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 545)
(setq diemchuando (getpoint "\nTu diem :"))
(setvar "osmode" 0)
(setq daidendiemdo (vlax-curve-getDistAtPoint chondd diemchuando))
(setvar "osmode"luubatdiem)
(cond
((= daidendiemdo nil) (princ "\nDiem vua chon khong nam tren duong dan, chon lai:") (cdxuatphatdo))
((/= daidendiemdo nil)))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun cdketthucdo ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 545)
(setq diemdinhhuongdo (getpoint diemchuando"\nDen diem :"))
(setvar "osmode" 0)
(setq daidenhuongdo (vlax-curve-getDistAtPoint chondd diemdinhhuongdo))
(setvar "osmode"luubatdiem)
(cond
((= daidenhuongdo nil) (princ "\nDiem vua chon khong nam tren duong dan, chon lai:") (cdketthucdo))
((/= daidenhuongdo nil)))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun cdxuatphat ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 545)
(setq diemchuan (getpoint "\nDiem bat dau rai tren duong dan:"))
(setvar "osmode" 0)
(setq daidendiem (vlax-curve-getDistAtPoint chondd diemchuan))
(setvar "osmode"luubatdiem)
(cond
((= daidendiem nil) (princ "\nDiem vua chon khong nam tren duong dan, chon lai:") (cdxuatphat))
((/= daidendiem nil)))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun cdketthuc ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 545)
(setq diemdinhhuong (getpoint diemchuan"\nDiem ket thuc rai tren duong dan:"))
(setvar "osmode" 0)
(setq daidenhuong (vlax-curve-getDistAtPoint chondd diemdinhhuong))
(setvar "osmode"luubatdiem)
(cond
((= daidenhuong nil) (princ "\nDiem vua chon khong nam tren duong dan, chon lai:") (cdketthuc))
((/= daidenhuong nil)))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun thongbaoketqua ()
(princ (strcat "\nChieu dai doan la: " (rtos chieudaitinh 2 4) doanhienthinoidung))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun chondiemxuatphat ()
(cdxuatphat)
(cdketthuc)
(Cond
((< daidendiem daidenhuong) (setq chieudaitinh (- daidenhuong daidendiem)) (setq dautinh +))
((> daidendiem daidenhuong) (setq chieudaitinh (- daidendiem daidenhuong)) (setq dautinh -))
)
(setq doanxuatphat daidendiem)
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun hoikieuraicd ()
(setq kraicd (strcase (getstring "\nKieu rai theo: Tinh /So luong/")))
(Cond
((= kraicd "T") (raisoluongtinh))
((/= kraicd "T")
(Cond
((= kraicd "S") (raisoluongcd))
((/= kraicd "S") (raikhoangcachcd))
)
)
)
(princ)
)
;;;;;;;;;;;;;;
(Defun raisoluongtinh ()
(setq slrai (getreal "\nRai them may lan khong tinh doi tuong tai diem bat dau rai:"))
(setq chieudaidoan (GETDIST "\nKhoang cach 1 lan rai: "))
(Cond
((= chieudaidoan 0) (dotructiep)))
(setq tongdoan (* slrai chieudaidoan))
(Cond
((> tongdoan chieudaitinh)
(princ (strcat "\nChieu dai doan la: " (rtos chieudaitinh 2 4) ", Yeu cau la: " (rtos chieudaidoan 2 4) "x" (rtos slrai 2 0) "=" (rtos tongdoan 2 4)))
(princ "\nVuot qua chieu dai cho phep, nhap lai:")
(raisoluongtinh))
((< tongdoan chieudaitinh)
(setq sl (fix (+ slrai 1)))
(setq sl (fix sl))
(setq doanhienthinoidung (strcat "\nDa thuc hien rai: " (rtos slrai 2 0) " lan voi khoang cach " (rtos chieudaidoan 2 4)))
(thuchienrai)
)
)
(princ)
)
;;;;;;;;;;;;;;
(Defun raikhoangcachcd ()
(setq chieudaidoan (GETDIST "\nKhoang cach 1 lan rai: "))
(Cond
((= chieudaidoan 0) (dotructiep)))
(Cond
((> chieudaidoan chieudaitinh)
(princ (strcat "\nChieu dai doan la: " (rtos chieudaitinh 2 4) ", Yeu cau la: " (rtos chieudaidoan 2 4)))
(princ "\nVuot qua chieu dai cho phep, nhap lai:")
(raikhoangcachcd))
((< chieudaidoan chieudaitinh)
(setq sol (+ (/ chieudaitinh chieudaidoan) 1))
(setq sl (fix sol))
(setq sl (fix sl))
(setq doanhienthinoidung (strcat "\nDa thuc hien rai: " (rtos sol 2 0) " lan voi khoang cach " (rtos chieudaidoan 2 4)))
(thuchienrai)
)
)
(princ)
)
;;;;;;;;;;;;;;
(Defun raisoluongcd ()
(setq slc (getreal "\nChia duong dan thanh may lan:"))
(setq chieudaidoan (/ chieudaitinh slc))
(setq sl (fix (+ 1 slc)))
(setq doanhienthinoidung (strcat "\nDa thuc hien rai: " (rtos slc 2 0) " lan voi khoang cach " (rtos chieudaidoan 2 4)))
(thuchienrai)
(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 doanxuatphat 0)
(setvar "osmode"luubatdiem)
(princ)
)
;;;;;;;;;;;;;;
(Defun raikieukhongtext (/ quaykhong)
(setq quaykhong (strcase (getstring "\nCo quay doi tuong vuong goc voi duong dan khong: Khong/")))
(Cond
((= quaykhong "K") (setq copygiua copykoquay))
((/= quaykhong "K")(setq copygiua copyquay))
)
(setq index -1)
(repeat sl
(setq index (1+ index))
(setq d2 (dautinh doanxuatphat (* chieudaidoan index)))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq p2 (vlax-curve-getPointAtDist chondd d2))
(setvar "osmode"luubatdiem)
(copygiua)
)
(thongbaoketqua)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun copycuoiquay()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq d5 (- (dautinh doanxuatphat (* chieudaidoan index)) 0.01))
(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 (+ (dautinh doanxuatphat (* 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 raikieutextcokem (/ quaykhong)
(setq quaykhong (strcase (getstring "\nCo quay doi tuong vuong goc voi duong dan khong: Khong/")))
(Cond
((= quaykhong "K") (setq copygiuatext copykoquaytext) (setq copygiua copykoquay))
((/= quaykhong "K")(setq copygiuatext copyquaytext) (setq copygiua copyquay))
)
(setq index -1)
(repeat sl
(setq index (1+ index))
(setq d2 (dautinh doanxuatphat (* chieudaidoan index)))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq p2 (vlax-curve-getPointAtDist chondd d2))
(setvar "osmode"luubatdiem)
(copygiuatext)
(copygiua)
)
(thongbaoketqua)
(princ)
)
;;;;;;;;;;;;;;
(Defun raikieutextkokem (/ quaykhong)
(setq quaykhong (strcase (getstring "\nCo quay doi tuong vuong goc voi duong dan khong: Khong/")))
(Cond
((= quaykhong "K") (setq copygiuatext copykoquaytext))
((/= quaykhong "K")(setq copygiuatext copyquaytext))
)
(setq index -1)
(repeat sl
(setq index (1+ index))
(setq d2 (dautinh doanxuatphat (* chieudaidoan index)))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq p2 (vlax-curve-getPointAtDist chondd d2))
(setvar "osmode"luubatdiem)
(copygiuatext)
)
(thongbaoketqua)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun copycuoiquaytext ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq d5 (- (dautinh doanxuatphat (* chieudaidoan index)) 0.01))
(setq p5 (vlax-curve-getPointAtDist chondd d5))
(command ".copy" sst "" dc p2)
(command ".rotate" "last" "" p2 p5)
(command ".rotate" "last" "" p2 180)
(setq congthems (atoi congthem))
(setq DTDM (entlast))
(if (and (>= (ascii NDTTT) 48) (<= (ascii NDTTT) 57))
(setq NDTTT (itoa (+ (atoi NDTTT) congthems)))
(setq NDTTT (chr (+ (ascii NDTTT) congthems)))
)
(setq Elist (entget DTDM))
(setq Oldlist (assoc 1 Elist))
(setq Oldtext (cdr Oldlist))
(setq Oldtext (strcase Oldtext nil))
(setq Newlist (cons '1 NDTTT))
(setq Elist (subst Newlist Oldlist Elist))
(entmod Elist)
(setvar "osmode"luubatdiem)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun COPYQUAYtext (/ p3)
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq d3 (+ (dautinh doanxuatphat (* chieudaidoan index)) 0.001))
(setq p3 (vlax-curve-getPointAtDist chondd d3))
(setvar "osmode"luubatdiem)
(Cond
((= p3 nil) (copycuoiquaytext))
((/= p3 nil)
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(command ".copy" sst "" dc p2)
(command ".rotate" "last" "" p2 p3)

(setq congthems (atoi congthem))
(setq DTDM (entlast))
(if (and (>= (ascii NDTTT) 48) (<= (ascii NDTTT) 57))
(setq NDTTT (itoa (+ (atoi NDTTT) congthems)))
(setq NDTTT (chr (+ (ascii NDTTT) congthems)))
)
(setq Elist (entget DTDM))
(setq Oldlist (assoc 1 Elist))
(setq Oldtext (cdr Oldlist))
(setq Oldtext (strcase Oldtext nil))
(setq Newlist (cons '1 NDTTT))
(setq Elist (subst Newlist Oldlist Elist))
(entmod Elist)
(setvar "osmode"luubatdiem)
)
)

(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun COPYKOQUAYtext ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(command ".copy" sst "" dc p2 "")
(setq congthems (atoi congthem))
(setq DTDM (entlast))
(if (and (>= (ascii NDTTT) 48) (<= (ascii NDTTT) 57))
(setq NDTTT (itoa (+ (atoi NDTTT) congthems)))
(setq NDTTT (chr (+ (ascii NDTTT) congthems)))
)
(setq Elist (entget DTDM))
(setq Oldlist (assoc 1 Elist))
(setq Oldtext (cdr Oldlist))
(setq Oldtext (strcase Oldtext nil))
(setq Newlist (cons '1 NDTTT))
(setq Elist (subst Newlist Oldlist Elist))
(entmod Elist)
(setvar "osmode"luubatdiem)
(princ)
)
;;;;;;;;;;;;;;


  • 1

Các bạn mới học LISP vào đây học và cho ý kiến nhé:

http://www.vlisp.blo...-loi-mo-au.html


#70 hakhoailang

hakhoailang

    biết lệnh rotate

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

Đã gửi 14 April 2012 - 03:35 PM

bác duy kiểm tra lại xem thế nào , chứ em rải dối tượng vuông góc lúc dc lúc ko . em tưởng em thao tác bị sai nhưng ko phải , hoặc em chưa hiểu rõ cách rải . em bị dính cái này mấy bản vẽ rồi . rải theo đường thẳng song song với trục X lúc nào cũng ok còn đường thẳng khác thì méo mồmhttp://www.cadviet.c...i_doi_tuong.dwg
  • 0

#71 Hainamnd86

Hainamnd86

    biết pan

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

Đã gửi 14 April 2012 - 03:59 PM

Hic! Các bác cho e hỏi. sao e dùng cái lisp này mà khi chọn đối tượng xong toàn báo lỗi "error: no function definition: VLAX-CURVE-GETENDPARAM" thôi. Bác nào giải quyết hộ e cái. em cảm ơn!
  • 0

#72 hakhoailang

hakhoailang

    biết lệnh rotate

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

Đã gửi 14 April 2012 - 11:39 PM

có cao thủ nào giúp em ko ?
  • 0

#73 begianglun

begianglun

    biết zoom

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

Đã gửi 08 August 2013 - 03:21 PM

mình xài lisp rải đối tượng nhưng ko thực hiện đuợc. xin cho hỏi  bị lỗi gì và xử lý sao nha? cám ơn 


  • 0

#74 begianglun

begianglun

    biết zoom

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

Đã gửi 08 August 2013 - 03:27 PM

mình xài lisp rải đối tượng nhưng ko thực hiện đuợc. xin cho hỏi  bị  lỗi gì và xử lý sao nha? cám ơn 

http://i.upanh.com/vpxaos


  • 0

#75 thanhlong.hygt

thanhlong.hygt

    biết vẽ pline

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

Đã gửi 16 September 2013 - 07:58 PM

Mình nghĩ lisp trên bổ sung thêm một tính năng rải đối tượng tại đỉnh và tại giao giữa các đường dẫn với các đối tượng chọn thì quá tổng quát. K biết mọi người thấy như thế nào chứ mình thấy tiện ích đó hay dùng hơn. Thank sờ kiu


  • 0

#76 dinang

dinang

    Chưa sử dụng CAD

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

Đã gửi 01 November 2013 - 06:59 PM

rải mà khoảng cách ko đều nhau dùng lệnh gì thế các bác?giup e vs


  • 0

#77 Trà Đá

Trà Đá

    biết vẽ line

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

Đã gửi 16 December 2013 - 04:54 PM

Em có lisp sau rải chấm hatch tròn tại các điểm endpoint của đối tượng. Bây giờ em muốn cải tiến lisp trên 1 chút là cho phép chọn 1 text đi kèm và cũng rải tăng dần tại endpoint theo bước +1. Nhờ các bác giúp đỡ ạ:
 

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.c...line-cho-truoc/
(vl-load-com)
(defun GetVer (e / i L)

(setq i 0 L nil)

(repeat (fix (+ (vlax-curve-getEndParam e) 1))

(setq L (append L (list (vlax-curve-getPointAtParam e i))))

(setq i (1+ i))

)

L

)

(defun C:ttt(/ ss_rai pt_rai ss n e lstPt x)

(princ "\nChon doi tuong muon rai")

(setq ss_rai (ssget))

(setq pt_rai (getpoint "\nChon diem chen"))

(princ "\nChon doi tuong duong dan")

(setq ss (ssget (list (cons 0 "*POLYLINE"))))

(repeat (setq n (sslength ss))

(setq e (ssname ss (setq n (1- n))))

(setq lstPt (GetVer e))

(foreach x lstPt (command "copy" ss_rai "" pt_rai x))

)

(princ)

)


  • 0

#78 ntt_present

ntt_present

    biết vẽ arc

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

Đã gửi 16 April 2014 - 08:28 AM

Lạy Chúa, đang chết đuối thì gặp Lisp này, cảm ơn bạn Phạm Quốc Duy nhiều lắm, cho mình double thank nhé :D


  • 0

#79 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:52 PM

Đã chỉnh lại lisp thêm chức năng rải text thay đổi giá trị.
-Tên lệnh: RT.
-Hỏi chọn đối tượng ko phải text thì hòi miết đến khi nào chọn đúng text thì hỏi tiếp điểm chuẩn, trong dòng hỏi điểm chuần có lồng giá trị thay đổi text mặc định là 1 (nghĩa là giá trị text thay đổi theo kiểu cộng 1 giá trị) nếu muốn thay đổi giá trị này thì đừng chọn điểm chuẩn vội mà gỏ d enter lisp hỏi giá trị cộng thêm bạn nhập vào (nhận cả giá trị âm nhé). Nhập xong lisp tiếp tục hỏi chọn điềm chuẩn.
-Hỏi chọn các đối tượng muốn rải theo các đối tượng này là bất cứ cái gì bạn muốn lisp sẽ rải nhóm đối tượng này và cái text bạn chọn ban đầu (giá trị cái text sẽ thay đổi còn các đối tượng chép theo giữ nguyên) nếu không chép theo cái gì thì enter.
-Các bước tiếp theo giống như cũ.
*Trong này có lệnh chính:
-RTD: rải từ điểm đã trình bày hôm trước.
-RDT: rải đồi tượng đã trình bày hôm trước.
-RT: rải text trình bày hôm nay.
*Và 1 lệnh khuyến mại:
-DTD: đo từ điểm, dùng đo độ dài đối tượng giữa 2 điểm trên đối tượng đó.
 

(Defun c:rdt (/ ss doituong dsl dc ddd chondd chieudaicuver diemdau diemcuoi krai chieudaidoan slc sl index d2 p2 d5 p5 d3 p3 dt l m)
(vl-load-com)
(command "undo" "be")
(command "ucs" "")
(chonnhomdoituong)
(choncuver)

(setq diemchuan (vlax-curve-getPointAtDist chondd 0))
(setq diemdinhhuong (vlax-curve-getPointAtDist chondd chieudaicuver))

(setq chieudaitinh chieudaicuver) 
(setq dautinh +) 

(setq thuchienrai raikieukhongtext)
(hoikieuraicd)
(command "ucs" "p")
(command "undo" "end")
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun c:dtd (/ ss doituong dsl dc ddd chondd chieudaicuver diemdau diemcuoi krai chieudaidoan slc sl index d2 p2 d5 p5 d3 p3 dt l m daidendiem)
(vl-load-com)
(command "undo" "be")
(command "ucs" "")
(choncuver)
(cdxuatphatdo)
(cdketthucdo)
(Cond
((< daidendiemdo daidenhuongdo) (setq chieudaidoan (- daidenhuongdo daidendiemdo))) 
((> daidendiemdo daidenhuongdo) (setq chieudaidoan (- daidendiemdo daidenhuongdo)))
) 
(command "undo" "end")
(princ (strcat "\nChieu dai doan do la: " (rtos chieudaidoan 2 4))) 
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun c:rt (/ ss doituong dsl dc ddd chondd chieudaicuver diemdau diemcuoi krai chieudaidoan slc sl index d2 p2 d5 p5 d3 p3 dt l m daidendiem)
(vl-load-com)
(command "undo" "be")
(command "ucs" "")
(chonnhomdoituongtext)

(princ "\nChon doi tuong rai kem theo text :")
(setq ss (ssget))
(cond 
((= ss nil) (setq thuchienrai raikieutextkokem))
((/= ss nil) (setq thuchienrai raikieutextcokem))) 

(choncuver)
(chondiemxuatphat)
;(setq thuchienrai raikieutext)
(hoikieuraicd)
(command "ucs" "p")
(command "undo" "end")
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun c:rtd (/ ss doituong dsl dc ddd chondd chieudaicuver diemdau diemcuoi krai chieudaidoan slc sl index d2 p2 d5 p5 d3 p3 dt l m daidendiem)
(vl-load-com)
(command "undo" "be")
(command "ucs" "")
(chonnhomdoituong)
(choncuver)
(chondiemxuatphat)
(setq thuchienrai raikieukhongtext)
(hoikieuraicd)
(command "ucs" "p")
(command "undo" "end")
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun chondiemchuandoituong ()
(setq dc (getpoint "\nChon diem goc: "))
(cond 
((= dc nil) (princ "\nChua chon duoc diem goc:") (chondiemchuandoituong))
((/= ss nil))) 
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun chonnhomdoituongtext ()
(if (null congthem)(setq congthem "1"))
(setq ddd (entsel "\nChon text mau"))
(while
(or
(null ddd)
(/= "TEXT" (cdr (assoc 0 (entget (car ddd)))))
)
(princ "\nDoi tuong khong phai la text! Chon lai")
(setq ddd (entsel "\nChon text mau"))
)
(setq sst (car ddd))
(setq DTTT (entget sst))
(setq NDTTT (cdr (assoc 1 DTTT)))
(Setq temp T)
(While temp
(setq dc (strcat "\nDon vi cong them la(" congthem "): ")) 
(Initget "D")
(setq str (getpoint dc))
(Cond
((= str "D") (setq congthem (getstring (strcat"\nDon vi cong them la <" congthem "> :"))))
(Progn
(Setq dc str)
(setq temp nil)
)
)
)
(princ)
)

;;;;;;;;;;;;;;;;;
(Defun dotructiep ()
(cdxuatphatdo)
(cdketthucdo)
(Cond
((< daidendiemdo daidenhuongdo) (setq chieudaidoan (- daidenhuongdo daidendiemdo))) 
((> daidendiemdo daidenhuongdo) (setq chieudaidoan (- daidendiemdo daidenhuongdo)))
) 
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun cdxuatphatdo ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 545)
(setq diemchuando (getpoint "\nTu diem :"))
(setvar "osmode" 0)
(setq daidendiemdo (vlax-curve-getDistAtPoint chondd diemchuando))
(setvar "osmode"luubatdiem)
(cond 
((= daidendiemdo nil) (princ "\nDiem vua chon khong nam tren duong dan, chon lai:") (cdxuatphatdo))
((/= daidendiemdo nil))) 
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun cdketthucdo ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 545)
(setq diemdinhhuongdo (getpoint diemchuando"\nDen diem :"))
(setvar "osmode" 0)
(setq daidenhuongdo (vlax-curve-getDistAtPoint chondd diemdinhhuongdo))
(setvar "osmode"luubatdiem)
(cond 
((= daidenhuongdo nil) (princ "\nDiem vua chon khong nam tren duong dan, chon lai:") (cdketthucdo))
((/= daidenhuongdo nil))) 
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun cdxuatphat ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 545)
(setq diemchuan (getpoint "\nDiem bat dau rai tren duong dan:"))
(setvar "osmode" 0)
(setq daidendiem (vlax-curve-getDistAtPoint chondd diemchuan))
(setvar "osmode"luubatdiem)
(cond 
((= daidendiem nil) (princ "\nDiem vua chon khong nam tren duong dan, chon lai:") (cdxuatphat))
((/= daidendiem nil))) 
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun cdketthuc ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 545)
(setq diemdinhhuong (getpoint diemchuan"\nDiem ket thuc rai tren duong dan:"))
(setvar "osmode" 0)
(setq daidenhuong (vlax-curve-getDistAtPoint chondd diemdinhhuong))
(setvar "osmode"luubatdiem)
(cond 
((= daidenhuong nil) (princ "\nDiem vua chon khong nam tren duong dan, chon lai:") (cdketthuc))
((/= daidenhuong nil))) 
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun thongbaoketqua ()
(princ (strcat "\nChieu dai doan la: " (rtos chieudaitinh 2 4) doanhienthinoidung)) 
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun chondiemxuatphat ()
(cdxuatphat)
(cdketthuc)
(Cond
((< daidendiem daidenhuong) (setq chieudaitinh (- daidenhuong daidendiem)) (setq dautinh +)) 
((> daidendiem daidenhuong) (setq chieudaitinh (- daidendiem daidenhuong)) (setq dautinh -))
) 
(setq doanxuatphat daidendiem)
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun hoikieuraicd ()
(setq kraicd (strcase (getstring "\nKieu rai theo: Tinh /So luong/")))

(Cond
((= kraicd "T") (raisoluongtinh))
((/= kraicd "T") 
(Cond
((= kraicd "S") (raisoluongcd))
((/= kraicd "S") (raikhoangcachcd))
) 
)
) 
(princ)
)
;;;;;;;;;;;;;;
(Defun raisoluongtinh ()
(setq slrai (getreal "\nRai them may lan khong tinh doi tuong tai diem bat dau rai:"))
(setq chieudaidoan (GETDIST "\nKhoang cach 1 lan rai: "))
(Cond
((= chieudaidoan 0) (dotructiep)))

(setq tongdoan (* slrai chieudaidoan))
(Cond
((> tongdoan chieudaitinh) 
(princ (strcat "\nChieu dai doan la: " (rtos chieudaitinh 2 4) ", Yeu cau la: " (rtos chieudaidoan 2 4) "x" (rtos slrai 2 0) "=" (rtos tongdoan 2 4))) 
(princ "\nVuot qua chieu dai cho phep, nhap lai:") 
(raisoluongtinh))
((< tongdoan chieudaitinh) 
(setq sl (fix (+ slrai 1)))
(setq sl (fix sl))
(setq doanhienthinoidung (strcat "\nDa thuc hien rai: " (rtos slrai 2 0) " lan voi khoang cach " (rtos chieudaidoan 2 4))) 
(thuchienrai)
)
) 
(princ)
)
;;;;;;;;;;;;;;
(Defun raikhoangcachcd ()
(setq chieudaidoan (GETDIST "\nKhoang cach 1 lan rai: "))
(Cond
((= chieudaidoan 0) (dotructiep)))
(Cond
((> chieudaidoan chieudaitinh) 
(princ (strcat "\nChieu dai doan la: " (rtos chieudaitinh 2 4) ", Yeu cau la: " (rtos chieudaidoan 2 4))) 
(princ "\nVuot qua chieu dai cho phep, nhap lai:") 
(raikhoangcachcd))
((< chieudaidoan chieudaitinh) 
(setq sol (+ (/ chieudaitinh chieudaidoan) 1))
(setq sl (fix sol))
(setq sl (fix sl))
(setq doanhienthinoidung (strcat "\nDa thuc hien rai: " (rtos sol 2 0) " lan voi khoang cach " (rtos chieudaidoan 2 4))) 
(thuchienrai)
)
) 
(princ)
)
;;;;;;;;;;;;;;
(Defun raisoluongcd ()
(setq slc (getreal "\nChia duong dan thanh may lan:"))
(setq chieudaidoan (/ chieudaitinh slc))
(setq sl (fix (+ 1 slc)))
(setq doanhienthinoidung (strcat "\nDa thuc hien rai: " (rtos slc 2 0) " lan voi khoang cach " (rtos chieudaidoan 2 4))) 
(thuchienrai)
(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 doanxuatphat 0)
(setvar "osmode"luubatdiem)
(princ)
)
;;;;;;;;;;;;;;
(Defun raikieukhongtext (/ quaykhong)

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

(setq index -1)

(repeat sl
(setq index (1+ index))
(setq d2 (dautinh doanxuatphat (* chieudaidoan index)))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq p2 (vlax-curve-getPointAtDist chondd d2))
(setvar "osmode"luubatdiem)
(copygiua)
)
(thongbaoketqua)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun copycuoiquay()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq d5 (- (dautinh doanxuatphat (* chieudaidoan index)) 0.01))
(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 (+ (dautinh doanxuatphat (* 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 raikieutextcokem (/ quaykhong)

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

(setq index -1)

(repeat sl
(setq index (1+ index))
(setq d2 (dautinh doanxuatphat (* chieudaidoan index)))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq p2 (vlax-curve-getPointAtDist chondd d2))
(setvar "osmode"luubatdiem)
(copygiuatext)
(copygiua)
)
(thongbaoketqua)
(princ)
)
;;;;;;;;;;;;;;
(Defun raikieutextkokem (/ quaykhong)

(setq quaykhong (strcase (getstring "\nCo quay doi tuong vuong goc voi duong dan khong: Khong/")))
(Cond
((= quaykhong "K") (setq copygiuatext copykoquaytext))
((/= quaykhong "K")(setq copygiuatext copyquaytext))
) 

(setq index -1)

(repeat sl
(setq index (1+ index))
(setq d2 (dautinh doanxuatphat (* chieudaidoan index)))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq p2 (vlax-curve-getPointAtDist chondd d2))
(setvar "osmode"luubatdiem)
(copygiuatext)
)
(thongbaoketqua)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun copycuoiquaytext ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq d5 (- (dautinh doanxuatphat (* chieudaidoan index)) 0.01))
(setq p5 (vlax-curve-getPointAtDist chondd d5))
(command ".copy" sst "" dc p2)
(command ".rotate" "last" "" p2 p5)
(command ".rotate" "last" "" p2 180)
(setq congthems (atoi congthem)) 
(setq DTDM (entlast))

(if (and (>= (ascii NDTTT) 48) (<= (ascii NDTTT) 57))
(setq NDTTT (itoa (+ (atoi NDTTT) congthems)))
(setq NDTTT (chr (+ (ascii NDTTT) congthems)))
)

(setq Elist (entget DTDM)) 
(setq Oldlist (assoc 1 Elist)) 
(setq Oldtext (cdr Oldlist))
(setq Oldtext (strcase Oldtext nil))
(setq Newlist (cons '1 NDTTT))
(setq Elist (subst Newlist Oldlist Elist))
(entmod Elist)
(setvar "osmode"luubatdiem)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun COPYQUAYtext (/ p3)
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq d3 (+ (dautinh doanxuatphat (* chieudaidoan index)) 0.001))
(setq p3 (vlax-curve-getPointAtDist chondd d3))
(setvar "osmode"luubatdiem)
(Cond
((= p3 nil) (copycuoiquaytext))
((/= p3 nil) 
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(command ".copy" sst "" dc p2)
(command ".rotate" "last" "" p2 p3)


(setq congthems (atoi congthem)) 
(setq DTDM (entlast))

(if (and (>= (ascii NDTTT) 48) (<= (ascii NDTTT) 57))
(setq NDTTT (itoa (+ (atoi NDTTT) congthems)))
(setq NDTTT (chr (+ (ascii NDTTT) congthems)))
)

(setq Elist (entget DTDM)) 
(setq Oldlist (assoc 1 Elist)) 
(setq Oldtext (cdr Oldlist))
(setq Oldtext (strcase Oldtext nil))
(setq Newlist (cons '1 NDTTT))
(setq Elist (subst Newlist Oldlist Elist))
(entmod Elist)
(setvar "osmode"luubatdiem)
)
) 


(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun COPYKOQUAYtext ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(command ".copy" sst "" dc p2 "")
(setq congthems (atoi congthem)) 
(setq DTDM (entlast))

(if (and (>= (ascii NDTTT) 48) (<= (ascii NDTTT) 57))
(setq NDTTT (itoa (+ (atoi NDTTT) congthems)))
(setq NDTTT (chr (+ (ascii NDTTT) congthems)))
)

(setq Elist (entget DTDM)) 
(setq Oldlist (assoc 1 Elist)) 
(setq Oldtext (cdr Oldlist))
(setq Oldtext (strcase Oldtext nil))
(setq Newlist (cons '1 NDTTT))
(setq Elist (subst Newlist Oldlist Elist))
(entmod Elist)
(setvar "osmode"luubatdiem)
(princ)
)
;;;;;;;;;;;;;;

Bác ơi lips quá tuyệt vời ạ. Nhưng bác cho em thêm lựa chọn rải block nữa được ko. Em rải block ko được bác ạ. bác xem lại xem có phải không giúp em.


  • 0

#80 nhn198

nhn198

    biết pan

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

Đã gửi 29 July 2014 - 03:55 PM

anh duy oi,cai lisp rải cọc kèm chử (rt)có thể nào chỉnh sửa lại

vd rải số 1,2,3,4,5,....thành C1,C2,C3,C4.....

dược không a.


  • 0