Đến nội dung


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

Viết lisp theo yêu cầu [phần 2]


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

#3281 dtvhtc

dtvhtc

    biết zoom

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

Đã gửi 07 April 2011 - 10:55 PM

Của bạn đây, nhu­ng mình xuất cho bạn theo toạ độ của acad thôi nhé, nếu theo toạ độ bản đồ thì bạn phải vào exel đổi lại trục toạ độ, cần lu­u­ ý khi bạn chạy chu­o­ng trình nó sẽ hỏi bạn độ chính xác tu­ vị trí Point cho den vị trí text, nếu bạn nhập số lon quá thì có thể bạn không nhận đu­o­c kết quả nhu­ mong muốn, còn nếu bản vẽ của bạn giũa Text và Point là trùng nhau thì bạn nên chọn là 0.


(defun c:xyzo (/ text_loc input timgan save data)
(defun text_loc (entn / p entg text jum72 jum73 i loc )
(setq p '())
(setq entg (entget entn))
(setq text (cdr (assoc 0 entg)))
(if (= text "TEXT")
(progn
(setq jum72 (cdr (assoc 72 entg)))
(setq jum73 (cdr (assoc 73 entg)))
(cond
((= jum72 1) (setq i 11))
((= jum72 2) (setq i 11))
((= jum72 4) (setq i 11))
((= jum72 3) (setq i 10))
((= jum72 5) (setq i 10))
((= jum72 0)
(progn
(if (= jum73 0)
(setq i 10)
(setq i 11)
)
)
)
)
(setq loc (cdr (assoc i entg)))
(setq p (subst 0 (caddr loc) loc))
)
)
p
) ;end sub text_loc
(defun input (/ sset i pts txts entn entg dxf)
(setq sset (ssget '((0 . "POINT,TEXT"))))
(setq i 0
pts '()
txts '()
)
(if sset
(while (setq entn (ssname sset i))


(setq i (+ i 1)
entg (entget entn)
dxf (cdr (assoc 0 entg))
)
(cond
((= dxf "POINT")
(setq pts (append pts (list (cdr (assoc 10 entg)))))
)
((= dxf "TEXT")
(setq txts
(append txts
(list (list (cdr (assoc 1 entg)) (text_loc entn)))
)
)
)
)
)
)
(if (and pts txts)
(list pts txts)
)
) ;end sub input
(defun timgan (p txts dk / p1 p2 d dmin ans)
(if txts
(progn
(setq p1 (subst 0 (caddr p) p))
(foreach x txts
(setq p2 (cadr x))
(setq d (distance p1 p2))
(if (not dmin)
(setq dmin d
k x
)
(if (< d dmin)
(setq dmin d
k x
)
)
)
)
(setq txts (vl-remove k txts))
(if (<= dmin dk)
(setq ans
(strcat
(car k)
(apply
'strcat
(mapcar '(lambda (e) (strcat "\t" (rtos e 2 3))) p)
)
)
)
)
)
)
(list txts ans)
) ;end sub timgan
(defun xuly (pts txts / dk ans kq)
(setq dk
(getdist
(strcat "\nDo chinh xac (Nguy hiem neu ban chon qua lon): <"
(rtos (abs (getvar "userr1")) 2 2)
"> "
)
)
)
(if dk
(setvar "userr1" (setq dk (abs dk)))
(setq dk (abs (getvar "userr1")))
)
(setq pts (mapcar '(lambda (e)
(progn
(setq ans (timgan e txts dk))
(setq txts (car ans)
kq (cadr ans)
)
)
)
pts
)
)
pts
) ;end sub xuly
(defun save (data / path fn f)
(if data
(progn
(setq path (vl-filename-directory (getvar "users1")))
(if (= path "")
(setq path (getvar "acadprefix"))
(setq path (strcat path "\\;"))
)
(setq fn (getfiled "Save as file." path "xyz;xy;pts" 1))
(if fn
(progn
(setvar "users1" fn)
(setq f (open fn "w"))
(foreach x data
(write-line x f)
)
(close f)
(alert "Program is completed")
)
)
)
(alert
"That bai\nTap hop diem chon khong thoa man dieu kien do chinh xac"
)
)
) ;end sub save
;;; -------------------MAIN----------------------
(setq data (input))

(if data
(progn
(setq data (xuly (car data) (cadr data)))
(setq data (vl-remove nil data))
(save data)
)
(alert
"That bai\nTap hop chon phai bao gom cac cap Point va Text"
)
)
)

Mình cám ơn bạn nhiều!
Bạn tomboy cho mình đồi hỏi thêm tý nữa nhe, giá như lisp của bạn không cần đồi hỏi khoảng cách vị trí giữa text và point thì rất tuyệt, tại vì các file dwg của mình hiện giờ khoảng cách giữa vị trí text và poit không điều nhau nên mình không đưa về trùng nhau được còn nếu chọn theo khoảng cách giữa text và point thì thất bại. Bạn làm thì làm ơn cho trót nhe giúp mình tiếp nhe.
  • 0

#3282 hdt4151

hdt4151

    biết vẽ pline

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

Đã gửi 08 April 2011 - 08:19 AM

Cho mình hỏi những text sau khi dùng lệnh Find - replace all có cách nào để chọn lại toàn bộ text đó k ?
  • 0

#3283 vunguyen90

vunguyen90

    biết vẽ circle

  • Advance Member
  • PipPip
  • 30 Bài viết
Điểm đánh giá: 1 (bình thường)

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

Bạn tự cho thêm dòng này vào cuối file lisp :

Hoặc copy trực tiếp dòng đó vào commandline của cad. Đây là 1 thiết đặt hiển thị của field chứ không ảnh hưởng gì đến kết quả cả

Được rùi pro ạ. Thanks a lot.
  • 0
vjpnguyen_vietnamidol

#3284 vunguyen90

vunguyen90

    biết vẽ circle

  • Advance Member
  • PipPip
  • 30 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 08 April 2011 - 08:40 AM

Bạn tự cho thêm dòng này vào cuối file lisp :

Hoặc copy trực tiếp dòng đó vào commandline của cad. Đây là 1 thiết đặt hiển thị của field chứ không ảnh hưởng gì đến kết quả cả

Được rùi pro ạ. thanks a lot.
  • 0
vjpnguyen_vietnamidol

#3285 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 08 April 2011 - 08:40 AM

Cho mình hỏi những text sau khi dùng lệnh Find - replace all có cách nào để chọn lại toàn bộ text đó k ?

Theo mình biết nếu thuần CAD thì không. Chắc bạn phải chọn lại tập cũ + chọn lựa trong qselect, hoặc dùng find and repalce bằng lisp nào đó có gom lại đối tượng ^^
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3286 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 08 April 2011 - 08:49 AM

Theo mình biết nếu thuần CAD thì không. Chắc bạn phải chọn lại tập cũ + chọn lựa trong qselect, hoặc dùng find and repalce bằng lisp nào đó có gom lại đối tượng ^^

Em à Cái này nếu thuần Cad có thể dùng filter với textvalue là nội dung text mà.
  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#3287 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 08 April 2011 - 09:01 AM

Ý bác có khác gì ý em là chọn lại tập hợp với lựa chọn qselect ạ ^^Vấn đề là bạn ấy đã chọn rất nhiều nhiều text, rồi mới replace chứ hok phải tìm từ đầu
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3288 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 08 April 2011 - 09:16 AM

Em à Cái này nếu thuần Cad có thể dùng filter với textvalue là nội dung text mà.

Thay 1 lần thì còn được chứ thay nhiều lần trong 1 lenh find thì....
  • 0

#3289 tomboy

tomboy

    biết vẽ polygon

  • Members
  • PipPip
  • 72 Bài viết
Điểm đánh giá: 20 (tàm tạm)

Đã gửi 08 April 2011 - 09:19 AM

http://www.cadviet.com/upfiles/3/toado_mau1_1.dwg
đa save lại cad2004, rất mong được bạn giúp

tình hình là mình chưa mở file của bạn được vì mình vừa cài mới acad2005 từ disc CD, nhưng cái file keygen của nó bị hư nên không active đươc, mà acad2004 mình lại kill mất rồi. Do vậy mình xin file keygen for acad2005 từ các bạn trên diễn đàn nhé!
Thank very much.
  • 0

#3290 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 08 April 2011 - 09:27 AM

Thay 1 lần thì còn được chứ thay nhiều lần trong 1 lenh find thì....

Không hiểu ý của Bác???
  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#3291 hdt4151

hdt4151

    biết vẽ pline

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

Đã gửi 08 April 2011 - 09:28 AM

Mình có các text như sau: 10/60 11/60 .... 60/60 , find-replace all => 10/62 11/62 ... 60/62 , muốn chọn lại những text này nhưng dùng 'p' thì chỉ đc 1 text, còn dùng 'fi và qselect thì hình như k có chế độ chọn text chứa 1 vài từ mà là value chính xác của text luôn.
  • 0

#3292 Detailing

Detailing

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 667 Bài viết
Điểm đánh giá: 278 (khá)

Đã gửi 08 April 2011 - 09:32 AM

Mình có các text như sau: 10/60 11/60 .... 60/60 , find-replace all => 10/62 11/62 ... 60/62 , muốn chọn lại những text này nhưng dùng 'p' thì chỉ đc 1 text, còn dùng 'fi và qselect thì hình như k có chế độ chọn text chứa 1 vài từ mà là value chính xác của text luôn.

bạn xem cái hình này rồi edit lại theo cái text của bạn.
Hình đã gửi
  • 1

Ideas don't matter, execution does!

1908412_308002392716743_8165279281236341


#3293 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 08 April 2011 - 09:34 AM

Không hiểu ý của Bác???

Mình viết rõ lắm mà: Thay nhiều lần trong 1 lệnh find -> Tìm các từ đã bị thay thế.
Phải viết code thôi bạn à?
Ví dụ : Chọn 1 loạt Text -> Dùng lệnh Find -> Replace all
thay chữ "abc" thành "cde"
thay tiếp "bcd" thành "ghfh"
tiếp tục .....
-> Tìm toàn bộ các chữ đã bị thay
  • 0

#3294 Detailing

Detailing

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 667 Bài viết
Điểm đánh giá: 278 (khá)

Đã gửi 08 April 2011 - 09:42 AM

Mình viết rõ lắm mà: Thay nhiều lần trong 1 lệnh find -> Tìm các từ đã bị thay thế.
Phải viết code thôi bạn à?
Ví dụ : Chọn 1 loạt Text -> Dùng lệnh Find -> Replace all
thay chữ "abc" thành "cde"
thay tiếp "bcd" thành "ghfh"
tiếp tục .....
-> Tìm toàn bộ các chữ đã bị thay

dùng Quịk select nhiều lần với option "Append to curent selection set"
  • 0

Ideas don't matter, execution does!

1908412_308002392716743_8165279281236341


#3295 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 08 April 2011 - 09:46 AM

Mình viết rõ lắm mà: Thay nhiều lần trong 1 lệnh find -> Tìm các từ đã bị thay thế.
Phải viết code thôi bạn à?
Ví dụ : Chọn 1 loạt Text -> Dùng lệnh Find -> Replace all
thay chữ "abc" thành "cde"
thay tiếp "bcd" thành "ghfh"
tiếp tục .....
-> Tìm toàn bộ các chữ đã bị thay

À bây giờ thì em đã hiểu...
  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#3296 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 08 April 2011 - 09:47 AM

dùng Quịk select nhiều lần với option "Append to curent selection set"

"Quịk" select lần này thì không "quịt" (quick) được rồi :lol: . Mất công phải nhớ lại mình đã thay những chữ gì. Bộ nhớ con người không tốt coi bộ cũng không ổn. :rolleyes:
Thực ra để chắc chắn, cái này mọi người cũng làm từng nhát 1 trong lệnh Find thôi.
  • 0

#3297 hdt4151

hdt4151

    biết vẽ pline

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

Đã gửi 08 April 2011 - 09:50 AM

@Detailing: thank bạn, có cái wildcard match mà quên mất ^^!
  • 0

#3298 tomboy

tomboy

    biết vẽ polygon

  • Members
  • PipPip
  • 72 Bài viết
Điểm đánh giá: 20 (tàm tạm)

Đã gửi 08 April 2011 - 11:22 AM

Mình cám ơn bạn nhiều!
Bạn tomboy cho mình đồi hỏi thêm tý nữa nhe, giá như lisp của bạn không cần đồi hỏi khoảng cách vị trí giữa text và point thì rất tuyệt, tại vì các file dwg của mình hiện giờ khoảng cách giữa vị trí text và poit không điều nhau nên mình không đưa về trùng nhau được còn nếu chọn theo khoảng cách giữa text và point thì thất bại. Bạn làm thì làm ơn cho trót nhe giúp mình tiếp nhe.

mình thêm vào cho ban lựa chọn Độ chính xác, Khi chạy chương trình nó sẽ đưa ra 1 hộp thoại cho phép bạn chọn hay không chọn độ chính xác. Sau khi bạn thiết lập các lựa chọn xong, bạn có thể tắt hộp thoại này cho đến khi bạn mở bản vẽ lần sau.

(defun c:xyzo (/ makedcl getdcx text_loc input timgan save data)
(defun makedcl (fn lst / fn f)
(if (not (findfile fn))
(progn
(setq fn (strcat (vl-filename-directory (findfile "acad.exe"))
"\\"
fn
)
)
(setq f (open fn "w"))
(foreach pp lst
(write-line pp f)
)
(close f)
)
)
) ;end sub makedcl
(defun getdcx (/ display)
(defun check (val / ok test)
(if (setq test (distof val))
(if (< test 0)
(setq ok "YES")
(if (> test 0.1)
(set_tile "text" "Nguy hiem neu ban nhap so lon")
(set_tile "text" "")
)
)
(setq ok "YES")
)
(if (= ok "YES")
(progn
(set_tile "text" "Khong hop le, phai la so va lon hon 0")
(mode_tile "input" 2)
)
)
val
) ;end sub check of getdcx
(defun display (val)
(if (= val "1")
(progn
(mode_tile "input" 0)
(mode_tile "input" 2)
)
(mode_tile "input" 1)
)
val
) ;end sub display of getdcx
(setq dcl_dat
'("input:dialog{"
"label=\"Input data:\";"
": boxed_column {"
"label = \"Setting\";"
": toggle { label = \"Do chinh xac neu co\"; key = \"dcx\"; }"
":edit_box {key=\"input\"; edit_limit = 10; width = 10;}"
":text {key = \"text\";}"
":spacer {}"
"}"
": button {"
"label = \" Ok \";"
"mnemonic = \"Y\";"
"key = \"accept\";"
"is_default=true;"
"fixed_width=true;"
"width=12;"
"alignment=centered;"
"}"
": toggle { label = \"Khong xuat hien hop thoai nay\"; key = \"kxh\"; }"
"}"
)
)
(if (not dcx_val)
(setq dcx_val 0)
)
(if (not dcx_status)
(setq dcx_status "1")
)
(if (not dcx_display)
(setq dcx_display "0")
)
(setq dcx_val (rtos dcx_val 2 2))
(makedcl "getdcx.dcl" dcl_dat)
(if (= dcx_display "0")
(progn
(setq dcl_id (load_dialog "getdcx.dcl"))
(new_dialog "input" dcl_id)
(set_tile "dcx" dcx_status)
(set_tile "input" dcx_val)
(display dcx_status)
(action_tile "dcx" "(setq dcx_status(display $value))")
(action_tile "input" "(setq dcx_val (check $value))")
(action_tile "kxh" "(setq dcx_display $value)")
(start_dialog)

)
)
(setq dcx_val (atof dcx_val))
(if (= dcx_status "1")
dcx_val
)
) ;end sub getdcx
(defun text_loc (entn / p entg text jum72 jum73 i loc)
(setq p '())
(setq entg (entget entn))
(setq text (cdr (assoc 0 entg)))
(if (= text "TEXT")
(progn
(setq jum72 (cdr (assoc 72 entg)))
(setq jum73 (cdr (assoc 73 entg)))
(cond
((= jum72 1) (setq i 11))
((= jum72 2) (setq i 11))
((= jum72 4) (setq i 11))
((= jum72 3) (setq i 10))
((= jum72 5) (setq i 10))
((= jum72 0)
(progn
(if (= jum73 0)
(setq i 10)
(setq i 11)
)
)
)
)
(setq loc (cdr (assoc i entg)))
(setq p (subst 0 (caddr loc) loc))
)
)
p
) ;end sub text_loc
(defun input (/ sset i pts txts entn entg dxf)
(setq sset (ssget '((0 . "POINT,TEXT"))))
(setq i 0
pts '()
txts '()
)
(if sset
(while (setq entn (ssname sset i))


(setq i (+ i 1)
entg (entget entn)
dxf (cdr (assoc 0 entg))
)
(cond
((= dxf "POINT")
(setq pts (append pts (list (cdr (assoc 10 entg)))))
)
((= dxf "TEXT")
(setq txts
(append txts
(list (list (cdr (assoc 1 entg)) (text_loc entn)))
)
)
)
)
)
)
(if (and pts txts)
(list pts txts)
)
) ;end sub input
(defun timgan (p txts dk / p1 p2 d dmin ans)
(if txts
(progn
(setq p1 (subst 0 (caddr p) p))
(foreach x txts
(setq p2 (cadr x))
(setq d (distance p1 p2))
(if (not dmin)
(setq dmin d
k x
)
(if (< d dmin)
(setq dmin d
k x
)
)
)
)
(setq txts (vl-remove k txts))
(if (not dk)
(setq dk 0))
)
(if (<= dmin dk)
(setq ans
(strcat
(car k)
(apply
'strcat
(mapcar '(lambda (e) (strcat "\t" (rtos e 2 3))) p)
)
)
)
)
)
)
(list txts ans)
) ;end sub timgan
(defun xuly (pts txts / dk ans kq)
(setq dk (getdcx))

(setq pts (mapcar '(lambda (e)
(progn
(setq ans (timgan e txts dk))
(setq txts (car ans)
kq (cadr ans)
)
)
)
pts
)
)
pts
) ;end sub xuly
(defun save (data / path fn f)
(if data
(progn
(setq path (vl-filename-directory (getvar "users1")))
(if (= path "")
(setq path (getvar "acadprefix"))
(setq path (strcat path "\\;"))
)
(setq fn (getfiled "Save as file." path "xyz;xy;pts" 1))
(if fn
(progn
(setvar "users1" fn)
(setq f (open fn "w"))
(foreach x data
(write-line x f)
)
(close f)
(alert "Program is completed")
)
)
)
(alert
"That bai\nTap hop diem chon khong thoa man dieu kien do chinh xac"
)
)
) ;end sub save
;;; -------------------MAIN----------------------
(setq data (input))

(if data
(progn
(setq data (xuly (car data) (cadr data)))
(setq data (vl-remove nil data))
(save data)
)
(alert
"That bai\nTap hop chon phai bao gom cac cap Point va Text"
)
)
)


  • 1

#3299 tancadviet.com

tancadviet.com

    biết pan

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

Đã gửi 09 April 2011 - 10:58 AM

GIÚP VỚI :em mới hoc cad , mấy anh pro ơi giúp em viết cái code của hình chiếu bằng máy bay boeing 787 . sau đó hỏi có xoay máy bay không ( yes/no?[no]). nếu có thì cho máy bay xoay với tâm xoay là giao điểm của đường thẳng từ mũi cánh máy bay với đường thẳng từ đầu máy bay tới đuôi. xoay 1 góc anpha nào đó. em xin cám ơn .
( em rất ghét phải nói câu này nhưng mà em cần code này gấp ) tks các anh trước.
day là hình boeing :link: http://www.cadviet.c...es/B787_HCB.dwg
  • 0

#3300 Detailing

Detailing

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 667 Bài viết
Điểm đánh giá: 278 (khá)

Đã gửi 09 April 2011 - 11:14 AM

GIÚP VỚI :em mới hoc cad , mấy anh pro ơi giúp em viết cái code của hình chiếu bằng máy bay boeing 787 . sau đó hỏi có xoay máy bay không ( yes/no?[no]). nếu có thì cho máy bay xoay với tâm xoay là giao điểm của đường thẳng từ mũi cánh máy bay với đường thẳng từ đầu máy bay tới đuôi. xoay 1 góc anpha nào đó. em xin cám ơn .
( em rất ghét phải nói câu này nhưng mà em cần code này gấp ) tks các anh trước.
day là hình boeing :link: http://www.cadviet.c...es/B787_HCB.dwg


Block cái máy bay đó lại với insert point là cái giao điểm rồi muốn quay đâu đó thì quay.
p/s: cái code của hình chiếu bằng là sao?
  • 0

Ideas don't matter, execution does!

1908412_308002392716743_8165279281236341