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

Tháng 6 10, 2011

Nhờ bác Duy và các bác trên diễn đàn cải tiến lisp rải đối tượng của bác Duy giùm em với yêu cầu như sau:

Đối tượng nguồn là text, sau khi rải, text sẽ được chèn vào điểm là giao điểm của các đường thẳng or cung tròn, or polyline với đường dẫn.Các text rải sẽ tăng dần đều.Em gửi hình minh họa để nhờ các bác chỉnh giùm em.Thanks các anh chị trên diễn đàn

Vụ text tăng dần điều thì mình làm đc nhưng mình ko biết cách tìm giao điểm của các đường bạn chọn.

Tháng 6 10, 2011

Vụ text tăng dần điều thì mình làm đc nhưng mình ko biết cách tìm giao điểm của các đường bạn chọn.

Dạ, vậy nhờ anh chỉnh cho em cái lisp tăng đều text khi rải.còn việc rải đúng giao điểm có thời gian anh nghiên cứu giùm em với nha

Tháng 6 20, 2011

*Đã hoàn thiện lisp rải đối tượng theo đường dẩn.

-Tên lệnh: RTD (rải từ điểm)

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

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

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

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

-Hỏi điểm đầu và điểm cuối đoạn rải (2 điểm này phải nằm trên đường dẩn nếu kông thì lisp sẽ hỏi lại. Sẽ thực hiện rải trong khoảng từ điểm thứ nhất đến điểm thứ 2 nếu bạn muốn rải nguyên đường thì chọn 2 điểm đầu mút)

-Hỏi “Kieu rai theo: Tinh/So luong/(khoang)” :

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

+Rải theo cách tính toán thì nhập T enter.

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

-Lựa chọn rải theo số lượng thì hỏi số lượng dùng chia điều đoạn rải cho số lượng.

-Lựa chọn Khoảng cách thì hỏi khoảng cách (Khoảng cách này nhập số bằng bàn pím hoặc chọn 2 điểm bất kỳ trên màn hình và lấy ra khoảng cách theo đường chom bay giữa 2 điểm). Nếu bạn muốn lấy khảng cách giữa 2 điểm trên đường dẩn (khoảng cách tính men theo đường dẩn giửa 2 điểm) thì nhập 0 (số không) lisp sẽ hỏi điểm đầu và điểm cuối đoạn đo (2 điểm này phải nằm trên đường dẩn nếu kông thì lisp sẽ hỏi lại).

-Lựa chọn tính thì sẽ hỏi khoảng cách và số lượng rải. Nếu số lượng nhân khoảng cách nhập vào dài hơn đoạn rải thì lisp yêu cầu nhập lại. Đoạn nhập khoảng cách tương tự như trên. Bắt đầu rải từ điểm thứ nhất.

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

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

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

Tải đây

Tháng 6 21, 2011

Dạ, vậy nhờ anh chỉnh cho em cái lisp tăng đều text khi rải.còn việc rải đúng giao điểm có thời gian anh nghiên cứu giùm em với nha

Bạn nêu lại yêu cầu cho mình tí. Trình tự và ết quả mong muốn nhé.

Tháng 6 21, 2011

Bạn nêu lại yêu cầu cho mình tí. Trình tự và ết quả mong muốn nhé.

Em gửi anh hình minh họa

Yêu cầu của em như sau:

1. Đối tượng nguồn được chọn là text

2. Đường dẫn là polyline

3. Rải theo khoảng cách.Khoảng các này được xác định từ giao điểm của các polyline,line or arc... giao với đường dẫn, rải từ điểm đầu và điểm cuối của đường dẫn.Trong quá trình rải, số thự tự của text tăng dần.

4. Các nội dung còn lại như xoay text hay gì đó thì lisp của anh đã thực hiện rất tốt rồi

Trên đây là yêu cầu của em, nhờ anh và các bác trên diễn đàn giúp em ah.Em cảm ơn các anh nhiều

Tháng 6 21, 2011

Em gửi anh hình minh họa

Yêu cầu của em như sau:

1. Đối tượng nguồn được chọn là text

2. Đường dẫn là polyline

3. Rải theo khoảng cách.Khoảng các này được xác định từ giao điểm của các polyline,line or arc... giao với đường dẫn, rải từ điểm đầu và điểm cuối của đường dẫn.Trong quá trình rải, số thự tự của text tăng dần.

4. Các nội dung còn lại như xoay text hay gì đó thì lisp của anh đã thực hiện rất tốt rồi

Trên đây là yêu cầu của em, nhờ anh và các bác trên diễn đàn giúp em ah.Em cảm ơn các anh nhiều

Hề hề hề,

Bạn hãy lưu ý các trường hợp sau:

1/- Giữa polyline của bạn với các polyline khác có thể có nhiều hơn một điểm cắt đó.

2/- Trật tự ghi text được sắp xếp thế nào theo tọa độ giao điểm hay theo thứ tự các polyline nhánh????

Tháng 6 21, 2011

Hề hề hề,

