Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Nguyen Hoanh

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

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

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.

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


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
phamthanhbinh    3.123

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

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


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
ketxu    2.653

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ả

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


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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

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


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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.

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


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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.

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


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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.

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


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
ketxu    2.653

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

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


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
phamngoctukts    708

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

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


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
ketxu    2.653

Ý 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

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


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Tue_NV    3.841

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

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


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
tomboy    20

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.

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


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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.

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


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Detailing    278

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.

tol.jpg

  • Vote tăng 1

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


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Tue_NV    3.841

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

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


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Detailing    278

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"

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


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
phamngoctukts    708

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

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


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Tue_NV    3.841

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.

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


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
tomboy    20

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

  • Vote tăng 1

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


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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

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


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Detailing    278

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?

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


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Khách
Chủ đề này bây giờ đã bị đóng lại để trả lời thêm.

×