Jump to content
InfoFile
Tác giả: hiepttr
Bài viết gốc: 249004
Tên lệnh: trans2
BT chương 4.3 - Xử lý list

Sửa theo ý 2 của bác Tue_NV:

Từ không có >>> trả về nil >>> tạm chấp nhận vậy :D

;bai tap 4.3.5_2 TRA TU DIEN
(defun c:TRANS2( / str)
(setq str (xstrcase (getstring "\n Nhap mot tu Tieng Anh <LOVE/HATE/WONDERFUL/FUN/THANKS>: ")))
(princ (cdr (assoc str (list (cons "LOVE" "YEU") (cons "HATE" "GHET") (cons "WONDERFUL" "TUYET VOI") (cons  "FUN" "VUI") (cons  "THANKS" "CAM ON (Tue_NV)")))))
(princ)
)

Filename: 249004_trans2.lsp
Tác giả: KangKung
Bài viết gốc: 249124
Tên lệnh: test
Chuyển các đối tượng về 1 layer ngay cả block

Lisp đây. Gõ lệnh Test xong toàn bộ đối tượng trên bản vẽ được chuyển về layer cùng tên, kể cả block.

(defun C:test( / layname)
  (vl-load-com)
  (vlax-for for-item (vla-get-blocks(vla-get-activedocument(vlax-get-acad-object)))
    (vlax-for item for-item
      (if (not (tblsearch "LAYER" (setq layname (substr (vla-get-ObjectName item) 5))))
	(vla-add(vla-get-layers(vla-get-ActiveDocument(vlax-get-acad-object)))...
>>

Lisp đây. Gõ lệnh Test xong toàn bộ đối tượng trên bản vẽ được chuyển về layer cùng tên, kể cả block.

(defun C:test( / layname)
  (vl-load-com)
  (vlax-for for-item (vla-get-blocks(vla-get-activedocument(vlax-get-acad-object)))
    (vlax-for item for-item
      (if (not (tblsearch "LAYER" (setq layname (substr (vla-get-ObjectName item) 5))))
	(vla-add(vla-get-layers(vla-get-ActiveDocument(vlax-get-acad-object))) layname)
	)
      (vla-put-layer item layname)
      )
    )
  )

<<

Filename: 249124_test.lsp
Tác giả: KangKung
Bài viết gốc: 249138
Tên lệnh: test
Chuyển các đối tượng về 1 layer ngay cả block

<pre class="_prettyXprint _lang-sql">
(defun C:test ()
(vl-load-com)
(if (not (tblsearch &quot;LAYER&quot; &quot;A&quot;))
(vla-add (vla-get-layers(vla-get-ActiveDocument (vlax-get-acad-object))) &quot;A&quot;))
(if (not (tblsearch &quot;LAYER&quot; &quot;B&quot;))
(vla-add (vla-get-layers(vla-get-ActiveDocument (vlax-get-acad-object))) &quot;B&quot;))
(if (not (tblsearch &quot;LAYER&quot;...
>>
<pre class="_prettyXprint _lang-sql">
(defun C:test ()
(vl-load-com)
(if (not (tblsearch &quot;LAYER&quot; &quot;A&quot;))
(vla-add (vla-get-layers(vla-get-ActiveDocument (vlax-get-acad-object))) &quot;A&quot;))
(if (not (tblsearch &quot;LAYER&quot; &quot;B&quot;))
(vla-add (vla-get-layers(vla-get-ActiveDocument (vlax-get-acad-object))) &quot;B&quot;))
(if (not (tblsearch &quot;LAYER&quot; &quot;C&quot;))
(vla-add (vla-get-layers(vla-get-ActiveDocument (vlax-get-acad-object))) &quot;C&quot;))
(if (not (tblsearch &quot;LAYER&quot; &quot;D&quot;))
(vla-add (vla-get-layers(vla-get-ActiveDocument (vlax-get-acad-object))) &quot;D&quot;))
(vlax-for for-item(vla-get-blocks(vla-get-activedocument (vlax-get-acad-object)))
(vlax-for item for-item
(if (wcmatch (vla-get-ObjectName item) &quot;*Hatch*&quot;)
(vla-put-layer item &quot;A&quot;)
)
(if (wcmatch (vla-get-ObjectName item) &quot;*Dim*&quot;)
(vla-put-layer item &quot;B&quot;)
)
(if (wcmatch (vla-get-ObjectName item) &quot;*Leader*&quot;)
(vla-put-layer item &quot;C&quot;)
)
(if (wcmatch (vla-get-ObjectName item) &quot;*Text*&quot;)
(vla-put-layer item &quot;D&quot;)
)
)
)
)
</pre>
<p>Lisp tr&ecirc;n chỉ tạo ra 4 layer theo y&ecirc;u cầu của bạn</p>
<<

Filename: 249138_test.lsp
Tác giả: hochoaivandot
Bài viết gốc: 249240
Tên lệnh: ttt
Nhờ lisp tính toán các phép tính giá trị text có phần chữ và phần số

(defun LM:EditBox ( string / id )
(and
(< 0 (setq id (load_dialog "ACAD")))
(new_dialog "acad_txtedit" id)
(set_tile "text_edit" string)
(action_tile "text_edit" "(setq string $value)")
(if (zerop (start_dialog)) (setq string nil))
)
(if (< 0 id) (unload_dialog id))
string
)
(defun LM:ParseNumbers ( s )
(
(lambda ( l )
(read
(strcat "("
(vl-list->string
(mapcar
(function
(lambda ( a b c...

>>

(defun LM:EditBox ( string / id )
(and
(< 0 (setq id (load_dialog "ACAD")))
(new_dialog "acad_txtedit" id)
(set_tile "text_edit" string)
(action_tile "text_edit" "(setq string $value)")
(if (zerop (start_dialog)) (setq string nil))
)
(if (< 0 id) (unload_dialog id))
string
)
(defun LM:ParseNumbers ( s )
(
(lambda ( l )
(read
(strcat "("
(vl-list->string
(mapcar
(function
(lambda ( a b c )
(if
(or
(< 47 b 58)
(and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
(and (= 46 b) (< 47 a 58) (< 47 c 58))
)
b 32
)
)
)
(cons nil l) l (append (cdr l) (list nil))
)
)
")"
)
)
)
(vl-string->list s)
)
)
(defun c:ttt (/ ss congthu e el dfx1 chudau chu dxf1Num newdxf1 i)
(setvar "cmdecho" 0)
(command "undo" "BE")
(if (not cal) (arxload "geomcal"))
(setq congthu (LM:EditBox "Nhap cong thuc voi x la phan so Vdu (x+10)*2"))
(setq ss (ssget (list (cons 0 "*TEXT") (cons 1 "P#*,p#*,td#*,TD#*,Td#*,tD#*,TC#*,tc#*,Tc#*,tC#*"))))
(repeat (setq i (sslength ss))
(setq
e (ssname ss (setq i (1- i)))
el (entget e)
dxf1 (cdr (assoc 1 el))
chudau (substr dxf1 1 1)
chu (if (or (= chudau "P") (= chudau "p")) chudau (substr dxf1 1 2))
dxf1Num (itoa (car (LM:ParseNumbers dxf1)))
newdxf1 (vl-string-subst dxf1Num "x" congthu)
newdxf1 (strcat chu (itoa (C:cal newdxf1)))
el (subst (cons 1 newdxf1) (assoc 1 el) el)
)
(entmod el)
)
(command "undo" "E")
(setvar "cmdecho" 1)
(princ "Viet boi DuongBaDiep - cadonline.duyxuyen.vn")
(princ)
)

 

 

- Tên lệnh : TTT

- Nhập công thức với x là phần số lấy từ text để tính toán

Ví dụ: Công thức là (x+10)*2 thì chọn P2 kết quả thành P24


<<

Filename: 249240_ttt.lsp
Tác giả: hathaiyb
Bài viết gốc: 249402
Tên lệnh: kvp
Lisp tự động sắp xếp bản vẽ từ model sang khung in bên layout

Mình thấy có cái này: 

(defun C:KVP( / os lst khung X_min Y_min X_max Y_max X index taphop tyle)

(command "layer" "m" "khung" "p" "n" "khung" "")
 (setvar "cmdecho" 0)

  (command "UNDO" "BE")
  (setq os(getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setq taphop(ssget ))
   (setq Tyle (getreal (strcat "\n Ty le 1/ <1000>: ")))
   (if (= Tyle nil) (setq Tyle 1000))
  (setq soluong (sslength taphop))
  (setq index 0)
  (command "LAYOUT" "N"...
>>

Mình thấy có cái này: 

(defun C:KVP( / os lst khung X_min Y_min X_max Y_max X index taphop tyle)

(command "layer" "m" "khung" "p" "n" "khung" "")
 (setvar "cmdecho" 0)

  (command "UNDO" "BE")
  (setq os(getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setq taphop(ssget ))
   (setq Tyle (getreal (strcat "\n Ty le 1/ <1000>: ")))
   (if (= Tyle nil) (setq Tyle 1000))
  (setq soluong (sslength taphop))
  (setq index 0)
  (command "LAYOUT" "N" "In")
  (command "LAYOUT" "S" "In")
  (command "ERASE" "ALL" "")
  (command "MODEL")
  (setq X 0)
  (command "ZOOM" "E")
  (while (< index soluong)
    (setq khung(ssname taphop index))
    (setq lst(acet-geom-vertex-list khung))
    (setq X_min 1000000000
      Y_min 1000000000
      X_max -1000000000
      Y_max -1000000000)
    (foreach a lst
      (if (< (car a) X_min) (setq X_min (car a)))
      (if (< (cadr a) Y_min) (setq Y_min (cadr a)))
      (if (> (car a) X_max) (setq X_max (car a)))
      (if (> (cadr a) Y_max) (setq Y_max (cadr a)))
      )
    (command "LAYOUT" "S" "In")
    (command "ZOOM" "W" (list X_min Y_min) (list X_max Y_max))
    (command "PLINE")
    (foreach a lst
      (command a))
    (command "C")
    (command "MOVE" (entlast) "" (list X_min Y_min) (list X 0))
    (command "ZOOM" "W" (list 0 0) (list (+ X 100) 0))
    (command "SCALE" (entlast) "" (list X 0) (/ 1000 tyle))
    (command "MVIEW" "O" (entlast))
    (command "MSPACE")
    (command "ZOOM" (list X_min Y_min) (list X_max Y_max))
    (command "PSPACE")
	(command "MVIEW" "L" "on" (entlast) "")
    (setq X(+ X 50 (/ (- X_max X_min) (/ tyle 1000))))
    (command "ZOOM" "W" (list 0 0) (list (+ X 100) 0))
    (setq index (+ index 1))
    )
  (command "MODEL")
  (command "UNDO" "END")
  (setvar "OSMODE" os)
  (princ)
  )


<<

Filename: 249402_kvp.lsp
Tác giả: hochoaivandot
Bài viết gốc: 249414
Tên lệnh: ttt
Nhờ lisp tính toán các phép tính giá trị text có phần chữ và phần số

Do yêu cầu ban đầu của bạn là sửa cho cọc TD, P va TC nên mói viết vậy

Tôi đã sửa lại để phần chữ bất kỳ đây (Mọi text kết thúc bằng số là OK).

Bạn lưu ý, khi yêu cầu lisp bạn nên gởi file bản vẽ lên để mọi người viết và test nhé

 

(defun LM:EditBox ( string / id )
(and
(< 0 (setq id (load_dialog "ACAD")))
(new_dialog "acad_txtedit" id)
(set_tile "text_edit"...

>>

Do yêu cầu ban đầu của bạn là sửa cho cọc TD, P va TC nên mói viết vậy

Tôi đã sửa lại để phần chữ bất kỳ đây (Mọi text kết thúc bằng số là OK).

Bạn lưu ý, khi yêu cầu lisp bạn nên gởi file bản vẽ lên để mọi người viết và test nhé

 

(defun LM:EditBox ( string / id )
(and
(< 0 (setq id (load_dialog "ACAD")))
(new_dialog "acad_txtedit" id)
(set_tile "text_edit" string)
(action_tile "text_edit" "(setq string $value)")
(if (zerop (start_dialog)) (setq string nil))
)
(if (< 0 id) (unload_dialog id))
string
)
(defun LM:ParseNumbers ( s )
(
(lambda ( l )
(read
(strcat "("
(vl-list->string
(mapcar
(function
(lambda ( a b c )
(if
(or
(< 47 b 58)
(and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
(and (= 46 b) (< 47 a 58) (< 47 c 58))
)
b 32
)
)
)
(cons nil l) l (append (cdr l) (list nil))
)
)
")"
)
)
)
(vl-string->list s)
)
)
(defun LM:ParseLetter (s)
(setq lst (vl-string->list s))
(vl-list->string (vl-remove-if '(lambda (x) (member x (list 48 49 50 51 52 53 54 55 56 57 58))) lst))
)
(defun c:ttt (/ ss congthu e el dfx1 newdxf1 i)
(setvar "cmdecho" 0)
(command "undo" "BE")
(if (not cal) (arxload "geomcal"))
(setq congthu (LM:EditBox "Nhap cong thuc voi x la phan so Vdu (x+10)*2"))
(setq ss (ssget (list (cons 0 "*TEXT") (cons 1 "*#"))))
(repeat (setq i (sslength ss))
(setq
e (ssname ss (setq i (1- i)))
el (entget e)
dxf1 (cdr (assoc 1 el))
newdxf1 (vl-string-subst (itoa (car (LM:ParseNumbers dxf1))) "x" congthu)
newdxf1 (strcat (LM:ParseLetter dxf1) (itoa (C:cal newdxf1)))
el (subst (cons 1 newdxf1) (assoc 1 el) el)
)
(entmod el)
)
(command "undo" "E")
(setvar "cmdecho" 1)
(princ "Viet boi DuongBaDiep - cadonline.duyxuyen.vn")
(princ)
)


<<

Filename: 249414_ttt.lsp
Tác giả: Namvanvo
Bài viết gốc: 249651
Tên lệnh: td
Viết lisp Tiết diện chử I420x260x6x10 chỉ cần gõ I,420,260,6,10 là ra như hình vẽ

Lisp vẽ thép I như bạn miêu tả ở trên:

(defun C:td(/ p1 h w bt wt p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12)
  (setq echo (getvar 'cmdecho)
os (getvar 'osmode)
la (getvar 'clayer))
  (setvar 'cmdecho 0)
  (setvar 'osmode 0)
  (command ".layer" "make" "beamlisp"
  "c" "4" ""
  "lw" "0.3" ""
  "l" "continuous" "" "")   
  (setq p1 (getpoint "\nSpecify the left bottom corner of beam:")
h (getdist "\nSpecify the height:")
w...

>>

Lisp vẽ thép I như bạn miêu tả ở trên:

(defun C:td(/ p1 h w bt wt p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12)
  (setq echo (getvar 'cmdecho)
os (getvar 'osmode)
la (getvar 'clayer))
  (setvar 'cmdecho 0)
  (setvar 'osmode 0)
  (command ".layer" "make" "beamlisp"
  "c" "4" ""
  "lw" "0.3" ""
  "l" "continuous" "" "")   
  (setq p1 (getpoint "\nSpecify the left bottom corner of beam:")
h (getdist "\nSpecify the height:")
w (getdist "\nSpecify the width:")
bt (getdist "\nSpecify beam thickness:")
wt (getdist "\nSpecify web thickness:"))
  (setq p2 (strcat "@" (rtos w) ",0")
p3 (strcat "@0," (rtos bt))
p4 (strcat "@" (rtos (-(- w (* w 0.5) (* wt 0.5)))) ",0")
p5 (strcat "@0," (rtos (- h (* 2 bt))))
p6 (strcat "@" (rtos (- w (* w 0.5) (* wt 0.5))) ",0")
p7 (strcat "@0," (rtos bt))
p8 (strcat "@" (rtos (- 0 w)) ",0")
p9 (strcat "@0," (rtos (- 0 bt)))
p10 (strcat "@" (rtos (- w (* w 0.5) (* wt 0.5))) ",0")
p11 (strcat "@0," (rtos (- (- h (* 2 bt)))))
p12 (strcat "@" (rtos (-(- w (* w 0.5) (* wt 0.5)))) ",0"))
  (command ".pline" p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p1 "")
  (command ".layer" "make" "hatchlisp"
  "c" "57" ""
  "lw" "0.13" ""
  "l" "continuous" "" "")
  (command ".hatch" "ansi31" "2" "90" "f" p1 p3  "" "")   
  (setvar 'cmdecho echo)
  (setvar 'osmode os)
  (setvar 'clayer la)
  (princ)
  )  


<<

Filename: 249651_td.lsp
Tác giả: Namvanvo
Bài viết gốc: 241899
Tên lệnh: bt2-1 bt2-2
Chữa bài tập chương 2

Thầy đi vắng thì trò chơi với nhau :D :D :D
Cụ thể chi tiết thì phải để thầy nhận xét, riêng mình có mấy ý sau:
1. Nên dùng (getreal) hoặc (getdist) thay cho (getint) khi nhập kích thước
2. Trong các biểu thức tính dtích, tbc ... nên nhập là (/ ...  2.0 hoặc 3.0); lý do chắc bạn đã...

>>

Thầy đi vắng thì trò chơi với nhau :D :D :D
Cụ thể chi tiết thì phải để thầy nhận xét, riêng mình có mấy ý sau:
1. Nên dùng (getreal) hoặc (getdist) thay cho (getint) khi nhập kích thước
2. Trong các biểu thức tính dtích, tbc ... nên nhập là (/ ...  2.0 hoặc 3.0); lý do chắc bạn đã biết
Thân !

 

Bạn hiểu sai khái niệm về hàm và thủ tục rồi.

 
Cám ơn hai bạn Hiepttr và cd2k44 đã hỗ trợ, mình đã hiểu ý của hai bạn và sửa lại bài như bên dưới, rất mong nhận được sự góp ý tiếp theo của các bạn.
 
Ketxu ơi, mình nộp lại bài tập chương 2 nhé :)
;1. Chuyen cac mo ta duoi day thanh 1 file lisp, luu duoi ten BT2-1.LSP

	;a. Lap thu tuc BT2-1
	;f. Loai bo bien x y z e ra khoi bo nho sau khi ket thuc thu tuc BT2-1, giu lai bien ketqua
	(defun C:BT2-1(/ x y z e)
	    ;b. gan bien x=2+7, y=3-1.25, z=5.0
	  	(setq x (+ 2 7) y (- 3 1.25) z 5.0)
	    ;c. gan bien z=x*y
	   	(setq z (* x y))
	    ;d. gan bien e=z+0.4(x-y)
	    (setq e (+ z (* 0.4 (- x y))))
	    ;c. gan bien ketqua=x+y+z+e
	    (setq ketqua (+ x y z e))
	 

 ;2. tao ham thu tuc BT2-2 thuc hien viec sau:
  (defun C:BT2-2()

	 ;a. loai bien ketqua o BT2-1
	    (setq ketqua Nil)

	 ;b. Bien a la canh day tam giac, bien b la chieu cao tam giac, gan c bang dien tich tam giac nay    
	    (setq a 2000 b 1000 c (* a b 0.5)) 
	    )
 ;3. ham trungbinhcong 2 so trong phan ly thuyet, nhan voi 0.5 va chia cho 2 theo em la giong nhau

 ;4. Tao ham tinh trung binh cong cua 3 so:
	(defun tbc3so (a b c)
	(/ (+ a b c) 3.0)
  	)

 ;5. Tao ham tinh dien tich tam giac voi canh day a va chieu cao b:
 	(defun dientichtamgiac (a b)
 	(* a b 0.5)
   	)

 ;6. Tao ham tinh tich 4 so:
	(defun tinhtich4so (a b c d)
	(* a b c d)
  	)

 ;7. Tao ham tinh lap phuong 1 so:
	(defun lapphuong1so (a)
	(expt a 3)
	)
 ;8. Load file BT2-1
	;a. Kiem tra ham trung binh cong 3 so voi tong 1.1+2.2+3.3
	(tbc3so 1.1 2.2 3.3)
	2.2
	;b. Kiem tra ham tinh dien tich voi ket qua bai 2
	(dientichtamgiac 2000 1000)
	1.0e+006
	;c. Kiem tra ham tich 4 so bat ky
	(tinhtich4so 4 5 6 7)
	840
	;d. Kiem tra ham lap phuong
	(lapphuong1so 5)
	125
)
 
;Tao file BT2-2.lsp

;a. Tao ham tinh ien tich hinh vanh khan, R1, R2 la ban kinh duong tron lon, duong tron nho
    (defun dthvk (R1 R2)
     (* pi (- (expt R1 2) (expt R2 2)))
    )

;b. Tao ham tinh dien tich biet 3 canh a b c, p la nua chu vi
(defun dthtg (a b c)
    ;nua chu vi tam giac
    (setq p (* (+ a b c) 0.5))
    ;dientichtamgiac
    (sqrt (* p (- p a)(- p b)(- p c)))
)

;c. Tinh dien tich mat cat thep tron, tham so d la duong kinh thep
(defun dtmctt(d)
    (* pi (expt (* d 0.5) 2))
 )

;d. Tao ham tinh khoi luong thanh thep tron KLR 7850kg/m3, dai l=11.7m, doi so la duong kinh thep
(defun klttt(d)
  (setq l 11.7)
  (setq khoiluongrieng 7850)
  (* pi (expt (* d 0.5) 2) l khoiluongrieng)
 )

;e. Tao ham tinh khoi luong thanh thep hinh hop vuong, chieu dai canh ngoai a, be day h, chieu dai va khoi luong nhu cau d
(defun kltthhvah (a h)
   (* (- (expt a 2) (expt (- a (* 2 h)) 2))  l khoiluongrieng)
)

;f. Tao ham tinh khoi luong thanh thep hinh hop vuong, chieu dai canh ngoai a, chieu dai canh trong b, chieu dai va khoi luong nhu cau d

(defun kltthhvab (a b)
  (* (- (expt a 2) (expt b 2)) l khoiluongrieng)
)

;g. Voi cac ham hay kiem nghiem voi mot vi du bat ky

    Command: (dthvk 4 2)
    37.6991

    Command: (dthtg 4 3 3)
    4.47214

    Command: (dtmctt 2)
    3.14159

    Command: (klttt 2)
    288540.0

    Command: (kltthhvah 3 1)
    734760.0

    Command: (kltthhvab 3 1)
    734760.0

<<

Filename: 241899_bt2-1_bt2-2.lsp
Tác giả: huunhantvxdts
Bài viết gốc: 249786
Tên lệnh: ed
[Đã xong] - Tự động bật - tắt chế độ gõ tiếng việt trong CAD

bạn có thể chuyển sang cho cad đời thấp dùng dc ko ?

vì ko phải ai cũng có nhu cầu cad đời cao , đại đa số các pm nhúng vào cad đều dùng cad 2007 .với một cơ số người thì cad 2007 đủ để phục vụ nhu cầu của họi và nhẹ load hơn nhiều.

thank!

Lisp này mình lấy về tự chế lại còn bị...

>>

bạn có thể chuyển sang cho cad đời thấp dùng dc ko ?

vì ko phải ai cũng có nhu cầu cad đời cao , đại đa số các pm nhúng vào cad đều dùng cad 2007 .với một cơ số người thì cad 2007 đủ để phục vụ nhu cầu của họi và nhẹ load hơn nhiều.

thank!

Lisp này mình lấy về tự chế lại còn bị lỗi 1 số chổ chưa sữa được (đó là phải nhập lệnh ed) nhưng dùng cũng tạm được. Mình dùng cad2008

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/66851-da-xong-tu-dong-bat-tat-che-do-go-tieng-viet-trong-cad/page-2
 
(vl-load-com)
;;; Dinh nghia lai lenh ED de lay ename doi tuong
(defun c:ed (/ textedit font ent n-textedit n-obj n-ent dk code l-obj obj lst)
(SETQ OLDERR *error*
*error* myerror)
(sendkeys "^+")
(and (or (and (setq textedit (ssget "I"))
           	(sssetfirst textedit)
           	(setq obj (ssname textedit 0)))
      	(setq textedit (entsel) obj (car textedit)))
(while obj
;(setq lst (Start-defun nil))
;(setq textedit (car (entsel)))
(setq ent (cdr (assoc 0 (entget obj))))
(cond ((wcmatch ent "*TEXT"); text
(progn
(setq font (cdr (assoc 7 (entget obj))))
;(setq font (vla-get-stylename (vlax-ename->vla-object textedit)))
(call font)
(command "ddedit" textedit "")
))
((= ent "DIMENSION") ;Dimension
(progn
          	(setq font (vla-get-textstyle (vlax-ename->vla-object obj)))
			;(setq font (vla-get-textstyle (vlax-ename->vla-object textedit)))
          	(call font)
			(command "ddedit" textedit "")
))
((= ent "HATCH") ;Hatch
(progn
          	(initdia)
			(call font)
			(command "hatchedit" textedit)
))
((= ent "INSERT") ;Block
          	(and (eq (type textedit) 'LIST)
               	(setq n-textedit (nentselp (cadr textedit)))
               	(setq n-obj (car n-textedit))
               	(setq n-ent (entget n-obj))
               	(setq n-obj (vlax-ename->vla-object n-obj))
               	(cond ((= (cdr (assoc 0 n-ent)) "ATTRIB") ; Attribute
                      	(setq code (check-font-code (cdr (assoc 7 n-ent))))
                      	(if (eq (vla-get-mtextattribute n-obj) :vlax-false)
                       	(progn
                        	;(setq dk nil dk (sendkeys "^+"))
                        	(cond ((= code "TCVN3") (sendkeys "^+{F2}"))
                              	((= code "UNICODE") (sendkeys "^+{F1}"))
                              	((= code "VNI") (sendkeys "^+{F3}")))))
						(vl-cmdf "eattedit" textedit)
                       	(if dk (sendkeys "^+")))
                     	((wcmatch (cdr (assoc 0 n-ent)) "TEXT,MTEXT") ; Text,Mtext in Block
                      	(if (or extract_clone (and (not extract_clone) (load "trexblk.lsp")))
                       	(progn
                        	(extract_clone n-textedit)
                        	(vla-put-visible n-obj :vlax-false)
                        	(entupd obj)
                        	(progn
							(setq l-obj (entlast) font (cdr (assoc 7 n-ent)))
							(call font)
							(vl-cmdf "DDedit" l-obj "")
							)
                        	(vla-put-textstring n-obj (cdr (assoc 1 (entget l-obj))))
                        	(vla-put-visible n-obj :vlax-true)
                        	(entdel l-obj)
                        	(entupd obj))
                       	(princ "Ban chua cai dat goi Express tool cho CAD\n"))))))
); cond	
;(Done-defun lst)		
(setq textedit (entsel) obj (car textedit))
);while
);and
(back)
(command "HIGHLIGHT" 1 "")
(SETQ *error* OLDERR)
(princ))
;;; Ham call dieu khien bo go tieng viet
(defun call (font / code Crfont)
(if font (setq Crfont font) (setq Crfont (getvar "textstyle")))
   (setq code (check-font-code Crfont))
   (cond ((= code "TCVN3") (sendkeys "^+{F2}"))
((= code "UNICODE") (sendkeys "^+{F1}"))
((= code "VNI") (sendkeys "^+{F3}"))
)
)
;;; Ham tra lai English
(defun back ()
(sendkeys "^+")
)
;;; Ham kiem tra bang ma cua textstyle (su dung true type font)
;;; style: String - ten cua textstlye kiem tra
(defun Check-Font-Code (style / ts font Bold Italic charSet PitchandFamily)
(setq ts (vlax-ename->vla-object (tblobjname "style" style)))
(vla-GetFont ts 'font 'Bold 'Italic 'charSet 'PitchandFamily)
(if (= font "") (setq font (vla-get-fontfile ts)))
(cond ((wcmatch (setq font (strcase font)) "ARIAL*,TAHOMA*,TIMES*,COURIER NEW,CAMBRIA,CONSOLAS") "UNICODE")
    ((wcmatch font ".VN*") "TCVN3")
    ((wcmatch font "VNI*") "VNI")))
;;; Ham senkeys
(defun SendKeys (keys / wscript)
(vlax-invoke-method (setq wscript (vlax-create-object "WScript.Shell")) 'sendkeys keys)
(vlax-release-object wscript))
;;;Ham bay loi
(defun myerror (s)
(if (= s "Function Cancelled") (sendkeys "^+"))
  (setq *error* OLDERR)
  (princ)
)
(defun Start-defun (lst-var)
(defun *error* (msg)
(redraw)
(vl-cmdf "undo" "end")
(vl-cmdf "undo" "")
(princ));end
(vl-cmdf "undo" "begin")
(mapcar '(lambda(x) (list x (getvar x))) lst-var));end
;;;
(defun Done-defun (lst-var / )
(mapcar '(lambda (x) (setvar (car x) (cadr x))) lst-var)
(vl-cmdf "undo" "end")
(princ));end


<<

Filename: 249786_ed.lsp
Tác giả: Tue_NV
Bài viết gốc: 97681
Tên lệnh: lb
Giao diện hộp thoại trong AutoLisp
Các bác cho Tue_NV hỏi chổ này với :

Tue_NV thử tạo 1 popup_list trong 1 dialog.
-> Kết quả là muốn hiện tên của Phần tử của 1 List ten trong AutoCAD mesage
Ví dụ mình chọn "so 2" trong dialog thì chỉ hiện ra "2" trong AutoCAD mesage (hàm alert)
Tue_NV muốn kết quả là "so 2" trong AutoCAD mesage (chính là phần tử "so 2" trong list ten)

Khi trở lại dialog thì không biết làm sao mà...
>>
Các bác cho Tue_NV hỏi chổ này với :

Tue_NV thử tạo 1 popup_list trong 1 dialog.
-> Kết quả là muốn hiện tên của Phần tử của 1 List ten trong AutoCAD mesage
Ví dụ mình chọn "so 2" trong dialog thì chỉ hiện ra "2" trong AutoCAD mesage (hàm alert)
Tue_NV muốn kết quả là "so 2" trong AutoCAD mesage (chính là phần tử "so 2" trong list ten)

Khi trở lại dialog thì không biết làm sao mà Dialog lại hiện "so 0" trong popup_list.
Tue_NV muốn nó trở lại chính phần tử mà mình đã chọn trước đó (tức chính là "so 2" đã chọn trước đó) nhưng không được.

Đây là file .dcl

Kiến thức về .dcl còn hạn chế nhiều quá. Mong nhận được sự giúp đỡ của các bác.
Tue_NV xin chân thành cảm ơn.
<<

Filename: 97681_lb.lsp
Tác giả: hoangkimoanh
Bài viết gốc: 250428
Tên lệnh: pdm thuhoi
Nhờ hoàn thiện lisp phun điểm mia địa chính ra Autocad

Em thấy cái lisp của anh toiyeuviet nam rất đơn giản về cách thực hiện, nhờ các các anh giúp sửa giúp em để khi mình chỉ cần ghi tọa độ 2 điểm GPS1 và GPS2 như file số liệu em gửi kèm theo và phun điểm mia bằng gõ lệnh PDM -> nhập mẫu số tỉ lệ: gõ 1000 -> tìm file solieu -> là phun điểm mia ra giống như hình vẽ kèm theo được không ạ! Chỉ cần liệt kê tọa độ trạm máy và điểm...

>>

Em thấy cái lisp của anh toiyeuviet nam rất đơn giản về cách thực hiện, nhờ các các anh giúp sửa giúp em để khi mình chỉ cần ghi tọa độ 2 điểm GPS1 và GPS2 như file số liệu em gửi kèm theo và phun điểm mia bằng gõ lệnh PDM -> nhập mẫu số tỉ lệ: gõ 1000 -> tìm file solieu -> là phun điểm mia ra giống như hình vẽ kèm theo được không ạ! Chỉ cần liệt kê tọa độ trạm máy và điểm định hướng (giống như dùng chương trình chitietwin của thầy Trần Trung Anh chỉ cần liệt kê tọa độ trạm máy và điểm định hướng là tự vẽ lưới các trạm trong khu đo).

mong các anh giúp em với nhé vì nếu thành công thì công đoạn sẽ đơn giản mà không phải phức tạp và nhiều file rác trong khâu xử lý số liệu nữa! cảm ơn các anh trước nhé!

------------------------------------------------------------------------------------------------------------------------------------------------------------------
;******chuong trinh phun diem mia cho file duoc che bien tu may TOPCON 223**********
 ;          	DUNG CHO BAN DO DIA CHINH 	*
 ;* TR  DCII-04  1014424.593 516275.846       	*
 ;* TR  DCII-07  1014339.861 516213.914       	*
 ;* TR  DCII-03  1014491.054  516180.297        	*
 ;* TR  DCII-06  1014670.141  516433.592         	*
 ;* TR  DCTI-04       	*
 ;* DH  DCII-03         	*
 ;* 1    	355.1447 	66.896        	*
 ;* 2    	355.1519 	47.576         	*
 ;* 3    	1.4545   	48.375        	*
 ;************************************************************************
(defun c:pdm (/    	tam ms  PR   FN	thunhat
   	tentram  caodotram  xtram   ytram	htram
   	tentrammay tendh
  	)
  (bdau)
  (setq tam ())
  (setq ms (getreal "Nhap vao mau so ty le : "))
  (setq
	FN (getfiled "Nh&#203;p file ngu&#229;n : "
   ""
   ""
   4
   	)
  )
  (progn
	(command "-osnap" "")
	(setvar "cmdecho" 0)
	(setvar "luprec" 8)
	(setvar "pdmode" 0)
	(command "-layer" "m" "diem" "c" "red" "" "")
;	(command "-layer" "m" "caodo" "c" "cyan" "" "")
	(command "-layer" "m" "sothutu" "c" "magenta" "" "")
	(command "-layer" "m" "khongche" "c" "red" "" "")
	(setq st (/ ms 1000))
	(setq st1 st)
	(command "-style" "mota" "txt.shx" st1 "1" "0" "n" "n" "n")
	(setq FN (open FN "r"))
	(while (and (setq PR (read-line FN)) (/= PR ""))
  	(progn
(setq PR (strcat "(" PR ")"))
(setq PR (read PR))
(setq thunhat (nth 0 PR))
(if
   (numberp thunhat)
	(gapsoA)
	(gaptramA)
)
  	) ;end progn
	) ;end while
  ) ;end progn
;;;;ket thuc viet lenh
  (close FN)
  (command "zoom" "e")
  (kthuc)
  (princ "\nVAY LA XONG!)*****")
  (princ)
)
(defun gaptramA (/ x y)
  (setq thunhat (convtostr thunhat))
  (if (= thunhat "TR")
	(progn
  	(setq ktra (nth 3 PR))
  	(if (/= ktra nil) ;GAP TRAM CHUA TOA DO GOC
(progn
   (setq tentram (convtostr (nth 1 PR)))
   (setq Y (nth 2 PR))
   (setq X ktra)
;   (setq h (nth 4 PR))
   (setq tam (append tam (list (list tentram x y ))))
)   ;GAP TRAM DO THUC TE
(progn
   (setq tentrammay (convtostr (nth 1 PR)))
;   (if (/= (nth 2 PR) nil)
; 	(setq caodotram (nth 2 PR))
; 	(setq caodotram 0)
;   )
   (laytdgoc tentrammay)
   (setq tdtram1 (list (+ xtram (* 2 st)) ytram ))
   (setq xxtram xtram)
   (setq yytram ytram)
   (setq tdtram (list xtram ytram))
   (command "-layer" "s" "khongche" "")
;(command "point" tdtram)
   (command "insert" "cdkc" tdtram st st "")
   (setq sss (strlen tentrammay))
   (setq tdtram2 (list (+ xtram (* 2 st) );(* (/ sss 2) st))
     	(- ytram (* 0.65 st))       
   )
   )
;   (command "insert"
; "l"
; 	tdtram1
; 	(* st sss)
; 	(* st sss)
; ""
;   )
   (command "-style"
 "mota"
 "txt.shx"
 	st
 "1"
 "0"
 "n"
 "n"
 "n"
   )
   (command "text" "j" "bl" tdtram1 "" tentrammay)
   (command "-style" "mota" "txt.shx" st1 "1" "0" "n" "n" "n")
;   (command "-layer" "s" "khongche" "")
;   (command "text" "j" "tl" tdtram2 "" (rtos htram 2 2))
)
  	)
	) ;end progn
	(if (= thunhat "DH")  ;else
  	(progn
(setq tendh (convtostr (nth 1 PR)))
(laytdgoc tendh)
(setq tddh (list xtram ytram ))
(setq tddh1 (list (+ xtram (* 2 st)) ytram ))
(command "-layer" "s" "khongche" "")
(command "insert" "cdkc" tddh st st "")
;(command "point" tddh)
(setq sss (strlen tendh))
(setq tddh2 (list (+ xtram (* 2 st)); (* (/ sss 2) st))
 	(- ytram (* 0.65 st))    
  	)
)
;(command "insert"
;  "l"
;  tddh1
;  (* st sss)
;  (* st sss)
;  ""
<img src='http://www.cadviet.com/forum/public/style_emoticons/<#EMO_DIR#>/wink.png' class='bbc_emoticon' alt=';)' />
(command "-style"
   "mota"
   "txt.shx"
   st
   "1"
   "0"
   "n"
   "n"
   "n"
)
(command "text" "j" "bl" tddh1 "" tendh)
(command "-style" "mota" "txt.shx" st1 "1" "0" "n" "n" "n")
; (command "-layer" "s" "khongche" "")
; (command "text" "j" "tl" tddh2 "" (rtos htram 2 1))
  	)
	)
  )
)
(defun gapsoA (/ gocbang kc goctd tdx tdy tdz td dentah)
  (setq gocbang (nth 1 PR))
  (setq kc (nth 2 PR))
;  (setq dentah (nth 3 PR))
  (setq gocbang (dpgtod gocbang))
  (setq gocbang (- 360 gocbang))
  (setq gocbang (+ (/ (* gocbang pi) 180) (angle tdtram tddh)))
  (setq tdX (+ xxtram (* kc (cos gocbang))))
  (setq tdY (+ yytram (* kc (sin gocbang))))
;  (if (/= dentah nil)
;	(setq tdz (+ caodotram (nth 2 tdtram) dentah))
;	(setq tdz 0)
;  )
  (setq td (list tdx tdy))
  (setq td1 (list (+ tdx (* 0.5 st)) (+ tdy (* 0.3 st)) ))
  (setq td2 (list (+ tdx (* 0.5 st)) (- tdy (* 0.3 st)) ))
  (command "-layer" "s" "diem" "")
  ;(command "insert" "cdc" td st st "")
  (command "point" td)
  (command "-style"
"mota"
"txt.shx"
	(* st 2)
"1"
"0"
"n"
"n"
"n"
  )
  (command "-style" "mota" "txt.shx" st1 "1" "0" "n" "n" "n")
  (command "-layer" "s" "sothutu" "")
  (command "text" td "" thunhat)
;  (command "-style" "mota" "txt.shx" st1 "1" "0" "n" "n" "n")
;  (command "-layer" "s" "caodo" "")
;  (command "text" "tl" td "" (rtos tdz 2 1))
)
------------------------------------------------------------------------------------
---------------------------------------------------------------------------------------
CHUONG TRINH CON:
---------------------------------------------------------------------------------------
(defun c:thuhoi (/ tenfile tenfile1 timfile dodaichuoi)
  (setq dodaichuoi (strlen (getvar "dwgname")))
  (setq tenfile1 (strcat (substr (getvar "dwgname") 1 (- dodaichuoi 3)) "xls"))
  (setq tenfile (strcat (getvar "dwgprefix") (getvar "dwgname")))
  (setq timfile (findfile (strcat (getvar "dwgprefix") tenfile1)))
  (if (/= timfile nil)
  	(vl-file-delete timfile)
  )
  ;(command "-eattext" "" "n" "n" "C:\\Program Files\\thuhoi.blk" "X" tenfile);Ghi file nhung bo bot vai cot
  (command "-eattext" "" "n" "n" "" "X" tenfile);Ghi file nhung khong bo bot cot
)
(defun laytdgoc (tentrammay / len i sosanh)
  (setq len (length tam))
  (setq i 0)
  (setq j 0)
  (while (< i len)
	(progn
  	(setq sosanh (car (nth i tam)))
  	(if (= tentrammay sosanh)
(progn
   (setq j (+ j 1))
   (setq xtram (cadr (nth i tam)))
   (setq ytram (caddr (nth i tam)))
   (if (/= (cadddr (nth i tam)) nil)
 	(setq htram (cadddr (nth i tam)))
 	(setq htram 0.0)
   )
)
(progn
   (if (= j 0)
 	(progn
   	(setq xtram 0)
   	(setq ytram 0)
   	(setq htram 0)
 	)
   )
)
  	)
  	(setq i (+ i 1))
	)
  )
)
(defun ConvtoStr (Sym)
  (setq ftemp "temp.tmp")
  (setq ftmp (open ftemp "w"))
  (princ Sym ftmp)
  (close ftmp)
  (setq ftmp (open ftemp "r"))
  (setq sym (read-line ftmp))
  (close ftmp)
  (princ sym)
)
(defun *error* (msg)
  (princ "\nerror:")
  (princ msg)
  (command "osmode" h "")
  (command "_.undo" "end")
  (command "clayer" clay)
  (command "u" "")
  (alert "  - - - - ha ha ha- - - -"
  )
  (setq *error* olderr)
  (princ)
)
(defun bdau ()
;(setq FNr "c:\\program files\\sr.txt")
;(setq FNr (open FNr "r"))
;(setq PRr (read-line FNr))
;(if (/= PRr "0909.446.887")
;(alert "VAY LA OK!"  )
   
<img src='http://www.cadviet.com/forum/public/style_emoticons/<#EMO_DIR#>/wink.png' class='bbc_emoticon' alt=';)' />
;(close FNr)
  (command "_.undo" "begin")
  (setq cmd (getvar "cmdecho"))
  (setq plwid (getvar "plinewid"))
  (setq elev (getvar "elevation"))
  (setq thick (getvar "thickness"))
  (setq hh (getvar "osmode"))
  (setq clay (getvar "clayer"))
)
(defun kthuc ()
  (command "plinewid" plwid)
  (command "elevation" elev)
  (command "thickness" thick)
  (command "osmode" hh)
  (command "_.undo" "end")
  (command "clayer" clay)
  (command "cmdecho" cmd)
)
(defun dpgtod (nhap / do phut giay)
  (setq do (fix nhap))
  (setq phut (fix (* (- nhap do) 100)))
  (setq giay (* (- (* (- nhap do) 100) phut) 100))
  (setq xuat (+ do (/ (* phut 1.0) 60) (/ giay 3600)))
)
(defun dtodpg (nhap / do phut giay)
  (setq do (fix nhap))
  (setq phut (fix (* (- nhap do) 60)))
  (setq giay (* (- (* (- nhap do) 60) phut) 60))
  (setq xuat (strcat (rtos do 2 0) "." (rtos phut 2 0) (rtos giay 2 0)))
)
(defun dd (nhap)
  (setq len (strlen nhap))
  (cond ((= len 1)  (setq xuat (strcat nhap "      	")))
((= len 2)  (setq xuat (strcat nhap "     	")))
((= len 3)  (setq xuat (strcat nhap "    	")))
((= len 4)  (setq xuat (strcat nhap "   	")))
((= len 5)  (setq xuat (strcat nhap "  	")))
((= len 6)  (setq xuat (strcat nhap " 	")))
((= len 7)  (setq xuat (strcat nhap "	")))
((= len 8)  (setq xuat (strcat nhap "   ")))
((= len 9)  (setq xuat (strcat nhap "  ")))
((= len 10) (setq xuat (strcat nhap " ")))
((= len 11) (setq xuat (strcat nhap "")))
; ((= len 12) (setq xuat (strcat nhap "     	")))
; ((= len 13) (setq xuat (strcat nhap "    	")))
; ((= len 14) (setq xuat (strcat nhap "   	")))
; ((= len 15) (setq xuat (strcat nhap "  	")))
; ((= len 16) (setq xuat (strcat nhap " 	")))
; ((= len 17) (setq xuat (strcat nhap "	")))
; ((= len 18) (setq xuat (strcat nhap "   ")))
; ((= len 19) (setq xuat (strcat nhap "  ")))
; ((= len 20) (setq xuat (strcat nhap " ")))
; ((= len 21) (setq xuat (strcat nhap "")))
  )
)
(defun dd1 (nhap)
  (setq len (strlen nhap))
  (cond ((= len 1)  (setq xuat (strcat nhap "                	")))
((= len 2)  (setq xuat (strcat nhap "               	")))
((= len 3)  (setq xuat (strcat nhap "              	")))
((= len 4)  (setq xuat (strcat nhap "             	")))
((= len 5)  (setq xuat (strcat nhap "            	")))
((= len 6)  (setq xuat (strcat nhap "           	")))
((= len 7)  (setq xuat (strcat nhap "          	")))
((= len 8)  (setq xuat (strcat nhap "         	")))
((= len 9)  (setq xuat (strcat nhap "        	")))
((= len 10) (setq xuat (strcat nhap "       	")))
((= len 11) (setq xuat (strcat nhap "      	")))
((= len 12) (setq xuat (strcat nhap "     	")))
((= len 13) (setq xuat (strcat nhap "    	")))
((= len 14) (setq xuat (strcat nhap "   	")))
((= len 15) (setq xuat (strcat nhap "  	")))
((= len 16) (setq xuat (strcat nhap " 	")))
((= len 17) (setq xuat (strcat nhap "	")))
((= len 18) (setq xuat (strcat nhap "   ")))
((= len 19) (setq xuat (strcat nhap "  ")))
((= len 20) (setq xuat (strcat nhap " ")))
((= len 21) (setq xuat (strcat nhap "")))
  )
)

file solieu và kết quả cần ra bản vẽ sau khi thực hiện xong


http://www.cadviet.com/upfiles/3/103752_file_solieu_goc_canh_va_san_pham_ban_ve_sau_phun_diem_mia.rar


<<

Filename: 250428_pdm_thuhoi.lsp
Tác giả: nhimret
Bài viết gốc: 250545
Tên lệnh: udt
lisp tính tổng diện tích của bác Nguyen Hoanh
(defun c:udt (/ ss tong ham tmp tt)
  (setq
    ss (ssget '((-4 . "<OR")(0 . "LWPOLYLINE")(0 . "REGION")(0 . "CIRCLE")(0 . "ARC")(-4 . "OR>")))	
    tong 0.0
    ham (lambda (x) (command ".area" "o" x) (setq tong (+ tong (getvar "area"))))
    tmp (mapcar 'ham (ss2ent ss))  
    hstl 0.001
    tp 2
    tt (entget (car (entsel "\nChon text ket qua: ")))
    tong (vl-string-right-trim "." (vl-string-right-trim "0" (rtos tong)))
  )
  (entmod (subst (cons 1...
>>
(defun c:udt (/ ss tong ham tmp tt)
  (setq
    ss (ssget '((-4 . "<OR")(0 . "LWPOLYLINE")(0 . "REGION")(0 . "CIRCLE")(0 . "ARC")(-4 . "OR>")))	
    tong 0.0
    ham (lambda (x) (command ".area" "o" x) (setq tong (+ tong (getvar "area"))))
    tmp (mapcar 'ham (ss2ent ss))  
    hstl 0.001
    tp 2
    tt (entget (car (entsel "\nChon text ket qua: ")))
    tong (vl-string-right-trim "." (vl-string-right-trim "0" (rtos tong)))
  )
  (entmod (subst (cons 1 (rtos (* (atof tong) hstl hstl) 2 tp)) (assoc 1 tt) tt))
)

(defun ss2ent(ss / sodt index lstent)
  (setq 
    sodt (if ss (sslength ss) 0)	 
    index 0
  )
  (repeat sodt
    (setq ent (ssname ss index)
	  index (1+ index)
	  lstent (cons ent lstent)
    )
  )
  (reverse lstent)
)
(princ "\nUpdate Area - free lisp from cadviet.com")
(princ "\nUse UDT command to start!")
(vl-load-com) 

 

Lisp này tui đã dùng được hơn 4 năm rồi, không có gì phàn nàn về hiệu quả của nó, nhưng bây giờ muốn nhờ các bác chỉnh sửa 1 tí để phù hợp hơn với nhu cầu hiện giờ ah

 

Hiện giờ: mỗi khi ra kết quả, lisp chỉ hiển thị số diện tích. VD: 10,1

 

Yêu cầu: Hiển thị kết quả, sẽ hiển thị S=10,1 m2

 

Cám ơn các bác trước :)


<<

Filename: 250545_udt.lsp
Tác giả: Namvanvo
Bài viết gốc: 250590
Tên lệnh: udt
[Nhờ chỉnh sửa]lisp tính tổng diện tích của bác Nguyen Hoanh


(defun c:udt (/ ss tong ham tmp tt)
(setq
ss (ssget '((-4 . "<OR")(0 . "LWPOLYLINE")(0 . "REGION")(0 . "CIRCLE")(0 . "ARC")(-4 . "OR>")))
tong 0.0
ham (lambda (x) (command ".area" "o" x) (setq tong (+ tong (getvar "area"))))
tmp (mapcar 'ham (ss2ent ss))
hstl 0.001
tp 2
tt (entget (car (entsel "\nChon text ket qua: ")))
tong (vl-string-right-trim "." (vl-string-right-trim "0" (rtos tong)))
)
(entmod (subst (cons 1 (strcat "S = " (rtos (*...

>>


(defun c:udt (/ ss tong ham tmp tt)
(setq
ss (ssget '((-4 . "<OR")(0 . "LWPOLYLINE")(0 . "REGION")(0 . "CIRCLE")(0 . "ARC")(-4 . "OR>")))
tong 0.0
ham (lambda (x) (command ".area" "o" x) (setq tong (+ tong (getvar "area"))))
tmp (mapcar 'ham (ss2ent ss))
hstl 0.001
tp 2
tt (entget (car (entsel "\nChon text ket qua: ")))
tong (vl-string-right-trim "." (vl-string-right-trim "0" (rtos tong)))
)
(entmod (subst (cons 1 (strcat "S = " (rtos (* (atof tong) hstl hstl) 2 tp) "M2")) (assoc 1 tt) tt))
)

(defun ss2ent(ss / sodt index lstent)
(setq
sodt (if ss (sslength ss) 0)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)
(princ "\nUpdate Area - free lisp from cadviet.com")
(princ "\nUse UDT command to start!")
(vl-load-com)

Sửa:

 

(entmod (subst (cons 1 (rtos (* (atof tong) hstl hstl) 2 tp)) (assoc 1 tt) tt))

Thành:

(entmod (subst (cons 1 (strcat "S = " (rtos (* (atof tong) hstl hstl) 2 tp) "M2")) (assoc 1 tt) tt))


<<

Filename: 250590_udt.lsp
Tác giả: Namvanvo
Bài viết gốc: 249691
Tên lệnh: orp rt2 gia tl
[LI]BT chương 4.3 - Xử lý list
libido max for her Anthony Bosch of Miami, accused of supplying performance-enhancing drugs through his Biogenesis anti-aging clinic, is in town to meet with MLB officials in preparation for testimony in Alex Rodriguez’s arbitration hearing on Sept. 30.
vigaplus uk In a proper...
>>
libido max for her Anthony Bosch of Miami, accused of supplying performance-enhancing drugs through his Biogenesis anti-aging clinic, is in town to meet with MLB officials in preparation for testimony in Alex Rodriguez’s arbitration hearing on Sept. 30.
vigaplus uk In a proper film-making nation, this would surely be hailed the most exciting generation of young female acting talent since the 1970s-born class of Kate Winslet, Rachel Weisz, Lena Headey and Thandie Newton. These are not your average bland starlets – they"re individual and versatile, with a knack for accents. The only thing holding them back is the scarcity of British films with female leads, so little wonder there"s a young female British invasion of Los Angeles already underway. Let"s just hope they don"t end up in boring girlfriend roles. They deserve better.
herbalife prelox blue antiossidante “Given a nearly equal mix of positives and negatives it is difficult to form a strong view on the likely outcome, but on balance we are somewhat more skeptical that FedEx is the name in focus for Pershing Square,” the analyst said in a research note. “Our sense is that the commentary from the letter (free cash generative, customer switching costs, high barriers) does not imply a narrow characterization and that FedEx could fit a loose definition of the description.”
libidus price President Obama has now committed to supporting the rebels in Syria. The White House"s reversal on that front is the right decision. Mostly it is right because it is an actual decision – something that has been lacking in American policy on Syria for the last year.
uso proextender Earlier this month, Amazon announced its MatchBook scheme, which will offer digital copies of 10,000 titles when they are bought in print. Some will be free, while others will cost up to $2.99 (£1.92).
femigra funziona Prime Minister David Cameron, bowing to pressure from the Eurosceptic right of his Conservative Party, has proposed a referendum on whether Britain should leave the European Union. Both the Liberal Democrat junior coalition partner and Labour opposition party have spoken out against the referendum, which would not be held before the next general election is due in 2015.
xytomax does it work The new Game Controller framework, added in iOS 7 and OS X v10.9, makes it easy to find controllers connected to a Mac or iOS device. Once discovered, your game reads control inputs as part of its normal gameplay. There are three kinds of controllers available:
libimax vs libigrow Michael Spurr, chief executive of the National Offender Management Service, said it was pleasing to see good work was taking place in resettlement and offender management and that the needs of prisoners were largely being met. He added: "Decisive action has already been taken to build on this work and address concerns raised in the report, particularly in the areas of training and purposeful activity. The prison and its staff will receive the support necessary to help raise performance and deliver a safe and constructive environment for the prisoners it holds."
buy prosolution online The challenge Apple faces stems in part from its iPhone strategy. Aside from the iPhone, Apple has historically created new product models at a variety of prices to appeal to different market segments.

<<

Filename: 249691_orp_rt2_gia_tl.lsp
Tác giả: nhoclangbat
Bài viết gốc: 214988
Tên lệnh: bt2-1 bt2-2
Chữa bài tập chương 2
bài 2-1 anh ketxu cho em hỏi nếu như mình đóng dấu sai vị trí thì có ảnh hưởng như thế nào không anh, để em pit sau này tránh mắc phải
em làm lại rùi anh xem thử ^^

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=66923&pid=214813&st=0&#entry214813
; baitap2-1
(defun c:bt2-1 (/ x y z e)
(setq x (+ 2 7))
(setq y (- 3 1.25))
>>
bài 2-1 anh ketxu cho em hỏi nếu như mình đóng dấu sai vị trí thì có ảnh hưởng như thế nào không anh, để em pit sau này tránh mắc phải
em làm lại rùi anh xem thử ^^

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=66923&pid=214813&st=0&#entry214813
; baitap2-1
(defun c:bt2-1 (/ x y z e)
(setq x (+ 2 7))
(setq y (- 3 1.25))
(setq z 5.0)
(setq e (+ (* (- x y) 0.4) z))
(setq kequa (+ x y z e))
)
;baitap 2-2
;tinh dien tich tam giac
(defun c:bt2-2 (/ a b c)
(setq a 1000)
(setq b 2000)
(setq c (* (* a B) 0.5)
))
(defun tbcongbaso ( a b c)
(/ (+ a b c) 3.0)
)
(defun zientich ( a B)
(* (* a B) 0.5)
)
;tich cua 4 so
(defun tich ( a b c d)
(* a b c d)
)
;tinh lap phuong 1 so
(defun lapphuong ( a)
(* a a a)
)

<<

Filename: 214988_bt2-1_bt2-2.lsp
Tác giả: nhoclangbat
Bài viết gốc: 215297
Tên lệnh: bt2-1 bt2-2
Chữa bài tập chương 2
đúng là mún chắc thì phải vững cơ bản thật, nằm ở chương 2 này lâu ghê, anh cho em nộp lại 2 bài hen , em đã sữa chỉ ko pit có đúng không hihi
baitap2-1

; baitap2-1
(defun c:bt2-1 (/ x y z e)
(setq x (+ 2 7))
(setq y (- 3 1.25))
(setq z (* x y))
(setq e (+ (* (- x y) 0.4) z))
(setq ketqua (+ x y z e))
)

;baitap 2-2
;tinh dien tich tam giac
(defun c:bt2-2 (/ ketqua)
>>
đúng là mún chắc thì phải vững cơ bản thật, nằm ở chương 2 này lâu ghê, anh cho em nộp lại 2 bài hen , em đã sữa chỉ ko pit có đúng không hihi
baitap2-1

; baitap2-1
(defun c:bt2-1 (/ x y z e)
(setq x (+ 2 7))
(setq y (- 3 1.25))
(setq z (* x y))
(setq e (+ (* (- x y) 0.4) z))
(setq ketqua (+ x y z e))
)

;baitap 2-2
;tinh dien tich tam giac
(defun c:bt2-2 (/ ketqua)
(setq a 1000)
(setq b 2000)
(setq c (* a b 0.5))
)
(defun tbcongbaso ( a b c)
(/ (+ a b c) 3.0)
)
(defun zientich ( a B)
(* a b 0.5)
)
;tich cua 4 so
(defun tich ( a b c d)
(* a b c d)
)
;tinh lap phuong 1 so
(defun lapphuong ( a)
(expt a 3)
)


baitap 2-2

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=66923&st=0
;baitap2-2
;tinh dien tich hinh vanh khan
;ban kinh lon : x
;ban kinh nho : y
(defun vkhan ( x y)
(* (- (* x x) (* y y)) 3.14)
)
;tinh dien tich tam giac pit 3 canh
(defun bacanh ( x y z)
(setq p (* (+ x y z) 0.5))
(sqrt (* (- p x) (- p y) (- p z) p))
)
;tinh dien tich mat cat thep tron
;biet duong kinh thep tron
(defun theptron ( x)
(* (/ (* x x) 4) 3.14)
)
;tinh khoi luong thep tron
(defun kltron ( x)
(* (/ (* x x) 4) 3.14 11.7 7850)
)
;tinh khoi luong thep hop vuong
;canh ngoai: x
;day : y
(defun klvuong ( x y)
(* (- (* 4 y x) (* 4 y y)) 11.7 7850)
)
;tinh khoi luong thep hop vuong
;canh ngoai: x
;canh ngoai : y
(defun klvuong2 ( x y)
(* (- (* x x 11.7) (* y y 11.7)) 7850)
)



<<

Filename: 215297_bt2-1_bt2-2.lsp
Tác giả: hieux5
Bài viết gốc: 215343
Tên lệnh: tbc3 dttgiac tich4 lp
Chữa bài tập chương 2
Em đã sửa lại thành các thủ tục cho BT2-1
Nếu còn sai thì e sẽ edit ngay tại bài này để page đỡ dài thêm :))
-------------------------------------------------------------------------------


Filename: 215343_tbc3_dttgiac_tich4_lp.lsp
Tác giả: quocnam1508
Bài viết gốc: 222325
Tên lệnh: sbc
Chữa bài tập chương 2
BT 2-1



;;;BAI 1

(defun c:bt2-1 (/ x y z e)
(setq x (+ 7 2))
(setq y (- 3 1.25))
(setq z 5.0)
(setq z (* x y))
(setq e (+ z (* 0.4 (- x y))))
(setq ketqua (+ x y z e))
)
;;;BAI 2
(defun c:bt2-2(/ a B c)
(setq a 1000)
(setq b 2000)
(setq c (* a B 0.5))
)
(defun tbc (a B c) ;;;ham trung binh cong
(/ (+ a b c) 3.0)
)
(defun stg (a B ) ;;;;ham...
>>
BT 2-1



;;;BAI 1

(defun c:bt2-1 (/ x y z e)
(setq x (+ 7 2))
(setq y (- 3 1.25))
(setq z 5.0)
(setq z (* x y))
(setq e (+ z (* 0.4 (- x y))))
(setq ketqua (+ x y z e))
)
;;;BAI 2
(defun c:bt2-2(/ a B c)
(setq a 1000)
(setq b 2000)
(setq c (* a B 0.5))
)
(defun tbc (a B c) ;;;ham trung binh cong
(/ (+ a b c) 3.0)
)
(defun stg (a B ) ;;;;ham tinh dien tich tam giac
(* (+ a B ) 0.5)
)
(defun tich4s (a B c d) ;;;;;ham tich 4 so
(* a B c d)
)
(defun lp (a) ;;;ham lap phuong bon so
(* a a a )
)


Nhận xét Bài 1 : chưa đạt
- Không khử biến ketqua ở thủ tục thứ 2
- Sai hàm tính diện tích tam giác - mục 5
- Thiếu mục 3

Bài 2 :


(defun svk (r1 r2)
( * pi ( abs(- r1 r2))))
;;;dien tich tam giac khi biet 3 canh
;cau lenh
(defun c:sbc(/ a b c)
(setq a (getint "\ncanh thu nhat:"))
(setq b (getint "\ncanh thu hai:"))
(setq c (getint "\ncanh thu ba:"))
(dttg3c a b c)
)
;;;ham
(defun dttg3c(x y z)
(setq p (*(+ x y z) 0.5))
(sqrt(* p(* (- p x) (- p y) (- p z))))
)
;;HAM TINH DIEN TICH MAT CAT THEP TRON
(defun sth(d pi)
(* pi (* (* d 0.5) (* d 0.5)))
)
(defun klt(d pi )
(setq s (* pi (* (* d 0.5) (* d 0.5))))
(* s 11.7 7850)
)
;; HAM TINH KHOI LUONG THEP VUONG;;CAU E
;a : canh
;k : be day thep
(defun klth1(a k)
(* (- (* a a) (* (- a (* 2 k)) (- a (* 2 k)))) 11.7 7850)
)
;;HAM TINH KHOI LUONG THEP;;CAU F
;a :cach
;b :canh trong
(defun klth2(a B)
(* ( - (* a a) (* b B)) 11.7 7850)
)



Nhận xét bài 2 : chưa đạt
- Thừa câu lệnh
- Thừa tham số trong các hàm liên quan đến pi (pi là hằng số, không nên đưa ra làm tham số)
- Câu f không tận dụng được câu e
- Sai diện tích vành khăn mất rồi ^^
<<

Filename: 222325_sbc.lsp
Tác giả: hiepttr
Bài viết gốc: 232304
Tên lệnh: bt2-1 bt2-2
Chữa bài tập chương 2

Cho mình nộp bài !

;Bai 1:
;cau a & f:
(defun c:BT2-1( / x y z e)
;cau b:
(setq
      x (+ 2 7)
      y (- 3 1.25)
      z 5.0
)
;cau c:
(setq z (* x y))
;cau d:
(setq e (+ z (* 0.4 (- x y))))
;cau e:
(setq ketqua (+ x y z e))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Bai 2:
(defun c:BT2-2( / a b)
;cau a:
(setq ketqua nil)
;cau b:
(setq a 2000 b 1000)
(setq c (* a b 0.5))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Bai 4:
(defun TBC3S (x y z)
       (/ (+ x...
>>

Cho mình nộp bài !

;Bai 1:
;cau a & f:
(defun c:BT2-1( / x y z e)
;cau b:
(setq
      x (+ 2 7)
      y (- 3 1.25)
      z 5.0
)
;cau c:
(setq z (* x y))
;cau d:
(setq e (+ z (* 0.4 (- x y))))
;cau e:
(setq ketqua (+ x y z e))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Bai 2:
(defun c:BT2-2( / a b)
;cau a:
(setq ketqua nil)
;cau b:
(setq a 2000 b 1000)
(setq c (* a b 0.5))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Bai 4:
(defun TBC3S (x y z)
       (/ (+ x y z) 3.0)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Bai 5:
(defun STG (a b)
       (* a b 0.5)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Bai 6:
(defun tich4so (a b c d)
       (* a b c d)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Bai 7:
(defun LP (a)
      (* a a a)
)


;Cau a: tinh dien tich hinh vanh khan
;Ban kinh vong tron nho: a
;Ban kinh vong tron lon: b
(defun SVK (a b)
       (* (- (* b b) (* a a)) pi)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Cau b: tinh S tam giac biet 3 canh
(defun DTTG (a b c / p)
       (setq p (* (+ a b c) 0.5))
       (sqrt (* p (- p a) (- p b) (- p c)))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;cau c: tinh S mc tron
(defun DTT (d)
       (* pi d d 0.25)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;cau d: tinh KL thep tron dac dai 11.7m
(defun MTR (d)
       (* (DTT d) 11.7 7850)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;cau e: tinh Kl thep hop theo canh va be day
(defun MHV (a d)
       (* 11.7 7850 (- (* a a) (* (- a (* 2 d)) (- a (* 2 d)))))
)
;cau f: tinh khoi luong thep hop theo canh ngoai & canh trong, reuse cau e
(defun MH (a b)
     (setq d (* 0.5 (- a b)))
     (MHV a d)
)

p/s: đi sau đc tham khảo mấy bài trước thật tiện lợi. Thanks all !


<<

Filename: 232304_bt2-1_bt2-2.lsp
Tác giả: nhoclangbat
Bài viết gốc: 222072
Tên lệnh: dtii
[LI]Chương 3 - Các hàm nhập liệu
em mới viết thêm 1lsp tính diện tích đơn giản, trong đó có hàm getvar và strcat là em lụm từ lsp khác, chưa học tới nhưng em mò cách nó hoạt động thử xem thế nào, trong đó có em dùng command là chính như có chỗ em chưa hỉu lắm, khi em tạo boundary xong tới lượt area, khi em thử trong cad chỉ làm bằng lệnh cad đơn thuần thì như lsp hay dùng là khi bo xong thì area rùi xóa cái bo vừa tạo, từ đó em thao...
>>
em mới viết thêm 1lsp tính diện tích đơn giản, trong đó có hàm getvar và strcat là em lụm từ lsp khác, chưa học tới nhưng em mò cách nó hoạt động thử xem thế nào, trong đó có em dùng command là chính như có chỗ em chưa hỉu lắm, khi em tạo boundary xong tới lượt area, khi em thử trong cad chỉ làm bằng lệnh cad đơn thuần thì như lsp hay dùng là khi bo xong thì area rùi xóa cái bo vừa tạo, từ đó em thao tác tương tự như trên thấy ok, nhưng khi vào lsp em cũng viết tương tự như vậy mà nó hơi lạ em viết như thế này:
(command "-boundary" p1 "")
(command "area" "")
(command "erase" "last" "")
=> thì khi chạy pick đc tính diện tích xong ghi ra text ok, xóa bo vừa tạo ok, nhưng khi thử vẽ hình khác, dùng lại thì khi ghi kết quả nó lại cho ra kết quả đúng như hình lần đầu, vẽ thêm mấy hình nhữa cũng vậy????.
Em thử coi lại lsp cũ, thì chỗ dòng tính diện tích thì viết như vậy (command "area" "e" "last" ""), em sữa của em giống vậy thì đúng là nó không bị nữa tính hình nào đúng hình đó, em thử làm giống vậy trong lệnh cad bấm area xong e xong last thì nó tính đúng ra hình em vừa vẽ,em hỉu là nó tính diện tích hình vửa tạo trước đó (last) còn tham số e là gì em ko pit, và tại sao khi em viết như trên thì nó lại chỉ nhớ diện tích hình em vẽ lúc đầu các hình sau thì ko đc, anh Ket giúp em ^^

;tinh dien tich don gian
(command ".layer" "m" "b-ghichu" "c" "7" "" "")
(defun c:dtii (/ p1 p2 b c d)
(setq p1 (getpoint "\nPick tam mien kinh:"))
(command "-boundary" p1 "")
(command ".area" "e" "last" "")
(command ".erase" "last" "")
(setq b (getvar "area"))
(setq c (getreal "\nNhap chieu cao:"))
(setq p2 (getpoint "\ndiem dat:"))
(command ".layer" "s" "B-Ghichu" "")
(command "style" "VAVON" "vni-avo" 0 1 0 "" "")
(setq d (strcat (rtos b 2 1)))
(command ".text" p2 c 0 d)
)

<<

Filename: 222072_dtii.lsp

Trang 141/330

141