Bạn hãy lưu ý các trường hợp sau:

1/- Giữa polyline của bạn với các polyline khác có thể có nhiều hơn một điểm cắt đó.

2/- Trật tự ghi text được sắp xếp thế nào theo tọa độ giao điểm hay theo thứ tự các polyline nhánh????

Cảm ơn bác Bình đã quan tâm đến vấn đề của em.Em trả lời các lưu ý của bác như sau:

1. Ý kiến nhiều hơn 1 điểm giao cắt là sao vậy bác, em chưa hiểu.Nhưng yêu cầu của em thì các đối tượng này do em bố trí nên chỉ giao cắt với đường dẫn tại 1 điểm thôi bác ah

2. Text rải theo thứ tự tăng dần từ đầu đến cuối đường dẫn ( hướng tuyến mình đã chọn từ lựa chọn có trong lisp của bác Duy)

Tháng 6 21, 2011

Cảm ơn bác Bình đã quan tâm đến vấn đề của em.Em trả lời các lưu ý của bác như sau:

1. Ý kiến nhiều hơn 1 điểm giao cắt là sao vậy bác, em chưa hiểu.Nhưng yêu cầu của em thì các đối tượng này do em bố trí nên chỉ giao cắt với đường dẫn tại 1 điểm thôi bác ah

2. Text rải theo thứ tự tăng dần từ đầu đến cuối đường dẫn ( hướng tuyến mình đã chọn từ lựa chọn có trong lisp của bác Duy)

Như đã nói mình bí vấn đề tìm giao điểm nên mình thính giải bài toán của bạn như sau:

-Hỏi chọn text mẫu, hỏi chọn điểm chuẩn, Hỏi có cần quay kết quả theo đường dẩn không:

+Nếu không thì chọn các điểm đến text sẽ được copy đến và tăng giá trị (giá trị này mặc định là +1 có cho phép nhập lại và nhận cả giá trị âm).

+Nếu có thì hỏi chọn đường dẩn, và các điểm đến (các điểm này phải nằm trên đường dẩn). Kết quả tương tự như trên nhưng có quay kết quả theo đường dẩn.

*Vậy lệnh này thao tác này giống copy text thay đổi giá trị. Bạn thấy ổn thì mình viết.

Tháng 6 21, 2011

Như đã nói mình bí vấn đề tìm giao điểm nên mình thính giải bài toán của bạn như sau:

-Hỏi chọn text mẫu, hỏi chọn điểm chuẩn, Hỏi có cần quay kết quả theo đường dẩn không:

+Nếu không thì chọn các điểm đến text sẽ được copy đến và tăng giá trị (giá trị này mặc định là +1 có cho phép nhập lại và nhận cả giá trị âm).

+Nếu có thì hỏi chọn đường dẩn, và các điểm đến (các điểm này phải nằm trên đường dẩn). Kết quả tương tự như trên nhưng có quay kết quả theo đường dẩn.

*Vậy lệnh này thao tác này giống copy text thay đổi giá trị. Bạn thấy ổn thì mình viết.

Dạ đúng rồi đó anh.Anh viết giùm em một lisp theo như bài toán mà anh đã giải thích giùm em ah

Tháng 6 21, 2011

Nhờ bác Duy và các bác trên diễn đàn cải tiến lisp rải đối tượng của bác Duy giùm em với yêu cầu như sau:

Đối tượng nguồn là text, sau khi rải, text sẽ được chèn vào điểm là giao điểm của các đường thẳng or cung tròn, or polyline với đường dẫn.Các text rải sẽ tăng dần đều.Em gửi hình minh họa để nhờ các bác chỉnh giùm em.Thanks các anh chị trên diễn đàn

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

Tháng 6 21, 2011

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.com/upfiles/3/drawing1_11.rar

Tháng 6 21, 2011

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.com/upfiles/3/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à ^^ :)

Tháng 6 22, 2011

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.com/upfiles/3/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)))))    )

Tháng 6 23, 2011

- 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

Tháng 6 23, 2011

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

Tháng 7 4, 2011

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

Tháng 7 4, 2011

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

Tháng 7 4, 2011

Đã 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

Tháng 3 21, 2012

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

Tháng 4 14, 2012

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

Tháng 4 14, 2012

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!

Tháng 4 14, 2012

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

Tháng 8 8, 2013

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

Tháng 8 8, 2013

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

Tháng 9 16, 2013

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

Đăng nhập

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

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

duy782006 1.517

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

cd2k44 123

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

duy782006 1.517

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

duy782006 1.517

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

cd2k44 123

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

phamthanhbinh 3.146

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

cd2k44 123

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

duy782006 1.517

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

cd2k44 123

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

gia_bach 1.548

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

cd2k44 123

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ketxu 2.983

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

gia_bach 1.548

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

cd2k44 123

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

duy782006 1.517

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

duy782006 1.517

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

chaytheomay 2

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

cd2k44 123

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

nguyentienthanhddksct 6

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

hakhoailang 2