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

[duyhung 9]

cảm ơn bác tú,hj dùng đơn thuần là lisp và acet nhỉ ^^ e tưởng phải dùng visual lisp nên mơ hồ.

Để em học hỏi lisp bác.

[phamthanhbinh 3.146]

các pro cho em hỏi. em có down được 1 lisp thống kê. khi xuất kết quả ra các sồ bị bôi mờ màu xám. Vậy làm thế nào để nó bị mất cái viền màu xám đấy đi mà chỉ hiện số thôi.

Hề hề hề,

Bạn phải post cái líp đó lên thì mọi người mới biết sửa thế nào chứ.....

[vunguyen90 1]

Hề hề hề,

Bạn phải post cái líp đó lên thì mọi người mới biết sửa thế nào chứ.....

Đây các pro: http://www.cadviet.com/upfiles/3/ll_lgt_lc_ln_lh_l_lmh.lsp

các pro sửa giùm với

[ketxu 2.984]

các pro cho em hỏi. em có down được 1 lisp thống kê. khi xuất kết quả ra các sồ bị bôi mờ màu xám. Vậy làm thế nào để nó bị mất cái viền màu xám đấy đi mà chỉ hiện số thôi.

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

(setvar "fielddisplay" 0)

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ả

[dtvhtc 0]

Bạn dùng thu­ cái này nhé

(defun c:sum( / sset i entn entg n tong)
 (setq sset(ssget '((0 . "TEXT"))))
 (setq i 0 tong 0)
 (while (setq entn(ssname sset i))
   (setq i ( + i 1))
   (setq entg(entget entn))
   (setq n(atof(cdr(assoc 1 entg))))
   (setq tong(+ tong n))
   )
 (setq p(getpoint "\nChon diem ghi gia tri:"))
 (setq ht(getvar "textsize"))
 (command "text"  "j" "MC" p ht 0 (rtos tong 2 1))
 )

Mình cám ơn bạn nhiều lắm nhe

[dtvhtc 0]

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.

[hdt4151 1]

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 ?

[vunguyen90 1]

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.

[vunguyen90 1]

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.

[ketxu 2.984]

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

[phamngoctukts 714]

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à.

[ketxu 2.984]

Ý 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

[Tue_NV 3.912]

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ì....

[tomboy 21]

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.

[phamngoctukts 714]

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

[hdt4151 1]

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.

[Detailing 281]

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.

[Tue_NV 3.912]

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

[Detailing 281]

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"

[phamngoctukts 714]

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

[Tue_NV 3.912]

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.

[hdt4151 1]

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

[tomboy 21]

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

[tancadviet.com 0]

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.com/upfiles/B787_HCB.dwg

[Detailing 281]

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