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

#2481 aliosa

aliosa

    biết vẽ polygon

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

Đã gửi 23 July 2009 - 10:57 AM

Bạn thử cái này, có điều là chỉ hỏi giá trị A thôi còn D thì nó đo khoảng cách giữa 2 pline rồi, ko cần hỏi nữa.

Mình đã test Lisp chạy tốt rồi. Bạn bổ sung giúp mình thêm chút nữa nhé: Trong những vị trí hai đường song song có gấp khúc lớn tại những vị trí đó Bạn có thể giúp mình nối tiếp đường thẳng bằng đường cong tròn có bán kính lớn hơn Rmin (nhập vào khi chạy chương trình) sao cho đường cong và đường polyline luôn tạo ra luôn nằm trọn ở giữa hai đường song song đó và phải đảm bảo tổng chiều dài của của đường thẳng và cánh tang của đường cong lớn hơn giá trị A.
Thân !
  • 0

#2482 aliosa

aliosa

    biết vẽ polygon

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

Đã gửi 23 July 2009 - 11:07 AM

Hiện nay mình đang dùng phần mền NOVA để thiết kế đường. Bạn nào trong diễn đàn đã dùng phần mềm đó xin cho mình hỏi có thể viết chương trình để áp thiết kế kết cấu áo đường bằng Lisp được không?. Mục đích của em là làm thế nào để nó không hiện ra cái hộp thoại áp thiết kế nữa mà hạy luôn.
Mong các bạn chỉ giúp cho !
  • 0

#2483 xuandao0708

xuandao0708

    biết lệnh scale

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

Đã gửi 23 July 2009 - 02:29 PM

Lisp này em đang cần, mong các Bác bỏ chút thời gian viết dùm em cái, em đang cần gấp. :s_dead:
Nhờ các Bác viết dùng em 1 lisp dùng để chạy kích thước và ghi text khoảng cách song song và nằm giữa với đường line hoặc pline được chọn. Lisp sẽ tạo layer kthuoc nếu bản vẽ chưa có layer kthuoc.
1: nhập tỷ lệ bản vẽ ( do em làm bên trắc địa nên tỷ lệ bản vẽ thường là 1/200 = tỷ lệ 5/2, 1/500 = tỷ lệ 1/1, 1/1000 = 5/10)
2: có vẽ mũi tên hay không(c/k)
3: chọn các đối tượng cần ghi kích thước.
Dưới đây là file mẫu em thể hiện ở 2 tỷ lệ 1/500 và 1/200
http://www.cadviet.c...files/mau_7.dwg
Thank các Bác nhiều. :s_dead:
  • 0

#2484 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 23 July 2009 - 09:18 PM

Lisp này em đang cần, mong các Bác bỏ chút thời gian viết dùm em cái, em đang cần gấp. :s_dead:
Nhờ các Bác viết dùng em 1 lisp dùng để chạy kích thước và ghi text khoảng cách song song và nằm giữa với đường line hoặc pline được chọn. Lisp sẽ tạo layer kthuoc nếu bản vẽ chưa có layer kthuoc.
1: nhập tỷ lệ bản vẽ ( do em làm bên trắc địa nên tỷ lệ bản vẽ thường là 1/200 = tỷ lệ 5/2, 1/500 = tỷ lệ 1/1, 1/1000 = 5/10)
2: có vẽ mũi tên hay không(c/k)
3: chọn các đối tượng cần ghi kích thước.
Dưới đây là file mẫu em thể hiện ở 2 tỷ lệ 1/500 và 1/200
http://www.cadviet.c...files/mau_7.dwg
Thank các Bác nhiều. :s_dead:


Bạn thử cái này xem.
Khi nó hỏi "Co ve mui ten khong? (C/K) :" nếu có vẽ thì enter, ko vẽ thì gõ k
Khi nó hỏi "Ty le <1/500>: 1/" nếu là 1/500 thì enter, khác thì gõ 200 hay 1000...
Sau đó chọn line, mình chưa làm với pline, bạn nên chuyển hết sang line thì hay hơn.

