Đến nội dung


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

Viết Lisp theo yêu cầu


  • Chủ đề bị khóa Chủ đề bị khóa
2780 replies to this topic

#1801 sv_nuce

sv_nuce

    biết zoom

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

Đã gửi 07 April 2009 - 06:19 PM

Em đang cần dùng một cái lisp như sau:
+ B1: offset đối tượng là một hình chữ nhật có sẵn như lệnh offset thường dùng.
+ B2: nối các góc của hình chữ nhật bên trong với góc của hình chữ nhật gốc.
Các pro giúp em viết hộ cái lisp này nhé.
Em đang cần dùng gấp để vẽ mấy cái chi tiết cửa sổ. Vẽ thủ công theo 2 bước trên lâu quá!
Bây giờ nếu mà offset nó nối luôn các góc cho thì nhanh hơn bao nhiêu!
Địa chỉ email:sv_nuce@yahoo.com.vn
  • 0
Diễn đàn cadviet thiệt là PRO!

#1802 q288

q288

    biết lệnh fillet

  • Members
  • PipPipPipPip
  • 209 Bài viết
Điểm đánh giá: 164 (tàm tạm)

Đã gửi 07 April 2009 - 08:42 PM

Chào cả nhà !
Mình thấy ở ngoài có người hỏi nhưng chưa ai trả lời ! Mình cũng đang cần cái này mong cả nhà giúp đỡ !
Mình đang rất cần lisp kiểm tra như sau:

+ layer 1 là Pline (mầu xanh cây) bắt snap hai đầu vào layer 2 cũng là Pline (mầu đen)
Nếu hai đầu layer 1 chưa tới hoặc vượt quá layer 2 thì lisp sẽ báo lỗi bằng point hoặc Circle
Mong cả nhà giúp mình với cám ơn nhiều lắm !

Ảnh Minh họa :Hình đã gửi


Bạn có thể nói rõ hơn đc không? Bạn muốn check toàn bản vẽ hay chỉ nhấp chọn đg biên rồi chọn tiếp các pline cần kiểm tra? Nếu check toàn bản vẽ thì phức tạp lắm, nhất là bản vẽ có nhiều pline như bình đồ chẳng hạn.
  • 0

#1803 thanhlichtran

thanhlichtran

    Chưa sử dụng CAD

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

Đã gửi 07 April 2009 - 09:11 PM

Bạn có thể nói rõ hơn đc không? Bạn muốn check toàn bản vẽ hay chỉ nhấp chọn đg biên rồi chọn tiếp các pline cần kiểm tra? Nếu check toàn bản vẽ thì phức tạp lắm, nhất là bản vẽ có nhiều pline như bình đồ chẳng hạn.

Chào bạn q288 Mình muốn check toàn bản vẽ nhưng chỉ bật hai layer đó lên để check thôi. Bạn giúp mình đi . Mình phải check rất nhiều mà bằng mắt thwờng thì rất lâu mới được một cái .
File mẫu : http://www.cadviet.c...es/file_mau.dwg
  • 0

#1804 q288

q288

    biết lệnh fillet

  • Members
  • PipPipPipPip
  • 209 Bài viết
Điểm đánh giá: 164 (tàm tạm)

Đã gửi 07 April 2009 - 09:54 PM

Chào bạn duy782006,mình xin giải thích rõ hơn
Nhờ các bạn viết dùm mình đọan code "Chèn block vào trung điểm của các đường thẳng được chọn", trình tự như sau:
- Gõ tên lệnh
- Chương trình sẽ yêu cầu chọn block cần insert (chỉ đường dẫn đến thư mục chứa file block)
- Chương trinh sẽ yêu cầu chọn các đường thẳng trong bản vẽ để insert block
- Thực thi lệnh
- Kết quả là block sẽ chèn và tự động align dọc theo phương của các đường thẳng được chọn
Xin chân thành cảm ơn!


Bạn thử dùng code sau đây xem sao nhé. Tên lệnh là ins.

