- Còn theo em thì mọi người không nên tán những chuyện ngoài chuyên môn ở box này ^^

@NTD : 1 ví dụ để thấy yêu cầu k có gì là khó khăn - hoàn toàn có thể thêm các option vào cho nó :



(defun c:ssc(/ get-points)
(defun get-points (/ p pt)
(setq p (getpoint "\nChon diem goc :"))
(while (setq pt (getpoint p "\nCac diem tham chieu :"))
(setq *ss-list* (cons pt...

- Còn theo em thì mọi người không nên tán những chuyện ngoài chuyên môn ở box này ^^

@NTD : 1 ví dụ để thấy yêu cầu k có gì là khó khăn - hoàn toàn có thể thêm các option vào cho nó :



(defun c:ssc(/ get-points)
(defun get-points (/ p pt)
(setq p (getpoint "\nChon diem goc :"))
(while (setq pt (getpoint p "\nCac diem tham chieu :"))
(setq *ss-list* (cons pt *ss-list*))
)
(setq *ss-list* (mapcar '(lambda(x)(mapcar '- x p)) *ss-list*))
)
(or *ss-list* (get-points))
(princ "\nChon doi tuong bang phuong thuc cross :")
(setq ss (ssget "c" (setq p1 (getpoint "\np1"))(setq p2(getcorner p1 "\np2"))))
(command "zoom" "e")
(setq lst (mapcar '(lambda(x)(ssget "c" (mapcar '+ p1 x)(mapcar '+ p2 x))) *ss-list*))
(command "zoom" "p")
(sssetfirst nil (acet-ss-union (cons ss lst)))
(princ)
)

Bạn xem lại dòng này: AB trùng AC ==> view đc xoay 1 góc BAC ==> góc quay luôn dương (??). Mình viết theo kiểu Align space của cad:

(defun c:ACS(/ p1 p2 p3 goc vs)
(setq p1 (getpoint "\nChon Tam")
p2 (getpoint p1 "\nChon Phuong hien tai")
p3 (getpoint p1 "\nChon Phuong moi")
goc (-(angle p3 p1)(angle p2 p1))
vs (getvar "viewsize")
p1 (trans p1 1 0))
(command...

Bạn xem lại dòng này: AB trùng AC ==> view đc xoay 1 góc BAC ==> góc quay luôn dương (??). Mình viết theo kiểu Align space của cad:

(defun c:ACS(/ p1 p2 p3 goc vs)
(setq p1 (getpoint "\nChon Tam")
p2 (getpoint p1 "\nChon Phuong hien tai")
p3 (getpoint p1 "\nChon Phuong moi")
goc (-(angle p3 p1)(angle p2 p1))
vs (getvar "viewsize")
p1 (trans p1 1 0))
(command "ucs" "z" (/(* 180 goc)pi) "")
(command "plan" "")
(command "zoom" "c" (trans p1 0 1) vs)
(princ)
)


P/s Có bác lo cho topic này em sướng rồi , cảm ơn bác nhiều bạn mà viết như thế này là đã bỏ qua biết bao ý kiến của nhiều bác khác trong diễn đàn, mà cách giải quyết của họ có thể nhanh gọn và hay hơn của mình gấp nhiều lần. Bạn rút kinh nghiệm nhá!

Chắc là cộng dim ra con số tổng chứ hả? Code này chỉ cho ra kết quả tại dòng command line

(defun c:ccd(/ gtt dt sdt ent id)
(setq dt (ssget '((0 . "DIMENSION")))
sdt (sslength dt)
id 0
gtt 0
)
(repeat sdt
(setq
ent (ssname dt id)
id (1+ id)
gtt (+ gtt (gt1 ent) )
)
)
(princ gtt)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;

>>

Chắc là cộng dim ra con số tổng chứ hả? Code này chỉ cho ra kết quả tại dòng command line

(defun c:ccd(/ gtt dt sdt ent id)
(setq dt (ssget '((0 . "DIMENSION")))
sdt (sslength dt)
id 0
gtt 0
)
(repeat sdt
(setq
ent (ssname dt id)
id (1+ id)
gtt (+ gtt (gt1 ent) )
)
)
(princ gtt)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun gt1(ent / so)
(if (wcmatch(cdr(assoc 1 (entget ent)))"")
(setq so (cdr(assoc 42 (entget ent))))
(setq so (atof(cdr(assoc 1 (entget ent)))))
)
)

Bạn xài cái của mình xem sao
Mình để thêm trường hợp bạn vẽ dôc trên trắc dọc tức là tỷ lệ X và Y có thể không bằng nhau
Dùng LISP bằng lệnh DTL - VPL - D1 (khuyến mãi để đo dốc dọc )


;;; Free lisp code from CADViet.com - edit by Mathan
;;; Ve Pline theo chieu dai va do doc

>>

Bạn xài cái của mình xem sao
Mình để thêm trường hợp bạn vẽ dôc trên trắc dọc tức là tỷ lệ X và Y có thể không bằng nhau
Dùng LISP bằng lệnh DTL - VPL - D1 (khuyến mãi để đo dốc dọc )


;;; Free lisp code from CADViet.com - edit by Mathan
;;; Ve Pline theo chieu dai va do doc
;;;ho tro ve duong do trong civil - nova
(prompt "Edited by Mathan,dat ty le lenh DTL - Ve pline VPL - kiem tra doc lend D1")
;;;;;;;;;;
(defun c:DTL (/ )
(if (= ngang Nil)
(setq ngang 1000)
)
(if (= dung Nil)
(setq dung 100)
)
(setq str (strcat "\nNhap ty le ngang (press Enter or Space for get default): "))
(setq n (getint str))
(if (/= n Nil)
(setq ngang n)
)
(setq str (strcat "\nNhap ty le dung (press Enter or Space for get default): "))
(setq n (getint str))
(if (/= n Nil)
(setq dung n)
)
(setq tyle (/ ngang dung))
)
;;;;;;;;;;;;;;;;;;;;;;
(defun c:vpl (/ Pt Leng Slope X Y alpha)
(setq Pt (getpoint "\nSpecify first point: "))
(while (/= Leng 0.0)
(setq Leng 0.0 )
(vl-cmdf "_.pline" Pt)
(setq Leng (getdist "\nSpecify length of line : "))
(if (/= Leng nil)
(progn
(setq Slope (getreal "\nSpecify slope of line ...%: ")
alpha (atan Slope)
X leng
Y (/ (* Leng slope tyle) 100)
);
(setq Pt (list (+ X (car Pt)) (+ Y (cadr Pt))))
);
(progn
(vl-cmdf "")
(exit)
);
);end if
);end while
(princ)
);end defun
;;; ******************************** DO do doc don gian (d1) ***************************
(defun c:d1 ()
(setq p1 (getpoint "\nchon diem thu nhat: ")
p2 (getpoint p1"\nChon diem thu hai: "))
(setq dx (abs(- (car p1)(car p2))))
;---------------------------------;
(setq dx1 (abs(- (car p1)(car p2))))
(setq dy1 (abs(- (cadr p1)(cadr p2))))
(setq tl1 (/ (* dy1 100) (* dx tyle)))
(princ (strcat "\nDo doc hien tai(theo ty le): " (rtos tl1 2 4) "%"))
(princ)
)

Hề hề hề,
Sau một hồi ngọ nguậy thì ra được cái lisp này. Hy vọng nó sẽ giúp được bạn. Tuy nhiên vì mình chưa có thời gian check toàn bộ bản vẽ bạn gửi nên bạn chịu khó test thử, có gì chưa ổn thì post lên. Trước mắt thì thấy rằng các block trong bản vẽ của bạn không phải là hoàn toàn giống nhau nên có thể sẽ có tí lộn xộn. Rất mong bạn test và chỉ cho biết chỗ chưa...

Hề hề hề,
Sau một hồi ngọ nguậy thì ra được cái lisp này. Hy vọng nó sẽ giúp được bạn. Tuy nhiên vì mình chưa có thời gian check toàn bộ bản vẽ bạn gửi nên bạn chịu khó test thử, có gì chưa ổn thì post lên. Trước mắt thì thấy rằng các block trong bản vẽ của bạn không phải là hoàn toàn giống nhau nên có thể sẽ có tí lộn xộn. Rất mong bạn test và chỉ cho biết chỗ chưa ổn để mình sửa lại.
Lưu ý bạn rằng bản kết quả trong excel sẽ không có các dòng tiêu đề nên bạn hãy tự bổ sung cho nó phù hợp nhé. Và mình cũng chưa khử biến. Vậy nên khi dùng cần tránh bị xung đột biến với các lisp khác.


Chúc bạn vui.

Đếm block ATT thì đa dạng lắm,
1)có thể bạn chỉ cần đếm số lượng block mà không quan tâm đến nội dung của ATT VD: không cần phân biệt cửa D1 với D2 mà chỉ cần biết nó có block name là "Door"
2)hoặc bạn muốn đếm có bao nhiêu D1 và bao nhiêu D2? ở trường hợp này bạn cần phải cho người viết lisp biết block của bạn như thế nào, có mấy ATT....

bạn cần...

Đếm block ATT thì đa dạng lắm,
1)có thể bạn chỉ cần đếm số lượng block mà không quan tâm đến nội dung của ATT VD: không cần phân biệt cửa D1 với D2 mà chỉ cần biết nó có block name là "Door"
2)hoặc bạn muốn đếm có bao nhiêu D1 và bao nhiêu D2? ở trường hợp này bạn cần phải cho người viết lisp biết block của bạn như thế nào, có mấy ATT....

bạn cần nói rõ yêu cầu của mình!
Nếu là yêu cầu như trường hợp 1 bạn có thể dùng thử lisp này, nó tương tự như lệnh slect similar, các đối tượng cùng kiểu, cùng layer thì nó sẽ chọn hết.

(defun c:sw(/ aaa ls dt dt1 sdt sdt1 ent ent1 id id1)
(setq AAA(SSGET)
sdt (sslength AAA)
id 0
dt (ssadd)
)
(repeat sdt;;repeat1
(setq ent (ssname AAA id)
id (1+ id)
);;setq
(setq ls (entget ent))
(if (= (cdr (assoc 0 ls)) "INSERT")
(get-block ent)
(setq dt1(ssget"all"(list(assoc 0 ls) (assoc 8 ls))))
);;if
(setq sdt1 (sslength dt1)
id1 -1)
(while (setq ent1(ssname dt1 (setq id1 (1+ id1))))
(setq dt (ssadd ent1 dt))
);;While
(sssetfirst dt dt)
);;repeat1
(princ (strcat "\nco " (rtos (sslength dt)) " doi tuong." ))
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun get-block(entm / sdtb idb ent2 entb dtm namem name BBB entb)
(setq dtm (vlax-ename->vla-object entm))
(setq namem (if(vlax-property-available-p dtm 'effectivename)
(vla-get-effectivename dtm)
(vla-get-name dtm)
));;;
(setq BBB(SSGET "all" (list(cons 0 "INSERT") (assoc 8 (entget entm))))
sdtb (sslength BBB)
idb 0
dt1 (ssadd)
)
(repeat sdtb;;repeat
(setq entb (ssname BBB idb)
idb (1+ idb)
)
(setq ent2(vlax-ename->vla-object entb))
(setq name (if(vlax-property-available-p ent2 'effectivename)
(vla-get-effectivename ent2)
(vla-get-name ent2)
))
(if (= name namem)
(setq dt1 (ssadd entb dt1))
)
);;repeat
)

Bạn sửa lại như thế này, mình k test, viết tạm bạn test nhé


(defun C:CoBlk (/ i ss ls la)
(setq la (if (tblsearch "LAYER" "Block") "Block" (getvar 'clayer)))
(princ "\n Chon Blocks doi mau bylayer <select all>: ")
(setq i 0 ss (ssget '((0 . "INSERT"))))
(if (not ss)(setq ss (ssget "x" '((0 . "INSERT")))))
(command ".UNDO"...

Bạn sửa lại như thế này, mình k test, viết tạm bạn test nhé


(defun C:CoBlk (/ i ss ls la)
(setq la (if (tblsearch "LAYER" "Block") "Block" (getvar 'clayer)))
(princ "\n Chon Blocks doi mau bylayer <select all>: ")
(setq i 0 ss (ssget '((0 . "INSERT"))))
(if (not ss)(setq ss (ssget "x" '((0 . "INSERT")))))
(command ".UNDO" "BE")
(repeat (sslength ss)
(CoBylayer (ssname ss i))
(setq i (1+ i))
)
(command ".REGEN")
(command ".UNDO" "E")
(princ)
)
(defun CoBylayer (blk / e el s)
(setq s (cdr (assoc 2 (entget blk))))
(if (not (member s ls))
(progn
(setq ls (append ls (list s)))
(setq e (cdr (assoc -2 (tblsearch "BLOCK" s))))
(while e
(setq el (entget e))
(if (= "INSERT" (cdr (assoc 0 el)))
(CoBylayer e)
)
(setq el (subst (cons 8 la) (assoc 8 el) el))
(entmod el)
(setq e (entnext e))
)
)
)
)

Mình gửi bạn code này, không quá giống ý "tự động" của bạn
Nhưng khi bạn làm xong, đánh lệnh SFD xong, nó sẽ tự động vạch mặt những dim bạn đã edit
Màu bạn có thể thay đổi giá trị vào lisp trong ô (setq mau 5); số màu do bạn chọn nhé

;; Free lisp code from CADViet.com - edit...

Mình gửi bạn code này, không quá giống ý "tự động" của bạn
Nhưng khi bạn làm xong, đánh lệnh SFD xong, nó sẽ tự động vạch mặt những dim bạn đã edit
Màu bạn có thể thay đổi giá trị vào lisp trong ô (setq mau 5); số màu do bạn chọn nhé

;; Free lisp code from CADViet.com - edit by mathan
(defun c:sfd ( / ss)
(setq ss (ssget '((0 . "DIMENSION")
(-4 . "<NOT")
(-4 . "<OR")
(1 . "")
(1 . "*<>*")
(-4 . "OR>")
(-4 . "NOT>")
)
)
)
;(sssetfirst ss ss)
(setq mau 5);; Ban nhap mau vao day
(command "_CHANGE" ss "" "Properties" "Color" mau "")
(princ)
)

Hope U be fun with this code

Chào các anh,em có một đoạn lisp thế này :

(defun DCL ( lstType / fl ret dcl_id Return# add_lst )
(defun add_lst (key lst method)
(start_list key method)
(mapcar 'add_list lst)
(end_list)
)
(vl-load-com)
(setq fl (vl-filename-mktemp "mip" nil ".dcl"))
(setq ret (open fl "w"))
(mapcar
'(lambda (x) (write-line x ret))
(list
" mip_msg : dialog { label =...

Chào các anh,em có một đoạn lisp thế này :

(defun DCL ( lstType / fl ret dcl_id Return# add_lst )
(defun add_lst (key lst method)
(start_list key method)
(mapcar 'add_list lst)
(end_list)
)
(vl-load-com)
(setq fl (vl-filename-mktemp "mip" nil ".dcl"))
(setq ret (open fl "w"))
(mapcar
'(lambda (x) (write-line x ret))
(list
" mip_msg : dialog { label = \"ANSI B16.5 FORGED FLANGES\";"
" : boxed_column { label = \"Select The Type Of Flanges\";"
" : list_box { key = \"mylist\";width = 20;}"
" } "
" : boxed_column { label = \"Select Nominal Pipe Size\";"
" : popup_list {key = \"NPS\"; width = 17; height = 8;} "
" } "
" : boxed_column { label = \"Select Wall Thickness\";"
" : edit_box {label = \"Wall Thichkness : t =\"; key = \"Tlon\"; edit_width = 8;}"
" } "
" : row { "
" : button {label = \"OK\"; key = \"accept\"; width = 10; fixed_width = true;} "
" : button {label = \"Cancel\"; is_cancel = true; key = \"cancel\"; width = 10; fixed_width = true;}"
" } "
"} "
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun Get_lwn1()
(setq Tlon (atof (get_tile "Tlon"))
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq ret (close ret))
(if (and (not (minusp (setq dcl_id (load_dialog fl))))
(new_dialog "mip_msg" dcl_id)
)
(progn
(add_lst "mylist" '("CLASS 150 FLANGES UNDER 8 INCH" "CLASS 300 FLANGES UNDER 8 INCH" "CLASS 400 FLANGES UNDER 8 INCH" "CLASS 600 FLANGES UNDER 8 INCH" "CLASS 900 FLANGES UNDER 8 INCH" "CLASS 1500 FLANGES UNDER 8 INCH" "CLASS 150 FLANGES 10-24 INCH" "CLASS 300 FLANGES 10-24 INCH" "CLASS 400 FLANGES 10-24 INCH" "CLASS 600 FLANGES 10-24 INCH" "CLASS 900 FLANGES 10-24 INCH" "CLASS 1500 FLANGES 10-24 INCH") 3)
(set_tile "mylist" "0")
(add_lst "NPS" (mapcar '(lambda (x)(vl-princ-to-string (car x))) (cadadr lst)) 3)
(action_tile "mylist"
"(add_lst \"NPS\" (mapcar '(lambda (x)(vl-princ-to-string (car x))) (cadr (assoc $value lst))) 3)"
)
(action_tile "accept"
"(setq ret (cons (get_tile \"mylist\")
(cadr
(nth (atoi (get_tile \"NPS\")) (cadr (assoc (get_tile \"mylist\") lst))))
)
)(Get_lwn1)(done_dialog)")
(start_dialog)
)
)
(unload_dialog dcl_id)
(vl-file-delete fl)
ret
)
(defun c:wn (/ PR RL lst0 lst1 lst2 lst3 lst4 lst5 lst40 lst41 lst42 lst43 lst44 lst45 val pt lst)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(or fn0
(setq fn0 (findfile "C:\\Program Files\\Autodesk\\ACADM 2010\\flanges\\Data\\Welding Neck Under 8 inch class 150.txt"))
(setq fn0 (getfiled "Data Welding Neck Under 8 inch class 150" "" "txt" 2)))
(or fn1
(setq fn1 (findfile "C:\\Program Files\\Autodesk\\ACADM 2010\\flanges\\Data\\Welding Neck Under 8 inch class 300.txt"))
(setq fn1 (getfiled "Data Welding Neck Under 8 inch class 300" "" "txt" 2)))
(or fn2
(setq fn2 (findfile "C:\\Program Files\\Autodesk\\ACADM 2010\\flanges\\Data\\Welding Neck Under 8 inch class 400.txt"))
(setq fn2 (getfiled "Data Welding Neck Under 8 inch class 400" "" "txt" 2)))
(or fn3
(setq fn3 (findfile "C:\\Program Files\\Autodesk\\ACADM 2010\\flanges\\Data\\Welding Neck Under 8 inch class 600.txt"))
(setq fn3 (getfiled "Data Welding Neck Under 8 inch class 600" "" "txt" 2)))
(or fn4
(setq fn4 (findfile "C:\\Program Files\\Autodesk\\ACADM 2010\\flanges\\Data\\Welding Neck Under 8 inch class 900.txt"))
(setq fn4 (getfiled "Data Welding Neck Under 8 inch class 900" "" "txt" 2)))
(or fn5
(setq fn5 (findfile "C:\\Program Files\\Autodesk\\ACADM 2010\\flanges\\Data\\Welding Neck Under 8 inch class 1500.txt"))
(setq fn5 (getfiled "Data Welding Neck Under 8 inch class 1500" "" "txt" 2)))
(or fn40
(setq fn40 (findfile "C:\\Program Files\\Autodesk\\ACADM 2010\\flanges\\Data\\Welding Neck 10-24 inch class 150.txt"))
(setq fn40 (getfiled "Data Welding Neck Under 8 inch class 150" "" "txt" 2)))
(or fn41
(setq fn41 (findfile "C:\\Program Files\\Autodesk\\ACADM 2010\\flanges\\Data\\Welding Neck 10-24 inch class 300.txt"))
(setq fn41 (getfiled "Data Welding Neck Under 8 inch class 300" "" "txt" 2)))
(or fn42
(setq fn42 (findfile "C:\\Program Files\\Autodesk\\ACADM 2010\\flanges\\Data\\Welding Neck 10-24 inch class 400.txt"))
(setq fn42 (getfiled "Data Welding Neck Under 8 inch class 400" "" "txt" 2)))
(or fn43
(setq fn43 (findfile "C:\\Program Files\\Autodesk\\ACADM 2010\\flanges\\Data\\Welding Neck 10-24 inch class 600.txt"))
(setq fn43 (getfiled "Data Welding Neck Under 8 inch class 600" "" "txt" 2)))
(or fn44
(setq fn44 (findfile "C:\\Program Files\\Autodesk\\ACADM 2010\\flanges\\Data\\Welding Neck 10-24 inch class 900.txt"))
(setq fn44 (getfiled "Data Welding Neck Under 8 inch class 900" "" "txt" 2)))
(or fn45
(setq fn45 (findfile "C:\\Program Files\\Autodesk\\ACADM 2010\\flanges\\Data\\Welding Neck 10-24 inch class 1500.txt"))
(setq fn45 (getfiled "Data Welding Neck Under 8 inch class 1500" "" "txt" 2)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (and fn0 fn1 fn2 fn3 fn4 fn5 fn40 fn41 fn42 fn43 fn44 fn45)
(progn
; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq PR (open fn0 "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst0 (append lst0 (list (list (car RL)(cdr RL))))
)
)
(setq lst0 (list "0" lst0))
(close PR)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq PR (open fn1 "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst1 (append lst1 (list (list (car RL)(cdr RL))))
)
)
(setq lst1 (list "1" lst1))
(close PR)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq PR (open fn2 "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst2 (append lst2 (list (list (car RL)(cdr RL))))
)
)
(setq lst2 (list "2" lst2))
(close PR)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq PR (open fn3 "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst3 (append lst3 (list (list (car RL)(cdr RL))))
)
)
(setq lst3 (list "3" lst3))
(close PR)
; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq PR (open fn4 "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst4 (append lst4 (list (list (car RL)(cdr RL))))
)
)
(setq lst4 (list "4" lst4))
(close PR)
; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq PR (open fn5 "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst5 (append lst5 (list (list (car RL)(cdr RL))))
)
)
(setq lst5 (list "5" lst5))
(close PR)
(setq PR (open fn40 "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst40 (append lst40 (list (list (car RL)(cdr RL))))
)
)
(setq lst40 (list "6" lst40))
(close PR)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq PR (open fn41 "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst41 (append lst41 (list (list (car RL)(cdr RL))))
)
)
(setq lst41 (list "7" lst41))
(close PR)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq PR (open fn42 "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst42 (append lst42 (list (list (car RL)(cdr RL))))
)
)
(setq lst42 (list "8" lst42))
(close PR)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq PR (open fn43 "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst43 (append lst43 (list (list (car RL)(cdr RL))))
)
)
(setq lst43 (list "9" lst43))
(close PR)
; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq PR (open fn44 "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst44 (append lst44 (list (list (car RL)(cdr RL))))
)
)
(setq lst44 (list "10" lst44))
(close PR)
; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq PR (open fn45 "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst45 (append lst45 (list (list (car RL)(cdr RL))))
)
)
(setq lst45 (list "11" lst45))
(close PR)
; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq lst (list lst0 lst1 lst2 lst3 lst4 lst5 lst40 lst41 lst42 lst43 lst44 lst45))
(if
(and (setq val (DCL lst))
(setq pt (getpoint "\nStart Point:"))
)
(apply 'wna (append val (list pt)))
(princ "Error")
)
)
(princ "\nMissing File")
)
(princ)
)
;--------------------------------------------------------------------------------
(defun wna (Loai D X G tnho T1 A C D1 p1 / OldOS)
(setq OldOs(getvar "osmode"))
(setvar "osmode" 0)
(setq
P2(polar P1 0.0 (/ G 2))
P3(polar P2 (/ pi 2) 1.6)
P4(polar P3 0.0 (/ (- D G) 2))
P5(polar P4 (/ pi 2) tnho)
P6(polar P5 pi (/ (- D X) 2))
P7(polar P1 (/ pi 2) (+ T1 1.6))
P8(polar P7 0.0 (/ A 2))
P9(polar P8 (* pi 1.5) 6)
P10(polar P8 pi Tlon)
P11(polar P10 (* pi 1.5) (+ T1 1.6))
P12(polar P3 0.0 (/ (- C G) 2))
P13(polar P12 pi (/ D1 2))
P14(polar P13 (/ pi 2) tnho)
P15(polar P12 0.0 (/ D1 2))
P16(polar P15 (/ pi 2) tnho)
P17(polar P1 (* pi 1.5) (/ T1 8))
P18(polar P7 (/ pi 2) (/ T1 8))
P19(polar P12 (* pi 1.5) (/ tnho 8))
P20(polar P12 (/ pi 2) (+ tnho (/ tnho 8)))
P21(polar P1 0.0 (/ D 2))
P22(polar P7 pi (/ D 2))
)
(COMMAND "LAYER" "M" "3" "C" "3" "" "L" "CONTINUOUS" "" "")
(command "line" P1 P2 P3 P4 P5 P6 P9 P8 P7 "")
(command "line" P10 P11 "")
(command "line" P13 P14 "")
(command "line" P15 P16 "")
(COMMAND "LAYER" "M" "1" "C" "1" "" "L" "CENTER2" "" "")
(command "line" P17 P18 "")
(command "line" P19 P20 "")
(COMMAND "LAYER" "M" "3" "C" "3" "" "L" "CONTINUOUS" "" "")
(command "zoom" "a" "")
(command "zoom" "w" P21 P22)
(COMMAND "MIRROR" "BOX" P21 P7 "" P1 P7 "" )
(setvar "osmode" OldOs)
(princ)
)



Nếu viết như thế này thì em thấy cách lấy file dữ liệu có vẻ dài quá,có cách nào để làm ngắn gọn lại không vậy các anh ??

Thanks !!!!

Rất nhiều người phàn nàn về việc bị virus acad.lsp,

Nó làm cho máy tính của họ không pan bằng phím giữa được, zoom bằng phím giữa rất chậm, hatch chạy đâu mất, đối tượng được chọn không highlight.

Giải pháp được đưa ra để khắc phục:
- xóa hết các file acad.lsp trong máy đi, đặt các biến:
- zoomfactor về 60
- mbuttonpan về 1
- HIGHLIGHT về...

Rất nhiều người phàn nàn về việc bị virus acad.lsp,

Nó làm cho máy tính của họ không pan bằng phím giữa được, zoom bằng phím giữa rất chậm, hatch chạy đâu mất, đối tượng được chọn không highlight.

Giải pháp được đưa ra để khắc phục:
- xóa hết các file acad.lsp trong máy đi, đặt các biến:
- zoomfactor về 60
- mbuttonpan về 1
- HIGHLIGHT về 1
- fillmode về on

Nhưng khổ nỗi làm việc trong công ty, mở file qua mạng LAN, mình xóa hết hôm nay, nhưng đến ngày mai thì lại bị lây từ máy khác trong mạng.

Không thể suốt ngày ngồi xóa acad.lsp và đặt lại thông số hệ thống được. CADViet Antivirus sẽ giúp bạn trong tình thế này.

Bạn hãy download file CVAV về (bằng cách click vào nút download) rồi làm theo hướng dẫn:


1. Phải chuột vào link rồi chọn save as về máy bạn.
http://www.cadviet.com/upfiles/CVAVHelp1.png

2. Dùng lệnh appload: Tool > Load Application
http://www.cadviet.com/upfiles/CVAVHelp2.png

3. Chọn mục content
http://www.cadviet.com/upfiles/CVAVHelp3.png

4. Nhấn Add
http://www.cadviet.com/upfiles/CVAVHelp4.png

5. Chọn đến file file CVAV.lsp
http://www.cadviet.com/upfiles/CVAVHelp5.png

6. file file CVAV.lsp đã nằm trong danh sách khởi động, nhấn close để kết thúc
http://www.cadviet.com/upfiles/CVAVHelp6.png

Bây giờ bạn đã được bảo vệ khỏi sự quấy nhiễu của acad.lsp, mỗi khi thấy không còn có acad.lsp nữa, bạn muốn gỡ CVAV ra khỏi autocad, chỉ đơn giản là remove CVAV.lsp ra khỏi mục content là được.

Hãy thử sử dụng và cho chúng tôi biết ý kiến của bạn.

Lời khuyên: Hiên nay biến thể của virus này rất nhiều, rất nhiều trong số đó chưa được cập nhật vào trong CADViet Antivirus. Nếu bạn đã cài CADViet Antivirus vào máy thì máy bạn sẽ không bị nhiễm những biến thể thể này (cho dù CVAV chưa cập nhật). Vì vậy, tôi khuyên các bạn (nhất là các bạn không rành về IT) nên cài CADViet Antivirus vào máy tính của bạn vì CADViet Antivirus gần như không ảnh hưởng đến AutoCAD của bạn nhưng bạn sẽ tránh được các rắc rối do biến thể của virus gây nên.

Lisp của bạn đây. Mình sưu tầm của các bác trên diễn đàn

(defun c:daochieu (/ C10 C40 C41 C42 C50 C70 CC40 CC41 CC42 DINH ENT ENT2 I N N10 N40 N41 N42 N50 N70 NC40 NC41 NC42 OSMODEC SS SSN SSN2 TEST0 TEST1 C11 N11)
(while (null(setq ss (entsel "\n Chon polyline: "))))
(setq osmodec (getvar "osmode"))
(setvar "osmode" 1)
(setq dinh (getpoint "\n Chon diem dau: "))
(setq ssn (car...

Lisp của bạn đây. Mình sưu tầm của các bác trên diễn đàn

(defun c:daochieu (/ C10 C40 C41 C42 C50 C70 CC40 CC41 CC42 DINH ENT ENT2 I N N10 N40 N41 N42 N50 N70 NC40 NC41 NC42 OSMODEC SS SSN SSN2 TEST0 TEST1 C11 N11)
(while (null(setq ss (entsel "\n Chon polyline: "))))
(setq osmodec (getvar "osmode"))
(setvar "osmode" 1)
(setq dinh (getpoint "\n Chon diem dau: "))
(setq ssn (car ss))
(setq ent (entget ssn))
(if (= (cdr(assoc 0 ent)) "POLYLINE")
(progn
(setq test1 (vlax-curve-getEndPoint ssn))
(setq test2 (vlax-curve-getStartPoint ssn))
(if (=(cdr(assoc 66 ent)) 1)
(progn
(setq ssn2 (entnext ssn))
(setq ent2 (entget ssn2))
(setq test0 (cdr(assoc 10 ent2)))
(if (or(equal dinh test1 0.00001)(equal test1 test2))
(progn
(setq c42 (append c42 (list(cons 42 0))))
(setq c40 (append c40 (list(cons 40 0))))
(setq c41 (append c41 (list(cons 41 0))))
(While(/= (cdr(assoc 0 ent2)) "SEQEND")
(setq c10 (append c10 (list(assoc 10 ent2))))
(setq c40 (append c40 (list(assoc 40 ent2))))
(setq c41 (append c41 (list(assoc 41 ent2))))
(setq c42 (append c42 (list(assoc 42 ent2))))
(setq c70 (append c70 (list(assoc 70 ent2))))
(setq c50 (append c50 (list(assoc 50 ent2))))
(setq ssn2 (entnext ssn2))
(setq ent2 (entget ssn2))
);end while
(setq n (- (length c42) 2))
(setq i 0)
(while (<= i n)
(setq nc42 (append nc42 (list(nth i c42))))
(setq nc40 (append nc40 (list(nth i c40))))
(setq nc41 (append nc41 (list(nth i c41))))
(setq i (1+ i))
);end while
(setq i 1)
(while (<= i n)
(setq cc42 (append cc42 (list(nth i c42))))
(setq cc41 (append cc41 (list(nth i c41))))
(setq cc40 (append cc40 (list(nth i c40))))
(setq i (1+ i))
);end while
(setq c42 nil c42 cc42 c41 nil c41 cc41 c40 nil c40 cc40)
(setq ss (ssget "_P"))
(setq ent (entget ssn))
(if (=(cdr(assoc 66 ent)) 1)
(progn
(setq i 0)
(setq ssn2 (entnext ssn))
(setq ent2 (entget ssn2))
(setq n10 (reverse c10))
(setq n40 (reverse nc40))
(setq n41 (reverse nc41))
(setq n42 (reverse nc42))
(setq n70 (reverse c70))
(setq n50 (reverse c50))
(While(/= (cdr(assoc 0 ent2)) "SEQEND")
(setq ent2 (subst (nth i n10) (nth i c10) ent2))
(setq ent2 (subst (cons 40 (cdr(nth i n41))) (nth i c40) ent2))
(setq ent2 (subst (cons 41 (cdr(nth i n40))) (nth i c41) ent2))
(setq ent2 (subst (cons 42 (- 0 (cdr(nth i n42)))) (nth i c42) ent2))
(setq ent2 (subst (nth i n70) (nth i c70) ent2))
(setq ent2 (subst (nth i n50) (nth i c50) ent2))
(entmod ent2)
(setq i (1+ i))
(setq ssn2 (entnext ssn2))
(setq ent2 (entget ssn2))
);end while
(entupd ssn)
);end progn
);end if
);end progn
);end if
);end progn
);end if
);end progn
);end if
(if (= (cdr(assoc 0 ent)) "LINE")
(progn
(setq test0 (cdr(assoc 10 ent)))
(if (equal dinh test0 0.00001)
(progn
(setq c10 (assoc 10 ent))
(setq c11 (assoc 11 ent))
(setq n10 (assoc 11 ent))
(setq n11 (assoc 10 ent))
(setq ent (subst (cons 10 (cdr n10)) c10 ent))
(setq ent (subst (cons 11 (cdr n11)) c11 ent))
(entmod ent)
(entupd ssn)
);end progn
);end if
);end progn
);end if
(if (= (cdr(assoc 0 ent)) "ARC")
(progn
(vl-cmdf "pedit" ss "y" "")
(if (= (cdr(assoc 0 ent)) "POLYLINE")
(progn
(setq test1 (vlax-curve-getEndPoint ssn))
(if (=(cdr(assoc 66 ent)) 1)
(progn
(setq ssn2 (entnext ssn))
(setq ent2 (entget ssn2))
(setq test0 (cdr(assoc 10 ent2)))
(if (equal dinh test1 0.00001)
(progn
(setq c42 (append c42 (list(cons 42 0))))
(setq c40 (append c40 (list(cons 40 0))))
(setq c41 (append c41 (list(cons 41 0))))
(While(/= (cdr(assoc 0 ent2)) "SEQEND")
(setq c10 (append c10 (list(assoc 10 ent2))))
(setq c40 (append c40 (list(assoc 40 ent2))))
(setq c41 (append c41 (list(assoc 41 ent2))))
(setq c42 (append c42 (list(assoc 42 ent2))))
(setq c70 (append c70 (list(assoc 70 ent2))))
(setq c50 (append c50 (list(assoc 50 ent2))))
(setq ssn2 (entnext ssn2))
(setq ent2 (entget ssn2))
);end while
(setq n (- (length c42) 2))
(setq i 0)
(while (<= i n)
(setq nc42 (append nc42 (list(nth i c42))))
(setq nc40 (append nc40 (list(nth i c40))))
(setq nc41 (append nc41 (list(nth i c41))))
(setq i (1+ i))
);end while
(setq i 1)
(while (<= i n)
(setq cc42 (append cc42 (list(nth i c42))))
(setq cc41 (append cc41 (list(nth i c41))))
(setq cc40 (append cc40 (list(nth i c40))))
(setq i (1+ i))
);end while
(setq c42 nil c42 cc42 c41 nil c41 cc41 c40 nil c40 cc40)
(setq ss (ssget "_P"))
(setq ent (entget ssn))
(if (=(cdr(assoc 66 ent)) 1)
(progn
(setq i 0)
(setq ssn2 (entnext ssn))
(setq ent2 (entget ssn2))
(setq n10 (reverse c10))
(setq n40 (reverse nc40))
(setq n41 (reverse nc41))
(setq n42 (reverse nc42))
(setq n70 (reverse c70))
(setq n50 (reverse c50))
(While(/= (cdr(assoc 0 ent2)) "SEQEND")
(setq ent2 (subst (nth i n10) (nth i c10) ent2))
(setq ent2 (subst (cons 40 (cdr(nth i n41))) (nth i c40) ent2))
(setq ent2 (subst (cons 41 (cdr(nth i n40))) (nth i c41) ent2))
(setq ent2 (subst (cons 42 (- 0 (cdr(nth i n42)))) (nth i c42) ent2))
(setq ent2 (subst (nth i n70) (nth i c70) ent2))
(setq ent2 (subst (nth i n50) (nth i c50) ent2))
(entmod ent2)
(setq i (1+ i))
(setq ssn2 (entnext ssn2))
(setq ent2 (entget ssn2))
);end while
(entupd ssn)
);end progn
);end if
);end progn
);end if
);end progn
);end if
);end progn
);end if
);end progn
);end if
(setvar "osmode" osmodec)
(princ)
)

P/s: Lần sau bạn nên search trước khi hỏi nhé