(defun c:kt()
(vl-load-com)

(if (not tl) (setq tl 500))
(initget "C K")
(setq ck (getkword "\nCo ve mui ten khong? (C/K) :")
tl1 (getint (strcat "\nTy le <1/" (itoa tl) ">: 1/"))
ss (ssget '((0 . "LINE"))))
(if (not ck) (setq ck "C"))
(if tl1 (setq tl tl1))

(setq tln (/ tl 500.)
caoc 0.85
os (getvar "OSMODE"))
(setvar "OSMODE" 0)

(command "-layer" "n" "Kthuoc" "c" 4 "Kthuoc" "l" "continuous" "Kthuoc" "lw" "default" "Kthuoc" "")
(setvar "clayer" "Kthuoc")

(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(setq obj (vlax-ename->vla-object ent)
ndai (/ (setq dai (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj))) 2)
p1 (vlax-curve-getStartPoint obj)
p2 (vlax-curve-getEndPoint obj)
ang (if (< (car p1) (car p2)) (angle p1 p2) (angle p2 p1))
p1 (polar p1 (+ ang (* 0.5 pi)) 0.5)
p2 (polar p2 (+ ang (* 0.5 pi)) 0.5)
pm (polar (vlax-curve-getPointAtDist obj ndai) (+ ang (* 0.5 pi)) 0.3)
)
(command "text" "j" "BC" pm caoc (* 180 (/ ang pi)) (rtos (* tln dai) 2 2))
(if (= ck "C")
(progn (muiten p1 (angle p1 p2))
(muiten p2 (angle p2 p1)))
)
)
(setvar "OSMODE" os)
)

(defun muiten(pt an)
(entmakex (append '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (8 . "Kthuoc") (100 . "AcDbPolyline") (90 . 3))
(list (cons 10 pt) '(41 . 0.33) '(42 . 0.0)
(cons 10 (polar pt an 0.9)) '(41 . 0.0) '(42 . 0.0)
(cons 10 (polar pt an 1.8)))))
)


  • 1

#2485 xuandao0708

xuandao0708

    biết lệnh scale

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

Đã gửi 23 July 2009 - 09:34 PM

Thank Bác q288 nhiều, em text liền, Bác cho em hỏi 1 chút là tại sao lisp này chỉ chạy được với line, còn với pline thì sao nó chạy không được vậy Bác q288?
  • 0

#2486 xuandao0708

xuandao0708

    biết lệnh scale

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

Đã gửi 23 July 2009 - 09:51 PM

Bác q288 ơi khi chạy lisp kt của bác thì nó báo là:
Command: kt
Co ve mui ten khong? (C/K) : ; error: bad argument type: fixnump: 500.0
Command:
Command: KT
Co ve mui ten khong? (C/K) :k ; error: bad argument type: fixnump: 500.0
Không biết do cad em bị lỗi hay cho lisp bị lỗi. Em nhờ Bác coi lại dùm em chút.
Còn cái file acad.lsp thì em dùng chương trình của Bác Hoành thì đã giải quyết được rồi.Thank Bác nhiều.
  • 0

#2487 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 24 July 2009 - 08:14 AM

Bác q288 ơi khi chạy lisp kt của bác thì nó báo là:
Command: kt
Co ve mui ten khong? (C/K) : ; error: bad argument type: fixnump: 500.0
Command:
Command: KT
Co ve mui ten khong? (C/K) :k ; error: bad argument type: fixnump: 500.0
Không biết do cad em bị lỗi hay cho lisp bị lỗi. Em nhờ Bác coi lại dùm em chút.
Còn cái file acad.lsp thì em dùng chương trình của Bác Hoành thì đã giải quyết được rồi.Thank Bác nhiều.


Máy mình ko bị lỗi đó, đó là do có sự lẫn lộn số thực số nguyên, mình sửa lại thành số thực hết.
Còn vụ pline thì do bạn nói cần gấp thì mình viết gấp, vả lại đa số trong bản vẽ của bạn là line,
dĩ nhiên nếu gồm cả pline thì ct sẽ dài hơn.
Bây giờ thì có đủ line và pline, bạn chạy thử xem.

(defun muiten(pt an)
(entmakex (append '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (8 . "Kthuoc") (100 . "AcDbPolyline") (90 . 3))
(list (cons 10 pt) '(41 . 0.33) '(42 . 0.0)
(cons 10 (polar pt an 0.9)) '(41 . 0.0) '(42 . 0.0)
(cons 10 (polar pt an 1.8)))))
)

(defun laydinh(plObj / n L)
(setq n -1
L nil)
(repeat (fix (1+ (vlax-curve-getEndParam plObj)))
(setq L (append L (list (vlax-curve-getPointAtParam plObj (setq n (1+ n)))))))
L
)

(defun ghikt(obj k / Ldinh n p1 p2 ndai ang pm dai)
(if (= k 1)
(progn
(setq Ldinh (laydinh obj)
n 0)
(repeat (1- (length Ldinh))
(setq p1 (nth n Ldinh)
p2 (nth (setq n (1+ n)) Ldinh)
ndai (/ (setq dai (distance p1 p2)) 2)
ang (if (< (car p1) (car p2)) (angle p1 p2) (angle p2 p1))
p1 (polar p1 (+ ang (* 0.5 pi)) 0.5)
p2 (polar p2 (+ ang (* 0.5 pi)) 0.5)
pm (polar p1 (angle p1 p2) ndai)
)
(ghichu))
)
(progn
(setq p1 (vlax-curve-getStartPoint obj)
p2 (vlax-curve-getEndPoint obj)
ndai (/ (setq dai (distance p1 p2)) 2)
ang (if (< (car p1) (car p2)) (angle p1 p2) (angle p2 p1))
p1 (polar p1 (+ ang (* 0.5 pi)) 0.5)
p2 (polar p2 (+ ang (* 0.5 pi)) 0.5)
pm (polar p1 (angle p1 p2) ndai)
)
(ghichu)
))
)

(defun ghichu()
(entmakex (list '(0 . "TEXT") (cons 11 pm) (cons 10 pm) (cons 40 caoc) (cons 50 ang)
'(7 . "style1") '(72 . 1) '(73 . 1) (cons 1 (rtos (* tln dai) 2 2))))
(if (= ck "C")
(progn (muiten p1 (angle p1 p2))
(muiten p2 (angle p2 p1)))
)
)

(defun c:kt()
(vl-load-com)

(if (not tl) (setq tl 500))
(initget "C K")
(setq ck (getkword "\nCo ve mui ten khong? (C/K):")
tl1 (getreal (strcat "\nTy le <1/" (rtos tl 2 0) ">: 1/"))
ss (ssget '((0 . "LINE,*POLYLINE"))))

(if (not ck) (setq ck "C"))
(if tl1 (setq tl tl1))
(setq tln (/ tl 500)
caoc 0.85 )

(command "-layer" "n" "Kthuoc" "c" 4 "Kthuoc" "l" "continuous" "Kthuoc" "lw" "default" "Kthuoc" "")
(setvar "clayer" "Kthuoc")

(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(setq obj (vlax-ename->vla-object ent))
(if (= (cdr (assoc 0 (entget ent))) "LINE")
(ghikt obj 0)
(ghikt obj 1))
)
(princ)
)

  • 2

#2488 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 24 July 2009 - 08:27 AM

Mình đã test Lisp chạy tốt rồi. Bạn bổ sung giúp mình thêm chút nữa nhé: Trong những vị trí hai đường song song có gấp khúc lớn tại những vị trí đó Bạn có thể giúp mình nối tiếp đường thẳng bằng đường cong tròn có bán kính lớn hơn Rmin (nhập vào khi chạy chương trình) sao cho đường cong và đường polyline luôn tạo ra luôn nằm trọn ở giữa hai đường song song đó và phải đảm bảo tổng chiều dài của của đường thẳng và cánh tang của đường cong lớn hơn giá trị A.
Thân !


Vì bạn bổ sung thêm yêu cầu mà yêu cầu này hơi khó nên mình cần thời gian, bạn chịu khó chờ nhé.
  • 2

#2489 aliosa

aliosa

    biết vẽ polygon

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

Đã gửi 24 July 2009 - 10:33 AM

Vì bạn bổ sung thêm yêu cầu mà yêu cầu này hơi khó nên mình cần thời gian, bạn chịu khó chờ nhé.

MÌnh cảm ơn nhiều nhé! Thân!
  • 0

#2490 conghoan1003

conghoan1003

    biết vẽ point

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

Đã gửi 24 July 2009 - 01:37 PM

[quote name='conghoan1003' date='Jul 20 2009, 14:09' post='67829']
Cái này mình cũng đã thử rồi nhưng vẫn không có tác dụng gì. Mình đang dùng cad 2007 liệu có ảnh hưởng gì không Tuê_NV. Hình như Tuê_NV dùng lệnh trim để nối nó lại với nhau à? Tuệ_NV có thể chuyển sang dùng lệnh fillet (với R=0) được không? phải thử giải pháp này thế nào chứ Tuê_NV "bó tay" thì mình cũng "bó chân" luôn. Thấy cái này hay thế mà chưa sử dụng được thấy tiết quá. Tuệ cố gắng giúp mình lần nữa nhé. Thank a lot!
Có ai test thử lisp vet bùn không vậy? sao Tuê_NV test duợc mầ mình không làm được, bác nào test xong cho ý kiến nhé,và biết cái lỗi mà mình gặp chỉ giúp mình với. Thank!
Tue_NV ơi! chẳng lẽ bó tay thật sao!
  • 0
Học học nữa học mãi.
Đúp học lại!

#2491 dkkx3a

dkkx3a

    biết lệnh trim

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

Đã gửi 25 July 2009 - 08:32 PM

Xin nhờ các bạn trên diễn đàn viết hộ cho một Lisp, chả là cũng lục đục viết mà kém quá nên chịu.
Mình thường "ngồi" in các bản vẽ của người khác, khi in thì phải chọn nét in: chọn theo màu hoặc độ dày đối tượng. Nhưng kẹt nỗi nhiều bản vẽ bố trí layer lộn xộn, màu hỗn loạn, in xong một bản vẽ cho có hồn muốn lòi con mắt.
Mình nhờ các bạn viết 1 lisp chọn cả bản vẽ, nó sẽ tự lọc màu và đưa vào layer tương ứng, ví dụ như màu đỏ cho vào layer "Color1", vàng vào layer "color2"........., những màu có chỉ số >=10 thì cho vào một layer riêng. Các nét đứt, nét tâm cũng vậy cho vào layer riêng. Còn các ngoại lệ thì mình cố gắng căng mắt vậy (ẩn layer để chỉnh) sợ yêu cầu nhiều mất thời gian của các anh chị em. Mình cảm ơn trước. Đang rất cần cái này........trước mắt là một khối bản vẽ phải in của các "tác gia" không chuyên....Thanks
  • 0
TỰ SỰ
Biển vào chiều buồn giữa cô liêu
Sóng vỗ bờ bạc đầu con nước
Khi biển động như lòng ta chợt động
Biển ồn ào nhưng thực rất dịu êm.......

#2492 duonghung1210

duonghung1210

    biết lệnh offset

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

Đã gửi 25 July 2009 - 10:51 PM

Chào các bác, em đang cần lish làm tròn Dim, sao cho khi đo luôn được bội của 0 va 5. ví dụ giá trị thực là 411 nhưng khi đo thì được 410, giá trị thực là 444 khi do dim được giá trị 445. Em tim từ sáng tới h không có kết quả. Các bác giúp em nhé!!! thank :s_dead: :s_dead: :s_dead:
  • 0
Nhăn răng ra cười cho đời đỡ khổ!!!

#2493 haanh

haanh

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 2875 Bài viết
Điểm đánh giá: 1554 (rất tốt)

Đã gửi 25 July 2009 - 11:07 PM

Anh thử đọc bài này xem:

Lisp làm tròn số ( là Text) trong CAD ???????
http://www.cadviet.c...?showtopic=8183
  • 2

“Sống trong đời sống cần có một tấm lòng / Để làm gì em biết không ? / Để gió cuốn đi, để gió cuốn đi...”


#2494 duonghung1210

duonghung1210

    biết lệnh offset

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

Đã gửi 26 July 2009 - 01:11 AM

Anh thử đọc bài này xem:

Lisp làm tròn số ( là Text) trong CAD ???????
http://www.cadviet.c...?showtopic=8183

mình đọc rùi!!! nhưng đề bài ra là khác nhau mà!!! mình muốn làm tròn dim, không phải text!!! :s_dead:
Mình đang gặp phải trường hợp có bản vẽ các giá trị cứ bị lẻ: ví dụ: 4501, 18003, 9001.... lí do là khi đo để chế độ bắt điểm không tốt, nếu sửa lại bằng tay thì nông dân quá!!! Cũng có trường hợp khi scale đối tượng, các giá trị cũng bị lẽ như thế này. nên mình mới muốn hỏi mọi người có cách nào để giá trị dim khi đo luôn là bội số của 0 và 5 không?
Các cao thủ lish giúp cái nào!!! :s_dead: :s_dead: :s_dead:
  • 0
Nhăn răng ra cười cho đời đỡ khổ!!!

#2495 xuandao0708

xuandao0708

    biết lệnh scale

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

Đã gửi 26 July 2009 - 01:26 AM

Nhờ Bác Q288 coi lại dùm em 1 chút về lisp KT. Khi chạy lisp kt trên máy em thì xảy ra trường hợp như sau:
- Trên máy em thì có lisp này dùng để thể hiện tỷ lệ bản vẽ, và hệ số làm tròn. Khi em chạy lisp nà trước thì lisp KT của Bác nó không chạy được nữa. Nhờ Bác ngâm cứu dùm em coi vì sao nó không chạy được. Dưới đây là lisp trong máy em:
- Và em có 1 bản vẽ khi chạy lisp Kt của Bác thì nó không ra như file mẫu em đã úp lên mà nó ra rất kỳ, nhờ Bác coi hộ dùm em vì sao nó bị như vậy. Cá mơn Bác nhiều.
http://www.cadviet.c...les/mau_3_1.dwg

(setq TL (getvar "userr1"))
(if (<= (getvar "userr1") 0.0) (setvar "userr1" 500.0))
(setq lt ".")
(if (= 0 (getvar "useri1")) (setq lt " ")
(setq lt (repeat (getvar "useri1") (setq lt (strcat lt "0")))))
(setvar "modemacro"
(strcat
"TTKD-BD "
"Ty le ban ve : 1/$(getvar,userr1) . "
"He so lam tron : $(getvar,useri1) . "
"Font: $(getvar,textstyle) . "
)
)
(princ)
;-----------------------------------------------------------
;Xac dinh ty le ban ve
;Tra ve he so ty le
(defun tyle (/ TL)
(setq TL (getvar "USERR1"))
(if (> TL 0.0)
(progn
(prompt "Ty le ban ve dang la:1/ ") (princ TL)
(initget 6)
(setq TL (getreal (strcat "\nNhap ty le ban ve : ")))
)
(progn
(prompt "Ban ve chua dinh ty le.")
(initget 7) (setq TL (getreal "\nNhap ty le ban ve: "))
)
)
(setvar "USERR1" TL)
(load "statusbar.fas")
TL)
;Kiem tra ty le ban ve
;tra ve he so ty le
(defun tle (/ TL) (if (<= (getvar "userr1") 0.0) (tyle) (setq TL (getvar "userr1"))))
;Xac dinh he so lam tron
(defun c:lamtron (/ Ltron)
(setq Ltron (getvar "useri1"))
(prompt "He so lam tron dang dung la : ")
(princ Ltron)
(initget 1) (setq Ltron (getint "\nNhap he so lam tron : "))
(setvar "USERI1" Ltron)
(load "statusbar.fas")
(princ))

  • 0

#2496 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 26 July 2009 - 06:21 AM

mình đọc rùi!!! nhưng đề bài ra là khác nhau mà!!! mình muốn làm tròn dim, không phải text!!! :s_dead:
Mình đang gặp phải trường hợp có bản vẽ các giá trị cứ bị lẻ: ví dụ: 4501, 18003, 9001.... lí do là khi đo để chế độ bắt điểm không tốt, nếu sửa lại bằng tay thì nông dân quá!!! Cũng có trường hợp khi scale đối tượng, các giá trị cũng bị lẽ như thế này. nên mình mới muốn hỏi mọi người có cách nào để giá trị dim khi đo luôn là bội số của 0 và 5 không?
Các cao thủ lish giúp cái nào!!! :s_dead: :s_dead: :s_dead:

Vậy là độ chế dim rồi.
Bạn thử cái Lisp này Tue_NV viết xem sao :
(defun c:Rdim()
(prompt "\n Moi ban chon cac dim can lam tron :")
(setq ss (ssget '((0 . "DIMENSION")))
i 0)
(while (< i (sslength ss))
(setq ent (entget(ssname ss i)))
(setq content (cdr(assoc 42 ent)))
(setq du (rem content 5))
(if (= du 0) (setq content content))
(if (and (> du 0) (< du 2.5)) (setq content (rtos (- content du) 2 0)))
(if (>= du 2.5) (setq content (rtos (+ content (- 5 du)) 2 0)))
(setq ent (entmod(subst(cons 1 content) (assoc 1 ent) ent)))
(setq i (1+ i))
)
(princ)
)

  • 1

#2497 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 26 July 2009 - 06:49 AM

Xin nhờ các bạn trên diễn đàn viết hộ cho một Lisp, chả là cũng lục đục viết mà kém quá nên chịu.
Mình thường "ngồi" in các bản vẽ của người khác, khi in thì phải chọn nét in: chọn theo màu hoặc độ dày đối tượng. Nhưng kẹt nỗi nhiều bản vẽ bố trí layer lộn xộn, màu hỗn loạn, in xong một bản vẽ cho có hồn muốn lòi con mắt.
Mình nhờ các bạn viết 1 lisp chọn cả bản vẽ, nó sẽ tự lọc màu và đưa vào layer tương ứng, ví dụ như màu đỏ cho vào layer "Color1", vàng vào layer "color2"........., những màu có chỉ số >=10 thì cho vào một layer riêng. Các nét đứt, nét tâm cũng vậy cho vào layer riêng. Còn các ngoại lệ thì mình cố gắng căng mắt vậy (ẩn layer để chỉnh) sợ yêu cầu nhiều mất thời gian của các anh chị em. Mình cảm ơn trước. Đang rất cần cái này........trước mắt là một khối bản vẽ phải in của các "tác gia" không chuyên....Thanks

Bạn thử dùng Lisp này xem sao ?
chuyển các đối tuợng về Layer mới có tên LINETYLE+COLOR
  • 3

#2498 khaosat2009

khaosat2009

    biết lệnh offset

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

Đã gửi 26 July 2009 - 08:05 AM

Em cần một lisp để phân trang in trên bản vẽ lớn.
Yêu cầu là để xác định phạm vi in theo tỷ lệ và khổ giấy và xuất sang trang in.
với thao tác sau:
1. Chọn khu vực in : góc trái trên và góc phải dưới.
2. Nhập tỷ lệ in
3. Khập khổ giấy : ngang và dài.
4. Đánh số trang đã phân theo chiều từ trái sang phải.
thể hiện lưới hình chử nhật của bản vẽ.
5. Xuất sang trang in, khi chọn từng khung của lưới hình chử nhật.
Rất mong được các anh giúp
  • 0

#2499 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 26 July 2009 - 10:49 AM

Nhờ Bác Q288 coi lại dùm em 1 chút về lisp KT. Khi chạy lisp kt trên máy em thì xảy ra trường hợp như sau:
- Trên máy em thì có lisp này dùng để thể hiện tỷ lệ bản vẽ, và hệ số làm tròn. Khi em chạy lisp nà trước thì lisp KT của Bác nó không chạy được nữa. Nhờ Bác ngâm cứu dùm em coi vì sao nó không chạy được. Dưới đây là lisp trong máy em:
- Và em có 1 bản vẽ khi chạy lisp Kt của Bác thì nó không ra như file mẫu em đã úp lên mà nó ra rất kỳ, nhờ Bác coi hộ dùm em vì sao nó bị như vậy. Cá mơn Bác nhiều.


Do trùng tên biến thôi, mình sửa lại tên biến của lệnh kt rồi (vì ko muốn sửa file lamtron của bạn).
Còn file kia sở dĩ ko ra đúng là do trong đó ko có kiểu chữ style1 như file mẫu trước, bây giờ mình cho nó lấy kiểu chữ hiện hành để khỏi nhầm.
Bạn chạy thử xem còn vấn đề gì nữa ko.

(defun muiten(pt an)
(entmakex (append '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (8 . "Kthuoc") (100 . "AcDbPolyline") (90 . 3))
(list (cons 10 pt) '(41 . 0.33) '(42 . 0.0)
(cons 10 (polar pt an 0.9)) '(41 . 0.0) '(42 . 0.0)
(cons 10 (polar pt an 1.8)))))
)

(defun laydinh(plObj / n L)
(setq n -1
L nil)
(repeat (fix (1+ (vlax-curve-getEndParam plObj)))
(setq L (append L (list (vlax-curve-getPointAtParam plObj (setq n (1+ n)))))))
L
)

(defun ghikt(obj k / Ldinh n p1 p2 ndai ang pm dai)
(if (= k 1)
(progn
(setq Ldinh (laydinh obj)
n 0)
(repeat (1- (length Ldinh))
(setq p1 (nth n Ldinh)
p2 (nth (setq n (1+ n)) Ldinh)
ndai (/ (setq dai (distance p1 p2)) 2)
ang (if (< (car p1) (car p2)) (angle p1 p2) (angle p2 p1))
p1 (polar p1 (+ ang (* 0.5 pi)) 0.5)
p2 (polar p2 (+ ang (* 0.5 pi)) 0.5)
pm (polar p1 (angle p1 p2) ndai)
)
(ghichu))
)
(progn
(setq p1 (vlax-curve-getStartPoint obj)
p2 (vlax-curve-getEndPoint obj)
ndai (/ (setq dai (distance p1 p2)) 2)
ang (if (< (car p1) (car p2)) (angle p1 p2) (angle p2 p1))
p1 (polar p1 (+ ang (* 0.5 pi)) 0.5)
p2 (polar p2 (+ ang (* 0.5 pi)) 0.5)
pm (polar p1 (angle p1 p2) ndai)
)
(ghichu)
))
)

(defun ghichu()
(entmakex (list '(0 . "TEXT") (cons 11 pm) (cons 10 pm) (cons 40 caoc) (cons 50 ang)
'(72 . 1) '(73 . 1) (cons 1 (rtos (* scalen dai) 2 2))))
(if (= ck "C")
(progn (muiten p1 (angle p1 p2))
(muiten p2 (angle p2 p1)))
)
)

(defun c:kt(/ ck scale1 ss caoc scalen obj)
(vl-load-com)

(if (not scale) (setq scale 500))
(initget "C K")
(setq ck (getkword "\nCo ve mui ten khong? (C/K):")
scale1 (getreal (strcat "\nTy le <1/" (rtos scale 2 0) ">: 1/"))
ss (ssget '((0 . "LINE,*POLYLINE"))))

(if (not ck) (setq ck "C"))
(if scale1 (setq scale scale1))
(setq scalen (/ scale 500)
caoc 0.85 )

(command "-layer" "n" "Kthuoc" "c" 4 "Kthuoc" "l" "continuous" "Kthuoc" "lw" "default" "Kthuoc" "")
(setvar "clayer" "Kthuoc")

(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(setq obj (vlax-ename->vla-object ent))
(if (= (cdr (assoc 0 (entget ent))) "LINE")
(ghikt obj 0)
(ghikt obj 1))
)
(princ)
)

  • 2

#2500 xuandao0708

xuandao0708

    biết lệnh scale

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

Đã gửi 26 July 2009 - 12:50 PM

Thank Bác q288 trước, em sẽ thử liền.
  • 0