(defun c:ins()
(setq bl (getfiled "Open file" (getvar "dwgprefix") "dwg" 4)
ss (ssget '((0 . "LINE")))
n 0)
(setq os (getvar "OSMODE"))
(setvar "OSMODE" 0)
(repeat (sslength ss)
(setq v (ssname ss n)
p1 (cdr (assoc 10 (entget v)))
p2 (cdr (assoc 11 (entget v)))
pm (polar p1 (angle p1 p2) (* 0.5 (distance p1 p2))))
(command "-insert" bl pm "" "" (* 180 (/ (angle p1 p2) pi)))
(setq n (1+ n)))
(setvar "OSMODE" os)
)
  • 2

#1805 anhlylyhuynh

anhlylyhuynh

    biết zoom

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

Đã gửi 08 April 2009 - 08:34 AM

Bạn thử dùng code sau đây xem sao nhé. Tên lệnh là ins.

(defun c:ins()
(setq bl (getfiled "Open file" (getvar "dwgprefix") "dwg" 4)
ss (ssget '((0 . "LINE")))
n 0)
(setq os (getvar "OSMODE"))
(setvar "OSMODE" 0)
(repeat (sslength ss)
(setq v (ssname ss n)
p1 (cdr (assoc 10 (entget v)))
p2 (cdr (assoc 11 (entget v)))
pm (polar p1 (angle p1 p2) (* 0.5 (distance p1 p2))))
(command "-insert" bl pm "" "" (* 180 (/ (angle p1 p2) pi)))
(setq n (1+ n)))
(setvar "OSMODE" os)
)

Cám ơn bạn rất nhiều, đúng là lisp mình cần
  • 1

#1806 nguyenkhoadung98

nguyenkhoadung98

    biết vẽ pline

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

Đã gửi 08 April 2009 - 12:36 PM

cảm ơn sự nhiệt tình của bạn Bình và Bác Tue mình đã chạy thử lisp của bạn Bình và thấy các vấn đề sau :

1- với đuờng PLine thì nói chung là đã ok

2-với đuờng SPline và đuờng cong thì block nó bị nguợc và thứ tự đánh chữ bị đảo nguợc sau text gốc là T1/L1-1A thì sẽ phải đến T1/L1-2B rồi đến T1/L1-3C rôi đến T1/L1-4A,T1/L1-5B......( mình chủ yếu là dùng đường loại SPline :cry: )

3- về text thì mình cần các text sau giống text gốc về khoảng cách với điểm gốc và song song với tiếp tuyến của đường chuẩn như trong file kèm theo mình đã vẽ chi tiếp ( vi khó nói miêu tả :cry: )

4- về số ký tự thì text mẫu ban đầu của mình luôn là T1/L1-1A ( không hiểu như vậy có dễ dàng hơn cho các bạn kô )

file đính kèm ( mình đã chuyển về CAD 2004 )
http://www.cadviet.com/upfiles/12.dwg


  • 0

#1807 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3805 (đỉnh cao)

Đã gửi 08 April 2009 - 12:57 PM

Em đang cần dùng một cái lisp như sau:
+ B1: offset đối tượng là một hình chữ nhật có sẵn như lệnh offset thường dùng.
+ B2: nối các góc của hình chữ nhật bên trong với góc của hình chữ nhật gốc.
Các pro giúp em viết hộ cái lisp này nhé.
Em đang cần dùng gấp để vẽ mấy cái chi tiết cửa sổ. Vẽ thủ công theo 2 bước trên lâu quá!
Bây giờ nếu mà offset nó nối luôn các góc cho thì nhanh hơn bao nhiêu!
Địa chỉ email:sv_nuce@yahoo.com.vn

Bạn thử dùng đoạn Lisp này xem :
(defun c:bcn(/ hcn kc phia entL entn a b c d e f g h)
(setq hcn (ssget '((0 . "LWPOLYLINE")))
kc (getdist "\n Khoang cach offset :")
phia (getpoint "\n Phia offset :")

)
(setq entL (entget(ssname hcn 0)))
(setq
a (List (cadr(nth 14 entL)) (caddr(nth 14 entL)) 0.0)
b (List (cadr(nth 18 entL)) (caddr(nth 18 entL)) 0.0)
c (List (cadr(nth 22 entL)) (caddr(nth 22 entL)) 0.0)
d (List (cadr(nth 26 entL)) (caddr(nth 26 entL)) 0.0)
)

(command "offset" kc hcn phia "")


(setq entn (entget(entlast)))
(setq
e (List (cadr(nth 14 entn)) (caddr(nth 14 entn)) 0.0)
f (List (cadr(nth 18 entn)) (caddr(nth 18 entn)) 0.0)
g (List (cadr(nth 22 entn)) (caddr(nth 22 entn)) 0.0)
h (List (cadr(nth 26 entn)) (caddr(nth 26 entn)) 0.0)
)
(Command "Line" a e "")
(Command "Line" b f "")
(Command "Line" c g "")
(Command "Line" d h "")
(princ)
)
Hy vọng bạn hài lòng.
Chúc thành công nhé :cry:
  • 2

#1808 q288

q288

    biết lệnh fillet

  • Members
  • PipPipPipPip
  • 209 Bài viết
Điểm đánh giá: 164 (tàm tạm)

Đã gửi 08 April 2009 - 01:37 PM

Chào bạn q288 Mình muốn check toàn bản vẽ nhưng chỉ bật hai layer đó lên để check thôi. Bạn giúp mình đi . Mình phải check rất nhiều mà bằng mắt thwờng thì rất lâu mới được một cái .
File mẫu : http://www.cadviet.c...es/file_mau.dwg


Mình đã viết thử ct và chạy thử. Tuy nhiên ngoài những điểm bắt đúng theo yêu cầu thì nó còn bắt thêm vài điểm khác. Có lẽ do cách bắt điểm của ACAD. Mình chưa biết cách khắc phục chuyện đó. Tuy vậy bạn có thể dùng tạm ct này, dù sao còn đõ hơn rà cả bản vẽ bằng mắt. Tên lệnh là chk.

(defun c:chk()

(defun ints (e1 e2 / ob1 ob2 V L1 L2)
;;;Intersections of e1, e2. Return LIST of points
;;;Thank Mr. Hoanh for this function!
(setq
ob1 (vlax-ename->vla-object e1)
ob2 (vlax-ename->vla-object e2)
)
(setq V (vlax-variant-value (vla-IntersectWith ob1 ob2 acExtendBoth)))
(if (/= (vlax-safearray-get-u-bound V 1) -1)
(progn
(setq L1 (vlax-safearray->list V) L2 nil)
(while L1
(setq L2 (append L2 (list (list (car L1) (cadr L1) (caddr L1)))))
(repeat 3 (setq L1 (cdr L1)))
)
)
(setq L2 nil)
)
L2
)

;;;

(setq os (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setvar "CLAYER" "layer 2")
(setvar "CECOLOR" "1")
(command "zoom" "e")
(setq ss (ssget "X" '((8 . "layer 2")))
n 0)

(repeat (sslength ss)
(setq v0 (ssname ss n)
v (vlax-ename->vla-object v0)
L nil)

(if (= (cdr (assoc 0 (entget v0))) "LWPOLYLINE")
(progn
(setq p1 (vlax-curve-getStartPoint v)
p2 (vlax-curve-getEndPoint v)
ss1 (ssget "f" (list p1 p2)))
(if (= (length p1) 2) (setq p1 (append p1 (list 0.0))))
(if (= (length p2) 2) (setq p2 (append p2 (list 0.0))))

(if (= (sslength ss1) 1)
(progn
(command "Point" p1)
(command "Point" p2))
(progn
(if (ssmemb v0 ss1) (setq ss1 (ssdel v0 ss1)))
(while (> (sslength ss1) 0)
(setq L (append L (ints v0 (ssname ss1 0)))
ss1 (ssdel (ssname ss1 0) ss1)))

(if (not (member p1 L)) (command "Point" p1))
(if (not (member p2 L)) (command "Point" p2)))
)
))
(setq n (1+ n)
)
)
(setvar "OSMODE" os)
)
  • 1

#1809 cuong_gtvt

cuong_gtvt

    biết zoom

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

Đã gửi 08 April 2009 - 01:39 PM

chào các bác. Em muốn viết một cái lisp để vẽ biên dạng có phương trình:
x=(r1-r2)*sin(a)+r3*sin(a)
y=(r1-r2)*cos(a)-r3*cos(a)
bác nào viết giúp em với. Em làm mãi ma không ra
Cám ơn các bác nhiều
  • 0

#1810 duy782006

duy782006

    PHẠM QUỐC DUY

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

Đã gửi 08 April 2009 - 02:08 PM

chào các bác. Em muốn viết một cái lisp để vẽ biên dạng có phương trình:
x=(r1-r2)*sin(a)+r3*sin(a)
y=(r1-r2)*cos(a)-r3*cos(a)
bác nào viết giúp em với. Em làm mãi ma không ra
Cám ơn các bác nhiều

Đã có bàn ở đây và mình cũng thấy bạn xuất hiện bên đó sao không hỏi luôn cho nó tập trung thuận tiện cho người sau bạn cần tìm.
  • 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


#1811 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 08 April 2009 - 03:16 PM

cảm ơn sự nhiệt tình của bạn Bình và Bác Tue mình đã chạy thử lisp của bạn Bình và thấy các vấn đề sau :

1- với đuờng PLine thì nói chung là đã ok

2-với đuờng SPline và đuờng cong thì block nó bị nguợc và thứ tự đánh chữ bị đảo nguợc sau text gốc là T1/L1-1A thì sẽ phải đến T1/L1-2B rồi đến T1/L1-3C rôi đến T1/L1-4A,T1/L1-5B......( mình chủ yếu là dùng đường loại SPline :cheers: )

3- về text thì mình cần các text sau giống text gốc về khoảng cách với điểm gốc và song song với tiếp tuyến của đường chuẩn như trong file kèm theo mình đã vẽ chi tiếp ( vi khó nói miêu tả :) )

4- về số ký tự thì text mẫu ban đầu của mình luôn là T1/L1-1A ( không hiểu như vậy có dễ dàng hơn cho các bạn kô )

file đính kèm ( mình đã chuyển về CAD 2004 )
http://www.cadviet.com/upfiles/12.dwg

Chào bạn nguyenkhoadung98,
Rất xin lỗi vì vẫn chưa làm được theo đúng yêu cầu của bạn. Hiện tại, mặc dầu đã cố gắng nhưng mình vẫn chưa giải quyết được triệt để theo đúng yêu cầu của bạn. Mình mới chỉ giải quyết được việc để cho block chèn không bị chổng tu, và các text nằm song song với tiếp tuyến, sắp xếp theo đúng thứ tự bạn muốn từ trái qua phải không phụ thuộc vào loại đường và cách vẽ. Còn vấn đề vị trí tương đối của text so với block chèn tưởng là ngon mà mình vẫn không giải quyết được. Lý do là việc chèn text vào rất khác với việc chèn block cột. Cái góc xoay của Text không hoàn toàn đồng nhất với cái góc chèn block bạn ạ.
Hơn nữa do text mẫu của bạn đã bị căn chỉnh cả về điểm chèn lẫn font gốc nên mình chưa tìm ra được cách lấy chuẩn để căn text bạn ạ.
Hiện tại mình chấp nhận vị trí đặt text cao hơn điểm chèn 6 và lệch trái so với điểm chèn block 3 bạn nhé.
Một vấn đề nữa là cái lisp này có sự khác biệt với các lisp trước do mình sử dụng gợi ý của bác ndtnv, mình đưa việc chọn điểm chèn bắt đầu vào và các block sẽ được chèn bắt đầu từ điểm này trở đi bạn nhé. Điểm chèn này sẽ được đánh thứ tự là T2/L1-2B bạn ạ và tăng dần. Trong trường hợp bạn muốn điểm bắt đấu này là mút của đường chuẩn thì bạn không được chèn trước block cũng như text vào đó và phải chấp nhận không có block mang số T2/L1-1A. Khi đó cái block và text chuẩn này bạn phải lấy từ một vị trí khác trên bản vẽ. Nếu bạn muốn điểm chèn đâu tiên được đánh số là T2/L1-1A thì cũng đơn giản, chỉ cần sửa lại một chút ở hai đoạn code lấy giá trị t4 và t5 mà thôi bạn ạ.
Hy vọng các bác cao thủ khác trên diễn đàn sẽ góp ý hoàn thiện ơn cái lisp này của mình. Mong bạn thông cảm.
Lisp đây bạn, nhớ lệnh chạy là ido
(defun c:ido ()
(vl-load-com)
(setq dt (car (entsel "\n Chon doi tuong goc"))
edt (entget dt)
bn (cdr (assoc 2 edt))
dg (cdr (assoc 10 edt))
txt (entsel "\n Chon text chuan")
etxt (entget (car txt))
text (cdr (assoc 1 etxt))
t1 (substr text 1 6)
t2 (substr text 7 1)
t3 (substr text 8 1)
gt (cdr (assoc 50 etxt))
h (cdr (assoc 40 etxt))
lt (cdr (assoc 8 etxt))
st (cdr (assoc 7 etxt))
mt (cdr (assoc 62 etxt))
pt (cdr (assoc 10 etxt))
dc (car (entsel "\n Chon duong chuan"))
edc (entget dc)
p0 (getpoint"\n Chon diem bat dau")
)
(setq a (- (car pt) (car dg))
b (- (cadr pt) (cadr dg))
)
(if (equal (cdr (assoc 10 edc)) p0)
(setq a1 0)
(setq a1 (vlax-curve-getdistatpoint dc p0))
)
(setq par (vlax-curve-getparamatdist dc a1)
vtt (vlax-curve-getFirstderiv dc par)
lth (vlax-curve-getdistatpoint dc (vlax-curve-getendpoint dc))
dis (getreal "\n Nhap khoang cach giua cac diem : ")
i 0
)
(if (/= (car vtt) 0)
(setq gr (atan (/ (cadr vtt) (car vtt))))
)
(if (> (car vtt) 0)
(setq gr (+ pi gr))
)
(setq gd (/ (* gr 180) pi))
;;;(command "insert" bn "r" gd p0 "" "" "")
(if (< (car vtt) 0)
(progn
(while (>= (- a1 (* i dis)) 0)
(setq p1 (vlax-curve-getpointatdist dc (- a1 (* i dis)))
par (vlax-curve-getparamatpoint dc p1)
vtt (vlax-curve-getFirstderiv dc par)
)
(if (/= (car vtt) 0)
(setq gr (atan (/ (cadr vtt) (car vtt))))
)
(if (> (car vtt) 0)
(setq gr (+ pi gr))
)
(setq gd (/ (* gr 180) pi))
(command "insert" bn "r" gd p1 "" "" "")
(if (and (> gd 90) (< gd 270))
(setq gd (+ gd 180))
)
(if (/= (atoi t2) nil)
(setq t4 (+ i (atoi t2) 1))
(setq t4 100)
)
(if (or (> (ascii t3) 67) (< (ascii t3) 65))
(setq t5 (chr 65))
(setq t5 t3)
)
(if (= 0 (rem i 3))
(setq t5 (chr (+ (ascii t5) 1)))
(if (= 1 (rem i 3))
(setq t5 (chr (+ (ascii t5) 2)))
)
)
(setq pt1 (list (+ (car p1) a) (+ (cadr p1) b)))
(command "layer" "m" lt "" "")
(Command "style" st "txt.shx" "0" "1" "0" "n" "n" "n")
(command "text" pt1 h gd (strcase (strcat t1 (itoa t4) t5) nil))
(setq i (1+ i))

)
)
(progn
(while (<= (+ a1 (* i dis)) lth)
(setq p1 (vlax-curve-getpointatdist dc (+ a1 (* i dis)))
par (vlax-curve-getparamatpoint dc p1)
vtt (vlax-curve-getFirstderiv dc par)
)
(if (/= (car vtt) 0)
(setq gr (atan (/ (cadr vtt) (car vtt))))
)
(if (< (car vtt) 0)
(setq gr (+ pi gr))
)
(setq gd (/ (* gr 180) pi))
(command "insert" bn "r" gd p1 "" "" "")
(if (and (> gd 90) (< gd 270))
(setq gd (+ gd 180))
)
(if (/= (atoi t2) nil)
(setq t4 (+ i (atoi t2) 1))
(setq t4 100)
)
(if (or (> (ascii t3) 67) (< (ascii t3) 65))
(setq t5 (chr 65))
(setq t5 t3)
)
(if (= 0 (rem i 3))
(setq t5 (chr (+ (ascii t5) 1)))
(if (= 1 (rem i 3))
(setq t5 (chr (+ (ascii t5) 2)))
)
)
(setq pt1 (list (+ (car p1) a) (+ (cadr p1) b)))
(command "layer" "m" lt "" "")
(Command "style" st "txt.shx" "0" "1" "0" "n" "n" "n")
(command "text" pt1 h gd (strcase (strcat t1 (itoa t4) t5) nil))
(setq i (1+ i))
)
)
)

)

Chúc bạn vui.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#1812 nguyenkhoadung98

nguyenkhoadung98

    biết vẽ pline

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

Đã gửi 08 April 2009 - 04:58 PM

Chào bạn nguyenkhoadung98,
Rất xin lỗi vì vẫn chưa làm được theo đúng yêu cầu của bạn. Hiện tại, mặc dầu đã cố gắng nhưng mình vẫn chưa giải quyết được triệt để theo đúng yêu cầu của bạn. Mình mới chỉ giải quyết được việc để cho block chèn không bị chổng tu, và các text nằm song song với tiếp tuyến, sắp xếp theo đúng thứ tự bạn muốn từ trái qua phải không phụ thuộc vào loại đường và cách vẽ. Còn vấn đề vị trí tương đối của text so với block chèn tưởng là ngon mà mình vẫn không giải quyết được. Lý do là việc chèn text vào rất khác với việc chèn block cột. Cái góc xoay của Text không hoàn toàn đồng nhất với cái góc chèn block bạn ạ.
Hơn nữa do text mẫu của bạn đã bị căn chỉnh cả về điểm chèn lẫn font gốc nên mình chưa tìm ra được cách lấy chuẩn để căn text bạn ạ.
Hiện tại mình chấp nhận vị trí đặt text cao hơn điểm chèn 6 và lệch trái so với điểm chèn block 3 bạn nhé.
Một vấn đề nữa là cái lisp này có sự khác biệt với các lisp trước do mình sử dụng gợi ý của bác ndtnv, mình đưa việc chọn điểm chèn bắt đầu vào và các block sẽ được chèn bắt đầu từ điểm này trở đi bạn nhé. Điểm chèn này sẽ được đánh thứ tự là T2/L1-2B bạn ạ và tăng dần. Trong trường hợp bạn muốn điểm bắt đấu này là mút của đường chuẩn thì bạn không được chèn trước block cũng như text vào đó và phải chấp nhận không có block mang số T2/L1-1A. Khi đó cái block và text chuẩn này bạn phải lấy từ một vị trí khác trên bản vẽ. Nếu bạn muốn điểm chèn đâu tiên được đánh số là T2/L1-1A thì cũng đơn giản, chỉ cần sửa lại một chút ở hai đoạn code lấy giá trị t4 và t5 mà thôi bạn ạ.
Hy vọng các bác cao thủ khác trên diễn đàn sẽ góp ý hoàn thiện ơn cái lisp này của mình. Mong bạn thông cảm.
Lisp đây bạn, nhớ lệnh chạy là ido

(defun c:ido ()
(vl-load-com)
(setq dt (car (entsel "\n Chon doi tuong goc"))
edt (entget dt)
bn (cdr (assoc 2 edt))
dg (cdr (assoc 10 edt))
txt (entsel "\n Chon text chuan")
etxt (entget (car txt))
text (cdr (assoc 1 etxt))
t1 (substr text 1 6)
t2 (substr text 7 1)
t3 (substr text 8 1)
gt (cdr (assoc 50 etxt))
h (cdr (assoc 40 etxt))
lt (cdr (assoc 8 etxt))
st (cdr (assoc 7 etxt))
mt (cdr (assoc 62 etxt))
pt (cdr (assoc 10 etxt))
dc (car (entsel "\n Chon duong chuan"))
edc (entget dc)
p0 (getpoint"\n Chon diem bat dau")
)
(setq a (- (car pt) (car dg))
b (- (cadr pt) (cadr dg))
)
(if (equal (cdr (assoc 10 edc)) p0)
(setq a1 0)
(setq a1 (vlax-curve-getdistatpoint dc p0))
)
(setq par (vlax-curve-getparamatdist dc a1)
vtt (vlax-curve-getFirstderiv dc par)
lth (vlax-curve-getdistatpoint dc (vlax-curve-getendpoint dc))
dis (getreal "\n Nhap khoang cach giua cac diem : ")
i 0
)
(if (/= (car vtt) 0)
(setq gr (atan (/ (cadr vtt) (car vtt))))
)
(if (> (car vtt) 0)
(setq gr (+ pi gr))
)
(setq gd (/ (* gr 180) pi))
;;;(command "insert" bn "r" gd p0 "" "" "")
(if (< (car vtt) 0)
(progn
(while (>= (- a1 (* i dis)) 0)
(setq p1 (vlax-curve-getpointatdist dc (- a1 (* i dis)))
par (vlax-curve-getparamatpoint dc p1)
vtt (vlax-curve-getFirstderiv dc par)
)
(if (/= (car vtt) 0)
(setq gr (atan (/ (cadr vtt) (car vtt))))
)
(if (> (car vtt) 0)
(setq gr (+ pi gr))
)
(setq gd (/ (* gr 180) pi))
(command "insert" bn "r" gd p1 "" "" "")
(if (and (> gd 90) (< gd 270))
(setq gd (+ gd 180))
)
(if (/= (atoi t2) nil)
(setq t4 (+ i (atoi t2) 1))
(setq t4 100)
)
(if (or (> (ascii t3) 67) (< (ascii t3) 65))
(setq t5 (chr 65))
(setq t5 t3)
)
(if (= 0 (rem i 3))
(setq t5 (chr (+ (ascii t5) 1)))
(if (= 1 (rem i 3))
(setq t5 (chr (+ (ascii t5) 2)))
)
)
(setq pt1 (list (+ (car p1) a) (+ (cadr p1) b)))
(command "layer" "m" lt "" "")
(Command "style" st "txt.shx" "0" "1" "0" "n" "n" "n")
(command "text" pt1 h gd (strcase (strcat t1 (itoa t4) t5) nil))
(setq i (1+ i))

)
)
(progn
(while (<= (+ a1 (* i dis)) lth)
(setq p1 (vlax-curve-getpointatdist dc (+ a1 (* i dis)))
par (vlax-curve-getparamatpoint dc p1)
vtt (vlax-curve-getFirstderiv dc par)
)
(if (/= (car vtt) 0)
(setq gr (atan (/ (cadr vtt) (car vtt))))
)
(if (< (car vtt) 0)
(setq gr (+ pi gr))
)
(setq gd (/ (* gr 180) pi))
(command "insert" bn "r" gd p1 "" "" "")
(if (and (> gd 90) (< gd 270))
(setq gd (+ gd 180))
)
(if (/= (atoi t2) nil)
(setq t4 (+ i (atoi t2) 1))
(setq t4 100)
)
(if (or (> (ascii t3) 67) (< (ascii t3) 65))
(setq t5 (chr 65))
(setq t5 t3)
)
(if (= 0 (rem i 3))
(setq t5 (chr (+ (ascii t5) 1)))
(if (= 1 (rem i 3))
(setq t5 (chr (+ (ascii t5) 2)))
)
)
(setq pt1 (list (+ (car p1) a) (+ (cadr p1) b)))
(command "layer" "m" lt "" "")
(Command "style" st "txt.shx" "0" "1" "0" "n" "n" "n")
(command "text" pt1 h gd (strcase (strcat t1 (itoa t4) t5) nil))
(setq i (1+ i))
)
)
)

)

Chúc bạn vui.



cảm ơn bạn Bình rất nhiều tớ đã dùng thử, đúng như bạn nói các vấn đề hầu như đã đc giải quyết, chỉ còn vấn đề về text và vụ kô có được cái text T1/L1-1A, hi vọng bạn sớm giải quyết được.1 lần nữa cảm ơn bạn rất nhiều :cheers:
  • 0

#1813 nguyenkhoadung98

nguyenkhoadung98

    biết vẽ pline

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

Đã gửi 08 April 2009 - 05:21 PM

cảm ơn bạn Bình rất nhiều tớ đã dùng thử, đúng như bạn nói các vấn đề hầu như đã đc giải quyết, chỉ còn vấn đề về text và vụ kô có được cái text T1/L1-1A, hi vọng bạn sớm giải quyết được.1 lần nữa cảm ơn bạn rất nhiều :)



ah bạn Bình có thể tách cho mình từ cái lisp IDO ấy ra cho mình 1 cái lisp mà nó chỉ tự động đánh số cột đèn từ T1/L1-1A,T1/L1-2B,T1/L1-3C,T1/L1-4A,T1/L1-5B.....vì các block đã có sẵn từ trước rồi ( đã me block hết rồi chỉ thiếu mỗi text thôi ), thật ngại wa đúng là đc voi đòi tiên :) mình có sẵn 1 lisp tương tự như thế rồi nhưng nó lại bắt mình pick từng điểm cho mỗi 1 text :cheers: nó đây :

;;;===================================================================
;;; Danh so cot den:
(defun c:dsc (/ ang x y ent tg tg1tg2 num_r
num_c num_inc dis_r dis_c num top idnum
dx dy bottom inc tgnum attr attr_ent
t_base b_base locat value deci stnum loca1 loca2
tt count inctg inctg1 bpoint mx my nx
ny bx by
)
(setq idnum 0)
(while (/= idnum 1)
(setq ent (entsel "\nHay lua chon so ma ban muon copy : "))
(if ent
(progn
(setq e (car ent))
(setq tg (entget e))
(if (= (cdr (assoc 0 tg)) "TEXT")
(setq idnum 1)
)
)
(princ)
)
)

(setq num_inc (getreal "\nHay nhap he so tang giam <1> : "))
(if (= num_inc nil)
(setq num_inc 1)
)

(setq bpoint (getpoint "\nChon diem goc de copy : "))
(setq x (car bpoint))
(setq y (car (cdr bpoint)))

(if (and (= (cdr (assoc 72 tg)) 0) (= (cdr (assoc 73 tg)) 0))
(progn
(setq bx (car (cdr (assoc 10 tg))))
(setq by (car (cdr (cdr (assoc 10 tg)))))
)
(progn
(setq bx (car (cdr (assoc 11 tg))))
(setq by (car (cdr (cdr (assoc 11 tg)))))
)
)

(setq attr (cdr tg))
(setq tg (cdr (assoc 1 tg)))
(setq inc 0)
(setq tg1 "")
(setq t_base "")
(setq b_base "")
(setq idnum 0)
(setq top 0)
(setq bottom 0)
(setq stnum "")
(setq deci 0)
(repeat (strlen tg)
(if
(or (and (> (ascii (setq tgnum (substr tg (- (strlen tg) inc) 1)))
47
) ;(chr 32)
(< (ascii (setq tgnum (substr tg (- (strlen tg) inc) 1)))
58
)
)

(= (ascii (setq tgnum (substr tg (- (strlen tg) inc) 1)))
32
)

(= (ascii (setq tgnum (substr tg (- (strlen tg) inc) 1)))
46
)
)
(progn
(if (= (ascii (setq tgnum (substr tg (- (strlen tg) inc) 1)))
46
)
(setq deci inc)
)
(if (= inc 0)
(progn
(setq idnum 1)
(if
(= (ascii (setq tgnum (substr tg (- (strlen tg) inc) 1)))
46
)
(setq b_base (strcat "." b_base))
)
)
)
(if (= bottom 1)
(progn (setq bottom 0) (setq idnum 1) (setq top 1))
)
(if (and (= idnum 0) (= top 1))
(setq t_base (strcat tgnum t_base))
)
(if (= idnum 1)
(progn
(if (and (= tgnum "0") (> inc 0))
(setq stnum (strcat stnum "0"))
(setq stnum "")
)
(setq tg1 (strcat tgnum tg1))
)
)
)
(if (= inc 0)
(progn
(setq b_base (strcat tgnum b_base))
(setq bottom 1)
)
(if (= bottom 1)
(setq b_base (strcat tgnum b_base))
(progn
(setq top 1)
(setq t_base (strcat tgnum t_base))
(if (= idnum 1)
(setq idnum 0)
)
)
)
)
)
(setq inc (+ inc 1))
)

(if (= tg1 "")
(exit)
)
(setq num (atof tg1))
(setq count 1)

(while (setq bpoint (getpoint "\nChon diem copy tiep theo : "))
(setq num (+ num num_inc))
(if (>= (strlen b_base) 1)
(cond
((or (= "A"
(strcase (substr b_base (strlen b_base) 1))
)
(= "B"
(strcase (substr b_base (strlen b_base) 1))
)
)
(setq b_base
(strcat
(substr b_base 1 (1- (strlen b_base)))
(chr (1+ (ascii (substr b_base (strlen b_base) 1))))
)
)
)
((= "C" (strcase (substr b_base (strlen b_base) 1)))
(setq
b_base (strcat (substr b_base 1 (1- (strlen b_base))) "A")
)
)
)

)
(setq value (strcat t_base (strcat stnum (rtos num 2 deci)) b_base))
(setq nx (car bpoint))
(setq ny (car (cdr bpoint)))
(setq dx (- nx x))
(setq dy (- ny y))
(setq mx (car (getvar "ucsxdir")))
(setq my (car (cdr (getvar "ucsxdir"))))
(setq loca1 (+ bx (* mx dx)))
(setq loca2 (+ by (* my dx)))
(setq mx (car (getvar "ucsydir")))
(setq my (car (cdr (getvar "ucsydir"))))
(setq loca1 (+ loca1 (* mx dy)))
(setq loca2 (+ loca2 (* my dy)))
(setq attr_ent (subst (cons 1 value) (assoc 1 attr) attr))
(if (and (= (cdr (assoc 72 attr_ent)) 0)
(= (cdr (assoc 73 attr_ent)) 0)
)
(setq attr_ent (subst (list 10 loca1 loca2 0)
(assoc 10 attr_ent)
attr_ent
)
)
(setq attr_ent (subst (list 11 loca1 loca2 0)
(assoc 11 attr_ent)
attr_ent
)
)
)
(entmake attr_ent)
(setq count (+ count 1))
) ;end while
(princ)
)
  • 0

#1814 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 08 April 2009 - 05:40 PM

chào các bác. Em muốn viết một cái lisp để vẽ biên dạng có phương trình:
x=(r1-r2)*sin(a)+r3*sin(a)
y=(r1-r2)*cos(a)-r3*cos(a)
bác nào viết giúp em với. Em làm mãi ma không ra
Cám ơn các bác nhiều

Chào bạn Cuong_gtvt,
Bạn thử xài cái củ lisp mót này của mình xem nhé. Thú thực là mình mót của bác SSG đó. Sau khi gặm xong, tiêu hóa rồi thì được cái lisp này. Được cái nó cũng hơi dễ tiêu nên mới dám post lên đây. Nếu bạn thấy nặng ụng thì cứ post lên, sẽ có thuốc giải ngay bạn nhé. Chúc bạn vui, khỏe và thành đạt.
Củ ấy đây:
(defun c:vhs ()
(setq Oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq r1 (getreal "\n Nhap gia tri R1 : ")
r2 (getreal "\n Nhap gia tri R2 : ")
r3 (getreal "\n Nhap gia tri R3 : ")
b (getreal "\ Nhap gia tri buoc nhay : ")
a 0
i 0
pt (getpoint "\n Chon diem goc ")
lstpt (list)
)
(while (<= a (* pi 2))
(setq x (+ (* (- r1 r2) (sin a)) (* (sin a) r3))
y (- (* (- r1 r2) (cos a)) (* (cos a) r3))
p (list (+ (car pt) x) (+ (cadr pt) y))
lstpt (append (list p) lstpt)
;;; p (command "point" p)
i (1+ i)
a (* i b)
)
)
(command "pline")
(foreach x Lstpt (command x))
(command "c")
(setvar "osmode" Oldos)
(princ)
)
Lệnh là VHS, vì ở đây dùng lệnh pline nên đường nối không được nhuyễn lắm. Bạn càng giảm bước nhảy thì nó sẽ càng nhuyễn bạn nhé. Hy vọng nó làm bạn hài lòng.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#1815 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 08 April 2009 - 07:34 PM

ah bạn Bình có thể tách cho mình từ cái lisp IDO ấy ra cho mình 1 cái lisp mà nó chỉ tự động đánh số cột đèn từ T1/L1-1A,T1/L1-2B,T1/L1-3C,T1/L1-4A,T1/L1-5B.....vì các block đã có sẵn từ trước rồi ( đã me block hết rồi chỉ thiếu mỗi text thôi ), thật ngại wa đúng là đc voi đòi tiên :) mình có sẵn 1 lisp tương tự như thế rồi nhưng nó lại bắt mình pick từng điểm cho mỗi 1 text :cheers: nó đây :

Chào bạn nguyenkhoadung98,
Rất vui vì thấy bạn dùng được cái lisp của mình. Về cái vụ vị trí text thì quả thực là mình cũng đang hơi rối, chưa tìm được giải pháp bạn ạ. Còn cái text T2/L1-1A thực ra chỉ khó nếu như bạn đã đặt nó vào đường chuẩn rồi thôi. Nếu như bạn chưa đặt nó vào thì như mình đã viết trong bài trước, chỉ chỉnh tí xíu là OK ngay. Tại mình cứ theo cái hình bạn post lên nên sợ có hai cột cùng số đó mà thôi. Nếu như bạn đặt cái text ấy và cái block d0 ra ngoài đường chuẩn thì mình đã sửa cái lisp rồi. Bạn sửa như sau nhé:
1/- Trong các dòng code (setq t4 (+ i (atoi t2) 1)) bạn xóa béng cái con số 1 đi. Nhớ là chỉ xóa số 1 chứ đừng xóa đi bất cứ dấu ngoặc nào nha.
2/- Trong các dòng code (if (= 0 (rem i 3)) bạn thay số 1 vào vị trí số 0
3/- Trong các dòng code (if (= 1 (rem i 3)) bạn thay số 2 vào vị trí số 1
Lúc này kết quả chạy ra sẽ có các text bắt đầu là T2/L1-1A và tăng dần đến cuối cùng như bạn muốn. Và như vậy bạn có thể chọn điểm bắt đấu từ bất cứ vị trí nào trên đường chuẩn của bạn, các block cột sẽ được bắt đầu chèn từ vị trí đó theo hướng từ trái qua phải bạn ạ.

Về cái việc đòi tiên thì ai chả muốn. Mình cũng muốn lắm chớ. Mỗi tội hơi khó kiếm thôi bạn ạ. Cái cô tiên bạn muốn hơi khó tính đấy. Này nhé:
1/- Vì các block đã được chèn sẵn rồi nên việc xác định thứ tự các block này không hề đơn giản bạn ạ. Nhất là khi bản vẽ lại do người khác cung cấp. Đấy cũng chính là lý do mà cái lisp của bạn lại yêu cầu người dùng phải nhập lại thứ tự các điểm chèn để mà đánh số cho đúng trật tự bạn ạ. Bởi vì rất có thể cái block cột thứ 6 lại được insert trước thằng block cột thứ nhất ấy chứ.
2/- Khoảng cách giữa các block có được biết chính xác hay không hay phải mò từng chú một.
3/- Về vị trí đặt text cũng gặp rắc rối y như trường hợp trên bạn ạ.

Vậy nên mình thiển nghĩ thế này: Chả có tiên thì ni cô cũng xài tạm vậy, cách xài như sau
Nếu như bạn đã biết chính xác cái khoảng cách giữa các block là như nhau và biết được chính xác cái điểm chèn của block đấu tiên thì bạn hoàn toàn có thể xài cái củ lisp mà mình đã biếu bạn với chút xíu công phu như sau:
1/- Bạn gõ giùm mình ba hay bốn cái dấu ; vào trước các dòng code (command "insert" bn "r" gd p1 "" "" "") để nó trở thành ;;;;(command "insert" bn "r" gd p1 "" "" "") .
2/- Bạn load lisp và chạy nó y sì như các thao tác cũ chỉ lưu ý rằng chọn đúng cái điểm chèn đầu tiên của cái block mà bạn muốn bắt đầu đánh số và nhập đúng cái khoảng cách giữa các block đã được chèn. Vậy là khi chạy lisp nó sẽ "quên béng cái việc insert block cột của bạn mà chỉ nhăm nhăm đánh số thôi bạn ạ. Và nó cũng sẽ đánh số i sì phóoc như bạn muốn
3/- Sau khi xài xong, bạn chịu khó xóa sạch mấy cái dấu ; đi là lisp lại trở về nguyên trạng bạn ạ. Vậy là khỏi phải lo tậu thêm lisp mới cho nặng máy bạn nhé.

Hì hì, vì mình chuyên đi mót nên bày bạn cái cách hơi củ chuối này. Bạn đừng giận nếu bạn không muốn xài thế nhé. Cái cách tuy củ chuối nhưng được việc ra phết bạn ạ. Ít ra nó cũng cứu đói được cho mình nhiều phen rồi bạn ạ.

Hy vọng bạn sẽ bật cười khi xài cái cách này. Mong bạn thành công

PS: bạn nguyenkhoadung ơi, lúc nào bạn ranh rảnh chỉ mình cách xài cái lệnh ME với nhé. Mình xài cad2004 mà chả biết mò cái đó ra sao. Thấy bạn xài tới tới mà ham quá à. Thanks bạn trước nha.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#1816 thanhlichtran

thanhlichtran

    Chưa sử dụng CAD

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

Đã gửi 08 April 2009 - 08:23 PM

Mình đã viết thử ct và chạy thử. Tuy nhiên ngoài những điểm bắt đúng theo yêu cầu thì nó còn bắt thêm vài điểm khác. Có lẽ do cách bắt điểm của ACAD. Mình chưa biết cách khắc phục chuyện đó. Tuy vậy bạn có thể dùng tạm ct này, dù sao còn đõ hơn rà cả bản vẽ bằng mắt. Tên lệnh là chk.

(defun c:chk()

(defun ints (e1 e2 / ob1 ob2 V L1 L2)
;;;Intersections of e1, e2. Return LIST of points
;;;Thank Mr. Hoanh for this function!
(setq
ob1 (vlax-ename->vla-object e1)
ob2 (vlax-ename->vla-object e2)
)
(setq V (vlax-variant-value (vla-IntersectWith ob1 ob2 acExtendBoth)))
(if (/= (vlax-safearray-get-u-bound V 1) -1)
(progn
(setq L1 (vlax-safearray->list V) L2 nil)
(while L1
(setq L2 (append L2 (list (list (car L1) (cadr L1) (caddr L1)))))
(repeat 3 (setq L1 (cdr L1)))
)
)
(setq L2 nil)
)
L2
)

;;;

(setq os (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setvar "CLAYER" "layer 2")
(setvar "CECOLOR" "1")
(command "zoom" "e")
(setq ss (ssget "X" '((8 . "layer 2")))
n 0)

(repeat (sslength ss)
(setq v0 (ssname ss n)
v (vlax-ename->vla-object v0)
L nil)

(if (= (cdr (assoc 0 (entget v0))) "LWPOLYLINE")
(progn
(setq p1 (vlax-curve-getStartPoint v)
p2 (vlax-curve-getEndPoint v)
ss1 (ssget "f" (list p1 p2)))
(if (= (length p1) 2) (setq p1 (append p1 (list 0.0))))
(if (= (length p2) 2) (setq p2 (append p2 (list 0.0))))

(if (= (sslength ss1) 1)
(progn
(command "Point" p1)
(command "Point" p2))
(progn
(if (ssmemb v0 ss1) (setq ss1 (ssdel v0 ss1)))
(while (> (sslength ss1) 0)
(setq L (append L (ints v0 (ssname ss1 0)))
ss1 (ssdel (ssname ss1 0) ss1)))

(if (not (member p1 L)) (command "Point" p1))
(if (not (member p2 L)) (command "Point" p2)))
)
))
(setq n (1+ n)
)
)
(setvar "OSMODE" os)
)


Cám ơn ban q288 nhiệt tình giúp đỡ bọn mình . Chương trình chạy rất tuyệt ! Tuy nhiên thì mình cũng phát hiện ra lỗi đó không biết có đúng không bạn xem lại hộ mình nhé. mình thấy ngoài lỗi bắt chính xác ra, những lỗi kia nó bắt là do không tạo điểm point (end point) ở đó. layer 2 nó chỉ snap vào thì cũng được không cần endpoint ...Bạn chỉnh lại cho giúp mình xem có được không nhé ...
  • 0

#1817 dhxd2387

dhxd2387

    Chưa sử dụng CAD

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

Đã gửi 08 April 2009 - 11:31 PM

Chào các bác!
Em đang cần Lisp có khả năng như sau:
1_Chọn "n" đối tượng trên bản vẽ.
2_Đổi màu "n" đối tường này (mỗi đối tượng có một màu mới).
Xin chân thành cảm ơn! Em đang rất cần. :cheers:
  • 0

#1818 tdvn

tdvn

    biết lệnh rotate

  • Members
  • PipPipPip
  • 134 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 09 April 2009 - 01:05 AM

Chào các bác!
Em ðang cần Lisp có khả nãng nhý sau:
1_Chọn "n" ðối týợng trên bản vẽ.
2_Ðổi màu "n" ðối týờng này (mỗi ðối týợng có một màu mới).
Xin chân thành cảm õn! Em ðang rất cần. :cheers:

Ðây, nhýng chỉ ðổi màu các ðối týợng ðõn giản thôi
(defun C:DOIMAUDT( / ss i j name)
(setq ss (ssget))
(if ss (progn
(setq i 0 j 1)
(while (< i (sslength ss))
(setq name (ssname ss i))
(command "_.change" name "" "p" "c" j "")
(setq j (1+ j) i (1+ i))
(if (= j 256) (setq j 1))
)
))
)

  • 1

#1819 nguyenkhoadung98

nguyenkhoadung98

    biết vẽ pline

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

Đã gửi 09 April 2009 - 09:03 AM

Chào bạn nguyenkhoadung98,
Rất vui vì thấy bạn dùng được cái lisp của mình. Về cái vụ vị trí text thì quả thực là mình cũng đang hơi rối, chưa tìm được giải pháp bạn ạ. Còn cái text T2/L1-1A thực ra chỉ khó nếu như bạn đã đặt nó vào đường chuẩn rồi thôi. Nếu như bạn chưa đặt nó vào thì như mình đã viết trong bài trước, chỉ chỉnh tí xíu là OK ngay. Tại mình cứ theo cái hình bạn post lên nên sợ có hai cột cùng số đó mà thôi. Nếu như bạn đặt cái text ấy và cái block d0 ra ngoài đường chuẩn thì mình đã sửa cái lisp rồi. Bạn sửa như sau nhé:
1/- Trong các dòng code (setq t4 (+ i (atoi t2) 1)) bạn xóa béng cái con số 1 đi. Nhớ là chỉ xóa số 1 chứ đừng xóa đi bất cứ dấu ngoặc nào nha.
2/- Trong các dòng code (if (= 0 (rem i 3)) bạn thay số 1 vào vị trí số 0
3/- Trong các dòng code (if (= 1 (rem i 3)) bạn thay số 2 vào vị trí số 1
Lúc này kết quả chạy ra sẽ có các text bắt đầu là T2/L1-1A và tăng dần đến cuối cùng như bạn muốn. Và như vậy bạn có thể chọn điểm bắt đấu từ bất cứ vị trí nào trên đường chuẩn của bạn, các block cột sẽ được bắt đầu chèn từ vị trí đó theo hướng từ trái qua phải bạn ạ.

Về cái việc đòi tiên thì ai chả muốn. Mình cũng muốn lắm chớ. Mỗi tội hơi khó kiếm thôi bạn ạ. Cái cô tiên bạn muốn hơi khó tính đấy. Này nhé:
1/- Vì các block đã được chèn sẵn rồi nên việc xác định thứ tự các block này không hề đơn giản bạn ạ. Nhất là khi bản vẽ lại do người khác cung cấp. Đấy cũng chính là lý do mà cái lisp của bạn lại yêu cầu người dùng phải nhập lại thứ tự các điểm chèn để mà đánh số cho đúng trật tự bạn ạ. Bởi vì rất có thể cái block cột thứ 6 lại được insert trước thằng block cột thứ nhất ấy chứ.
2/- Khoảng cách giữa các block có được biết chính xác hay không hay phải mò từng chú một.
3/- Về vị trí đặt text cũng gặp rắc rối y như trường hợp trên bạn ạ.

Vậy nên mình thiển nghĩ thế này: Chả có tiên thì ni cô cũng xài tạm vậy, cách xài như sau
Nếu như bạn đã biết chính xác cái khoảng cách giữa các block là như nhau và biết được chính xác cái điểm chèn của block đấu tiên thì bạn hoàn toàn có thể xài cái củ lisp mà mình đã biếu bạn với chút xíu công phu như sau:
1/- Bạn gõ giùm mình ba hay bốn cái dấu ; vào trước các dòng code (command "insert" bn "r" gd p1 "" "" "") để nó trở thành ;;;;(command "insert" bn "r" gd p1 "" "" "") .
2/- Bạn load lisp và chạy nó y sì như các thao tác cũ chỉ lưu ý rằng chọn đúng cái điểm chèn đầu tiên của cái block mà bạn muốn bắt đầu đánh số và nhập đúng cái khoảng cách giữa các block đã được chèn. Vậy là khi chạy lisp nó sẽ "quên béng cái việc insert block cột của bạn mà chỉ nhăm nhăm đánh số thôi bạn ạ. Và nó cũng sẽ đánh số i sì phóoc như bạn muốn
3/- Sau khi xài xong, bạn chịu khó xóa sạch mấy cái dấu ; đi là lisp lại trở về nguyên trạng bạn ạ. Vậy là khỏi phải lo tậu thêm lisp mới cho nặng máy bạn nhé.

Hì hì, vì mình chuyên đi mót nên bày bạn cái cách hơi củ chuối này. Bạn đừng giận nếu bạn không muốn xài thế nhé. Cái cách tuy củ chuối nhưng được việc ra phết bạn ạ. Ít ra nó cũng cứu đói được cho mình nhiều phen rồi bạn ạ.

Hy vọng bạn sẽ bật cười khi xài cái cách này. Mong bạn thành công

PS: bạn nguyenkhoadung ơi, lúc nào bạn ranh rảnh chỉ mình cách xài cái lệnh ME với nhé. Mình xài cad2004 mà chả biết mò cái đó ra sao. Thấy bạn xài tới tới mà ham quá à. Thanks bạn trước nha.



cảm ơn bạn Bình rất nhiều.mình đã thử làm và đã làm được theo chỉ dẫn của bạn,nếu có 1000 lần thanks thì cũng đã bấm cho bạn :cheers:. về cái lệnh ME thì mình vẫn dùng như các lệnh khác ( cad 2007) bạn đánh lệnh ME,chọn đối tượng rồi nó hỏi chọn chiều dài đoạn thẳng cần chia hoặc là chọn block ( mình cần rải block nên chọn là B ) sau đó nó hỏi đánh tên Block cần rải,sau đó nó hỏi có làm cho block vuông góc với đường mình chọn hay kô ( y,n), rồi nó bắt mình nhập khoảng cách giữa các block, vậy là xong. kô bit là cad 2004 có kô nữa ( hình như là có ) :) thanks you bạn nhiều
  • 1

#1820 conghoan1003

conghoan1003

    biết vẽ point

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

Đã gửi 09 April 2009 - 09:41 AM

Chào bạn,
Theo như bạn viết thì mình hiểu là bạn muốn cộng tất cả chiều dài các đoạn rồi chỉ viết ra tổng chiều dài thôi, phải vậy không? Nếu như vậy thì mình sửa lại như sau:

;;;------------------------------------------------------------------------------------
(defun getTw ()
;;;Get current text width factor
(cdr (assoc 41 (tblsearch "style" (getvar "textstyle"))))
)
;;;------------------------------------------------------------------------------------
(defun getTh (/ Th)
;;;Get current textheight or textsize
(if (= (setq
Th (cdr (assoc 40 (tblsearch "style" (getvar "textstyle"))))
)
0
)
(getvar "textsize")
Th
)
)
;;;------------------------------------------------------------------------------------
(defun emkT (S p)
;;;Write text S at point p by entmake function
;;;Text style, heigh and width factor get from current values
(entmake (list (cons 0 "TEXT")
(cons 10 p)
(cons 40 (getTh))
(cons 41 (getTw))
(cons 1 S)
(cons 7 (getvar "textstyle"))
)
)
)
;;;------------------------------------------------------------------------------------
(defun calcL (e)
;;;Calculate length of Line, Pline, 3dPoly, Spline, Circle, Arc, Polygon
(vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))
)
;;;------------------------------------------------------------------------------------
(defun C:CHD (/ Opt S1 S2 e p L)
(vl-load-com)
(if (not preT)
(setq preT "L=")
)
(if (not sufT)
(setq sufT "")
)
(setq S1 preT
S2 sufT
)
(prompt (strcat
"\nMeasure and write length. Current prefix:["
preT
"]\tSuffix:["
sufT
"]"
)
)
(initget "Y N")
(setq Opt (getkword "\nChange prefix and suffix? [Yes/No] :"))
(if (not Opt)
(setq Opt "N")
)
(if (= Opt "Y")
(progn
(setq
S1 (getstring "\nPrefix :")
preT S1
S2 (getstring "\nSuffix :")
sufT S2
)
)
)
(setq ss (ssget)
n 0
total 0
)

(repeat (sslength ss)
(setq e (ssname ss n)
L (calcL e)
total (+ total L)
n (1+ n)
)
)
(setq p (getpoint "\nBase point: "))
(emkT S1 p)
(emkT (strcat " " (rtos total) S2) p)

(princ)
)

Bạn chạy thử xem có đúng ý bạn không, nếu không thì sửa tiếp. Chào bạn


Chào q288!
Cái này thì ok rồi nhưng mình muốn hoàn thiện hơn chút xíu bạn giúp mình với nha.
Mình muốn sau khi ghi kích thước thứ nhất thì mình có thể chọn tiếp các đoạn khác để ghi tiếp chứ không cần phải kích lệnh thêm lần nữa, vì mình cần tính chiều dài của nhiều đoạn mà mỗi lần lai đánh lệnh lại từ đầu, rồi nó lại hỏi preix and suffix thấy cũng bất tiện.
Nhân tiện cho mình hỏi thêm nha, hôm trước minh dung thì ok nhung mấy hôm nay dung thì nó ghi kích thước tại vị trí rất xa so với chỗ mình click (điểm cần ghi). Giúp mình với nhé!
Thank!
Chúc sức khoẻ!
  • 0
Học học nữa học mãi.
Đúp học lại!