Jump to content
InfoFile
Tác giả: TaiNguyen79
Bài viết gốc: 243635
Tên lệnh: vantuan18
Xuất cao độ từ CAD sang Notpad hoặc Excel

Mình cũng chưa hiểu về lisp này, đã làm thử rồi nhưng không thấy hiệu quả,không có kết quả
Bạn chọn 2 điểm thì không được rồi, mình muốn quét chọn tất cả đối tượng muốn xuất ra cơ.

Chọn 2 diểm băng qua hàng text muốn lấy. nếu muốn theo phương trục X hoặc Y thì bật F8. Số liệu xuất...
>>

Mình cũng chưa hiểu về lisp này, đã làm thử rồi nhưng không thấy hiệu quả,không có kết quả
Bạn chọn 2 điểm thì không được rồi, mình muốn quét chọn tất cả đối tượng muốn xuất ra cơ.

Chọn 2 diểm băng qua hàng text muốn lấy. nếu muốn theo phương trục X hoặc Y thì bật F8. Số liệu xuất ra sẽ sắp xếp theo chiều bạn pick 2 điểm đó.
Muốn chọn tất cả lại càng dễ nhưng khi xuất ra số liệu sẽ không có trật tự gì, thì cũng như một mớ bỏ đi thôi.
Mình đã làm thử trên file của bạn rồi , kết quả như sau :
3.25 2.36 2.33 3.23 2.4 2.44 3.76
8.5 8.5 8.5 8.5 4.98 7.21 4.92 7.88 0.61
Còn đây là lsp mình làm sát theo yc của bạn :

(defun c:vantuan18 (/ ss f fl goc p1 p2 i ) ;chon text theo goc roi ghi ra file
(if (findfile (setq f (getstring "\n<Ten FILE> xuat so lieu , Go <ENTER> neu khong luu : ")))
(setq fl (open f "a")) (setq fl (open f "w")))
(while (setq goc (getangle "\nNhap goc cua text muon chon :"))(setq i 0)
(if (setq ss (ssget (list (cons 0 "TEXT") (cons 50 goc))))
(repeat (sslength ss) (prin1 (read (cdr (assoc 1 (entget (ssname ss i))))) fl) (princ " " fl) (setq i (1+ i)))
(prompt "\nKhong chon dc text nao !"));if
(write-line "" fl));while
(close fl)(princ))


<<

Filename: 243635_vantuan18.lsp
Tác giả: vantuan18nd
Bài viết gốc: 242826
Tên lệnh: 4
Lisp tính cao độ

------------------------do khoang cach giua 2 diem va ghi ra text ------ghi ra text------cach 2---------

------------------------do khoang cach giua 2 diem va ghi ra text ------ghi ra text------cach 2---------
;; free lisp from cadviet.com
;;; this lisp was downloaded from

>>
------------------------do khoang cach giua 2 diem va ghi ra text ------ghi ra text------cach 2---------

------------------------do khoang cach giua 2 diem va ghi ra text ------ghi ra text------cach 2---------
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=61450&pid=187391&st=0&#entry187391


(defun C:4( / ss L te p1 p2 textmau P)
(while (and (setq p1 (getpoint "\n Chon diem thu nhat :"))
(setq p2 (getpoint p1 "\n Chon diem thu hai :"))
)
(setq L (distance p1 p2))
(initget "T")
(setq p (getpoint "\nPick diem chen hoac go T de chon Text :"))

(if (/= p "T")
(progn
(if (not textmau) (setq textmau (car(entsel "\nChon Text mau:"))))
(entmake (list (cons 0 "TEXT") (cons 1 (rtos L 2 2)) (assoc 40 (entget textmau))
(cons 10 p) (cons 11 p) (assoc 7 (entget textmau))
))
)
(progn
(setq te (entget(car(entsel"\n Chon Text de gan ket qua :")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te)
)
)
)
)

 

Đây là lisp đo khoảng cách. Các bác sửa giúp em như trên với :

Ở bước : Pick diem chen hoac go T de chon Text , giúp em bỏ đi lựa chọn Pick điểm chèn, em muốn Chọn Text để gán kết quả luôn

Thank !

;; free lisp from cadviet.com
 
 
(defun C:4( / ss L te p1 p2 textmau P)
(while (and (setq p1 (getpoint "\n Chon diem thu nhat :")) 
(setq p2 (getpoint p1 "\n Chon diem thu hai :"))
)
(setq L (distance p1 p2))
(initget "T")
(setq p (getpoint "\nPick diem chen hoac go T de chon Text :"))
 
(if (/= p "T")
  (progn 
    (if (not textmau) (setq textmau (car(entsel "\nChon Text mau:"))))
    (entmake (list (cons 0 "TEXT") (cons 1 (rtos L 2 2)) (assoc 40 (entget textmau)) 
  (cons 10 p) (cons 11 p) (assoc 7 (entget textmau)) 
    ))
  )
  (progn
  (setq te (entget(car(entsel"\n Chon Text de gan ket qua :")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te)
  )
)
)
)

<<

Filename: 242826_4.lsp
Tác giả: vantuan18nd
Bài viết gốc: 243770
Tên lệnh: as
Lisp cộng thêm hằng số K

Nhờ các member chỉnh sửa cho mình Lisp cộng thêm vào một dãy số đã có một hằng số K, mà khi chạy lệnh, lisp tự động nhớ con số mình vừa nhập, không phải nhập lại sau mỗi lần chạy lệnh.

;; free lisp from cadviet.com
;;; this lisp was downloaded from

>>

Nhờ các member chỉnh sửa cho mình Lisp cộng thêm vào một dãy số đã có một hằng số K, mà khi chạy lệnh, lisp tự động nhớ con số mình vừa nhập, không phải nhập lại sau mỗi lần chạy lệnh.

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/10226-lisp-cong-text-toan-bo-ban-ve-them-1-hang-so/
(defun c:as()

(setq i 0 s1 0)
(setq n (getreal "\nnhap so bi tru hoac so de cong: "))
(prompt "\nchon cac so can sua ...")
(setq txt (ssget '((0 . "TEXT"))))
(repeat (sslength txt)
(setq txt_name (ssname txt i))
(setq txt_ent (entget txt_name))
(setq cont (cdr(assoc 1 txt_ent)))
(setq cont (atof cont))
(setq s (+ cont n))
(setq txt_ent (subst (cons 1 (rtos s)) (assoc 1 txt_ent) txt_ent))
(entmod txt_ent)
(setq i (+ i 1))
);repeat
);defun
;------------------------------------------------------

 

Thanks !


<<

Filename: 243770_as.lsp
Tác giả: cd2k44
Bài viết gốc: 243775
Tên lệnh: as
[Nhờ chỉnh sửa] Lisp cộng thêm hằng số K

(defun c:as()


(setq i 0 s1 0)

(if (= n nill) (setq n (getreal "\nnhap so bi tru hoac so de cong: ")))
(prompt "\nchon cac so can sua ...")

(setq txt (ssget '((0 . "TEXT"))))

(repeat (sslength txt)

(setq txt_name (ssname txt i))

(setq txt_ent (entget txt_name))

(setq cont (cdr(assoc 1 txt_ent)))

(setq cont (atof cont))

(setq s (+ cont n))

(setq txt_ent (subst (cons 1 (rtos s)) (assoc 1 txt_ent)...

>>

(defun c:as()


(setq i 0 s1 0)

(if (= n nill) (setq n (getreal "\nnhap so bi tru hoac so de cong: ")))
(prompt "\nchon cac so can sua ...")

(setq txt (ssget '((0 . "TEXT"))))

(repeat (sslength txt)

(setq txt_name (ssname txt i))

(setq txt_ent (entget txt_name))

(setq cont (cdr(assoc 1 txt_ent)))

(setq cont (atof cont))

(setq s (+ cont n))

(setq txt_ent (subst (cons 1 (rtos s)) (assoc 1 txt_ent) txt_ent))

(entmod txt_ent)

(setq i (+ i 1))

);repeat

);defun

Hàm này làm có thể đúng ý bạn, nhưng chưa khắc phục được việc bạn muốn nhập lại hằng số mới thay vì số đã nhập, vì không biết bạn có muốn yêu cầu này hay không


<<

Filename: 243775_as.lsp
Tác giả: cd2k44
Bài viết gốc: 243798
Tên lệnh: nhso as
Lisp cộng thêm hằng số K

;;;;Nhap hang so
(defun c:nhso ()
(setq n (getreal "\nnhap so bi tru hoac so de cong: "))
)
;;;;
(defun c:as()

(setq i 0 s1 0)

(if (= n nill) (setq n (getreal "\nnhap so bi tru hoac so de cong: ")))
(prompt "\nchon cac so can sua ...")

(setq txt (ssget '((0 . "TEXT"))))

(repeat (sslength txt)

(setq txt_name (ssname txt i))

(setq txt_ent (entget txt_name))

(setq cont (cdr(assoc 1 txt_ent)))

(setq cont...

>>

;;;;Nhap hang so
(defun c:nhso ()
(setq n (getreal "\nnhap so bi tru hoac so de cong: "))
)
;;;;
(defun c:as()

(setq i 0 s1 0)

(if (= n nill) (setq n (getreal "\nnhap so bi tru hoac so de cong: ")))
(prompt "\nchon cac so can sua ...")

(setq txt (ssget '((0 . "TEXT"))))

(repeat (sslength txt)

(setq txt_name (ssname txt i))

(setq txt_ent (entget txt_name))

(setq cont (cdr(assoc 1 txt_ent)))

(setq cont (atof cont))

(setq s (+ cont n))

(setq txt_ent (subst (cons 1 (rtos s)) (assoc 1 txt_ent) txt_ent))

(entmod txt_ent)

(setq i (+ i 1))

);repeat

);defun

Khi bạn muốn nhập lại hằng số mới, bạn gõ lệnh "nhso" sau đó sử dụng lệnh của bạn như bình thường.


<<

Filename: 243798_nhso_as.lsp
Tác giả: quansla
Bài viết gốc: 242964
Tên lệnh: thu
Lisp copy text, giá trị text thay đổi theo chênh cao các vị trí bắt điểm

Gửi bạn

lisp lấy chữ số thập phân giống như TextA chọn, Ví dụ TextA chọn là 20.00 thì các số tiếp theo sẽ là 20.01 26.33 27.00 .....
Còn nếu TextA là 20 thì tiếp theo sẽ là 21 23 49 50 ....100,,,,,

ặc mình cũng nhanh nhảu quá, bạn yêu là chọn vị trí đặt điểm chèn TextB cơ mà nhỉ, lisp của mình thì...
>>

Gửi bạn

lisp lấy chữ số thập phân giống như TextA chọn, Ví dụ TextA chọn là 20.00 thì các số tiếp theo sẽ là 20.01 26.33 27.00 .....
Còn nếu TextA là 20 thì tiếp theo sẽ là 21 23 49 50 ....100,,,,,

ặc mình cũng nhanh nhảu quá, bạn yêu là chọn vị trí đặt điểm chèn TextB cơ mà nhỉ, lisp của mình thì lại tự lấy luôn vị trí rồi
Sửa không khó nhưng bạn muốn vị trí này tự động căn ngang hàng với TextA không/
Nếu không thì sẽ thế này

(defun c:thu ()
(prompt "\nChon TextA")(princ)
(if (and (setq textA (ssname (ssget '((0 . "*TEXT"))) 0 ))
(setq pA (getpoint "\nChon diem A\t")))
(progn
(setq entA (entget TextA)
Textstr (cdr(assoc 1 entA))
pos (cond ( (vl-string-search "." Textstr))( 1)))
(setq dauTP ( - (strlen Textstr) pos 1))
;(setq dauTP 3);;;;-----Co the sua lai dau thap phan o day
(while (setq pB (Getpoint "\nChon diem B"))
(setq dchen (getpoint "\nChon diem chen TextB"))
(setq textB (+ (atof(cdr(assoc 1 entA))) (- (car pB) (car pA))))
(entmake (list
(cons 0 "TEXT")
(cons 10 dchen)
(cons 11 dchen)
(assoc 40 entA)
(cons 1 (rtos TextB 2 dauTP))
))
)
)
)
(princ)
)

<<

Filename: 242964_thu.lsp
Tác giả: lyky
Bài viết gốc: 243861
Tên lệnh: as
[Nhờ chỉnh sửa] Lisp cộng thêm hằng số K

Thay vì phải nhập số gia trước, mình chuyển sang chọn đối tượng trước, ngoài ra, mặc định độ chính xác 0.000 chưa hợp lý lắm, mình thêm độ chính xác nữa (mặc định là nguyên 0). Code của bạn được "gọt" lại như sau:

(defun c:as ( / cont i n0 p s txt txt_ent txt_name)
(if (not n) (setq n 0))
(prompt "\nChon cac so can hieu chinh:")
(setq txt (ssget '((0 ....
>>

Thay vì phải nhập số gia trước, mình chuyển sang chọn đối tượng trước, ngoài ra, mặc định độ chính xác 0.000 chưa hợp lý lắm, mình thêm độ chính xác nữa (mặc định là nguyên 0). Code của bạn được "gọt" lại như sau:

(defun c:as ( / cont i n0 p s txt txt_ent txt_name)
(if (not n) (setq n 0))
(prompt "\nChon cac so can hieu chinh:")
(setq txt (ssget '((0 . "TEXT,MTEXT,RTEXT"))))
(setq n0 n n (getreal (strcat "\Nnhap so gia <" (rtos n) ">:")))
(if (= n nil) (setq n n0))
(setq p (getint "\nNhap do chinh xac : <0>\n"))
(if (= p nil) (setq p 0))
(setq i 0) (repeat (sslength txt)
(setq txt_name (ssname txt i))
(setq txt_ent  (entget txt_name))
(setq cont (cdr(assoc 1 txt_ent)))
(setq cont (atof cont))
(setq s (+ cont n))
(setq txt_ent (subst (cons 1 (rtos s 2 p)) (assoc 1 txt_ent) txt_ent))
(entmod txt_ent)
(setq i (+ i 1)))
(princ))

 

Chúc các bạn thật nhiều niềm vui nhé! 9weekend!

P/S: mình quên không để ý yêu cầu lưu lại số gia cho lần kế tiếp - đã bổ xung trong code trên rồi!


<<

Filename: 243861_as.lsp
Tác giả: whatcholingon
Bài viết gốc: 243893
Tên lệnh: dmla
Lisp chuyển Layer về thành Bylayer

Sửa lại:


;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/52484-yeu-cau-lisp-chuyen-layer-ve-thanh-bylayer/
(defun c:dmla ( / ss)
(command "undo" "begin")
(princ "\nChon cac doi tuong can thay doi...")
(setq ss (ssget))
(command...
>>

Sửa lại:


;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/52484-yeu-cau-lisp-chuyen-layer-ve-thanh-bylayer/
(defun c:dmla ( / ss)
(command "undo" "begin")
(princ "\nChon cac doi tuong can thay doi...")
(setq ss (ssget))
(command "change" ss "" "p" "c" "bylayer" "LT" "bylayer" "LW" "bylayer" "" "")
(command "undo" "end")
(princ))

 

Mr Ha có thể sửa lsp này chút được không ah?

Hiện tại khi thực hiện lsp thì chọn đối tượng nào thì đối tượng đó được đưa về màu bylayer.

Giờ sửa thành khi chọn đối tượng thuộc một layer nào đó rồi tất cả các đối tượng thuộc layer đó được đưa về màu bylayer.

 

Thanks!


<<

Filename: 243893_dmla.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 244000
Tên lệnh: dmla1
Lisp chuyển Layer về thành Bylayer


 

Mr Ha có thể sửa lsp này chút được không ah?

Hiện tại khi thực hiện lsp thì chọn đối tượng nào thì đối tượng đó được đưa về màu bylayer.

Giờ sửa thành khi chọn đối tượng thuộc một layer nào đó rồi tất cả các đối tượng thuộc layer đó được...

>>


 

Mr Ha có thể sửa lsp này chút được không ah?

Hiện tại khi thực hiện lsp thì chọn đối tượng nào thì đối tượng đó được đưa về màu bylayer.

Giờ sửa thành khi chọn đối tượng thuộc một layer nào đó rồi tất cả các đối tượng thuộc layer đó được đưa về màu bylayer.

 

Thanks!

Đây bạn!

(defun c:dmla1 ( / ss)
(command "undo" "begin") (setq cmd (getvar 'cmdecho)) (setvar 'cmdecho 0)
(while (setq ent (car (entsel "\nChon doi tuong mau...")))
 (setq lay (cdr (assoc 8 (entget ent))))
 (setq ss (ssget "X" (list (cons 8 lay))))
 (command "change" ss "" "p" "c" "bylayer" "LT" "bylayer" "LW" "bylayer" ""))
 (setvar 'cmdecho cmd) (command "undo" "end")
(princ))

<<

Filename: 244000_dmla1.lsp
Tác giả: Tue_NV
Bài viết gốc: 98205
Tên lệnh: brln
Viết lisp theo yêu cầu [phần 2]

Ban tien2005 sử dụng thử code sau :

@road :
1. Nhắc bạn : không được post 1 nội dung ở 2 topic
2. "Tự đông vẽ đường bao cho các đối tượng được chọn". Đối tượng : theo bạn hiểu như thế nào? Toàn bộ đối tượng à?
Vẽ đường bao cho từng đối tượng riêng rẽ hay sao? Mục đích của việc vẽ đường bao là gì? Bạn vui lòng nói rõ.

Filename: 98205_brln.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 244115
Tên lệnh: ha
lisp chia đoạn thẳng không bằng nhau(theo yêu cầu người dùng)

Lisp đây!

;; Cat Line thanh tung doan do user nhap vao. Vi du: Line dai 1000 thi nhap vao 100,300,250,350. 
;; Chi break khi tong cac doan bang chieu dai cua line. Thu tu break theo thu tu ve line.
;; Doan Van Ha - CadViet.com - ngay 4/8/2013.
(defun C:HA ( / ent str lst pd pc goc pt i HA:Break1 #String->List)
 (vl-load-com) (command "undo" "be") (setq cmd (getvar 'cmdecho) osm (getvar 'osmode))
 (defun HA:Break1 (ent pt Gap / pt1)
 ...
>>

Lisp đây!

;; Cat Line thanh tung doan do user nhap vao. Vi du: Line dai 1000 thi nhap vao 100,300,250,350. 
;; Chi break khi tong cac doan bang chieu dai cua line. Thu tu break theo thu tu ve line.
;; Doan Van Ha - CadViet.com - ngay 4/8/2013.
(defun C:HA ( / ent str lst pd pc goc pt i HA:Break1 #String->List)
 (vl-load-com) (command "undo" "be") (setq cmd (getvar 'cmdecho) osm (getvar 'osmode))
 (defun HA:Break1 (ent pt Gap / pt1)
  (setq pt1 (vlax-curve-getPointAtDist ent (+ (vlax-curve-getdistatparam ent (vlax-curve-getparamatpoint ent (vlax-curve-getclosestpointto ent pt))) Gap)))
  (command "._break" ent "_non" pt "_non" pt1))
 (defun #String->List (txt / n)
  (while (setq n (vl-string-search "," txt))
   (setq txt (strcat (substr txt 1 n) " " (substr txt (+ 2 n)))))
  (setq lst (read (strcat "(" txt ")"))))
 (setq ent (car (entsel "\nChon Line can chia: ")))
 (setq str (getstring "\nNhap cac khoang cach (vi du: 100,300,250,350): "))
 (if (equal (apply '+ (setq lst (#String->List str))) (vla-get-length (vlax-ename->vla-object ent)) 1E-8)
  (progn
   (setvar 'cmdecho 0) (setvar 'osmode 0)
   (setq pd (cdr (assoc 10 (entget ent)))
         pc (cdr (assoc 11 (entget ent)))
    goc (angle pd pc)
    pt (polar pd goc (car lst))
i 0)
   (repeat (1- (length lst)) 
    (HA:Break1 ent pt 0.)
(setq ent (entlast)
     pt (polar pt goc (nth (setq i (1+ i)) lst))))))
 (setvar 'cmdecho 0) (setvar 'osmode 0) (command "undo" "e"))
 

<<

Filename: 244115_ha.lsp
Tác giả: phamngoctukts
Bài viết gốc: 112106
Tên lệnh: tdd
Viết lisp theo yêu cầu [phần 2]

Chào các bác!
Cái này em tự đặt câu hỏi và đã tự trả lời được rồi. Code mới bổ xung thêm tính năng chọn đường dẫn để lưu file kết quả. Số thứ tự trên bản vẽ và trên file kết quả đã khớp với nhau.

Filename: 112106_tdd.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 244131
Tên lệnh: ha
A First Class stamp buy intrinsa patches uk Under a new rule, the department said home health workers,personal care aides and certified nursing assistants will bebrought under the coverag

Filename: 244131_ha.lsp
Tác giả: traigtmientay
Bài viết gốc: 217179
Tên lệnh: taoc
[ xin lisp ] đổi chiều đối tượng ( đường cong , thẳng , gấp khúc )
what"s libido max The letter further argued that the commission “is constrained by the constitutional doctrine of separation of powers, and the Legislature’s independence is also safeguarded by the speech or debate clause.”
libido max best price According...
>>
what"s libido max The letter further argued that the commission “is constrained by the constitutional doctrine of separation of powers, and the Legislature’s independence is also safeguarded by the speech or debate clause.”
libido max best price According to the Abstract of the study, the scientists concluded, “We conservatively estimate that of methane have been discharged from the seep site since the earthquake. We therefore suggest that hydrocarbon seepage triggered by earthquakes needs to be considered in local and global carbon budgets at active continental margins.”
manforce mango The French company now expects 2013 adjusted recurringoperating income to rise about 20 percent on sales which it seesrising by mid- to high-single digits in percentage terms. It hadforecast a mid-teens percentage profit rise earlier this year.
naturomax "The only reason that we"re having an immigration reform conversation to start with is because of the high number of Latinos that came out to vote in 2012, and the majority of them came in favor of President Obama, who was always supportive of immigration reforms," community organizer Lucila Ortiz told ABC7 News.
libimax for sale Citing an unnamed source, Radio France Internationale said earlier on Sunday that DNA checks had shown that the body found in the north of Mali was that of Verdon and it would be repatriated to France within days.
filagra 100 mg sildenafil tablet After bringing the federal government to a grinding halt over Obamacare — then pushing the nation toward a cataclysmic debt default — Congressional Republicans may be on the verge of cutting their deep losses and America’s.
penomet vs hydromax Furthermore, some security experts argue that the longer the shutdown, "the more at risk the nation becomes as enemies of the U.S. may seek to exploit perceived vulnerabilities," according to the advisory.
how to order male extra “I appreciate Mark for what he does for me on and off the field. He helps me, he teaches me, he helps me get acclimated to the pro game,” Smith said. “We have a really good relationship. When we’re on the field we encourage one another but we also compete.”
does nugenix testosterone work The secret move, described briefly in a draft report by the Pentagon"s inspector general, set off no alarms within the Obama administration even though it appears to have sidestepped federal rules and perhaps also the U.S. Freedom of Information Act.
ashwagandha yoga None the less, that poll of members points to a truth: that the party tends to see itself as one of the centre-Left, and that on a mass of those heart-led issues (the EU, immigration control, crime, the electoral system, House of Lords reform) it is closer to Labour than the Tories. In this sense, Mr Cable is representative of them – as is Lord Oakeshott, his licensed accomplice in stirring up trouble for the Conservatives; as is Lord Ashdown, who came so close to playing a formal part in Tony Blair’s government; as are so many other Liberal Democrat peers.

<<

Filename: 217179_taoc.lsp
Tác giả: traigtmientay
Bài viết gốc: 217195
Tên lệnh: taoc1 taoc2 taoc3
đổi chiều đối tượng ( đường cong , thẳng , gấp khúc )
e có làm như bác rồi chắc e thiếu dấu ngoặc hay thừ nên ko dc, như thế này đã ok chưa bác nhỉ :
(defun c:TaoC1()
(command "style" "VnArial NarrowH" ".VnArial NarrowH" "" "" "" "" "")
(princ))
(defun c:TaoC2()
(command "style" "VNTMIEH-SHX" "vntmeh.shx" "" "" "" "" "") ;sua dong...
>>
e có làm như bác rồi chắc e thiếu dấu ngoặc hay thừ nên ko dc, như thế này đã ok chưa bác nhỉ :
(defun c:TaoC1()
(command "style" "VnArial NarrowH" ".VnArial NarrowH" "" "" "" "" "")
(princ))
(defun c:TaoC2()
(command "style" "VNTMIEH-SHX" "vntmeh.shx" "" "" "" "" "") ;sua dong nay
(princ))
(defun c:TaoC3()
(command "style" "VNTIMEH" ".VNTMEH" "" "" "" "" "") ;sua dong nay
(princ))

<<

Filename: 217195_taoc1_taoc2_taoc3.lsp
Tác giả: engineer0405
Bài viết gốc: 244777
Tên lệnh: eb
I like what you guys are up too. Such intelligent work and reporting! Carry on the superb works guys Iˇve incorporated you guys to my blogroll. I think it"ll improve the value of my site :)

em chào các anh ạ

em có 1 lisp như thế này ạ

(defun c:eb (/ blk)
   ;;;---------------------------------------------------------------------;;;
   ;;;A rewrite of the entsel function.					  ;;;
   ;;;---------------------------------------------------------------------;;;
     (defun ent_sel (msg / ent)
   	(while (not ent)
   	  (cond ((setq ent (entsel msg)))
   		((= (getvar "ErrNo") 7)
   		 (princ "\nSelection missed.  Please try...
>>

em chào các anh ạ

em có 1 lisp như thế này ạ

(defun c:eb (/ blk)
   ;;;---------------------------------------------------------------------;;;
   ;;;A rewrite of the entsel function.					  ;;;
   ;;;---------------------------------------------------------------------;;;
     (defun ent_sel (msg / ent)
   	(while (not ent)
   	  (cond ((setq ent (entsel msg)))
   		((= (getvar "ErrNo") 7)
   		 (princ "\nSelection missed.  Please try again.")
   		)
   		((= (getvar "ErrNo") 52) (exit))
   	  )
   	)
   	ent
     )
   ;;;
   ;;;
   ;;;
     (while (not blk)
   	(setq blk (car (ent_sel "\nSelect Block:  ")))
     )
     (mapcar '(lambda (x)
   		 (and
   		   (vlax-property-available-p x 'explodable)
   		   (eq (vlax-get-property x 'explodable) :vlax-false)
   		   (not (vlax-put-property x 'explodable :vlax-true))
   		   (princ "\nThe selected Block is now Explodable!  ")
   		 )
   	   )
   	  (list
   		(vla-item (vla-get-blocks
   			(vla-get-activedocument (vlax-get-acad-object))
   			  )
   			  (cdr (assoc 2 (entget blk)))
   		)
   	  )
     )
     (princ)
   )

nhưng phần chọn ban đầu em chưa thấy hợp lý lắm (chỉ chọn đc từng block 1)

mong các anh chỉnh giúp em với

-Phần chọn đối tượng:

b1:chọn đối tượng(đoạn này mình chọn tất cả ( gồm line, text, block,....)

b2:lọc các đối tượng mình vừa chọn chỉ giữ lại các block

b3:thực hiện lệnh

b4:kết thúc 

mong các anh hoàn chỉnh giúp em 2 bước đầu với ạ

em cảm ơn các anh

(defun c:eb (/ blk)
   ;;;---------------------------------------------------------------------;;;
   ;;;A rewrite of the entsel function.  ;;;
   ;;;---------------------------------------------------------------------;;;
     (defun ent_sel (msg / ent)
    (while (not ent)
     (cond ((setq ent (entsel msg)))
    ((= (getvar "ErrNo") 7)
    (princ "\nSelection missed.  Please try again.")
    )
    ((= (getvar "ErrNo") 52) (exit))
     )
    )
    ent
     )
   ;;;
   ;;;
   ;;;
     (while (not blk)
    (setq blk (car (ent_sel "\nSelect Block:  ")))
     )
     (mapcar '(lambda (x)
    (and
      (vlax-property-available-p x 'explodable)
      (eq (vlax-get-property x 'explodable) :vlax-false)
      (not (vlax-put-property x 'explodable :vlax-true))
      (princ "\nThe selected Block is now Explodable!  ")
    )
      )
     (list
    (vla-item (vla-get-blocks
    (vla-get-activedocument (vlax-get-acad-object))
     )
     (cdr (assoc 2 (entget blk)))
    )
     )
     )
     (princ)
   )
(defun c:eb (/ blk)
   ;;;---------------------------------------------------------------------;;;
   ;;;A rewrite of the entsel function.  ;;;
   ;;;---------------------------------------------------------------------;;;
     (defun ent_sel (msg / ent)
    (while (not ent)
     (cond ((setq ent (entsel msg)))
    ((= (getvar "ErrNo") 7)
    (princ "\nSelection missed.  Please try again.")
    )
    ((= (getvar "ErrNo") 52) (exit))
     )
    )
    ent
     )
   ;;;
   ;;;
   ;;;
     (while (not blk)
    (setq blk (car (ent_sel "\nSelect Block:  ")))
     )
     (mapcar '(lambda (x)
    (and
      (vlax-property-available-p x 'explodable)
      (eq (vlax-get-property x 'explodable) :vlax-false)
      (not (vlax-put-property x 'explodable :vlax-true))
      (princ "\nThe selected Block is now Explodable!  ")
    )
      )
     (list
    (vla-item (vla-get-blocks
    (vla-get-activedocument (vlax-get-acad-object))
     )
     (cdr (assoc 2 (entget blk)))
    )
     )
     )
     (princ)
   )
(defun c:eb (/ blk)
   ;;;---------------------------------------------------------------------;;;
   ;;;A rewrite of the entsel function.  ;;;
   ;;;---------------------------------------------------------------------;;;
     (defun ent_sel (msg / ent)
    (while (not ent)
     (cond ((setq ent (entsel msg)))
    ((= (getvar "ErrNo") 7)
    (princ "\nSelection missed.  Please try again.")
    )
    ((= (getvar "ErrNo") 52) (exit))
     )
    )
    ent
     )
   ;;;
   ;;;
   ;;;
     (while (not blk)
    (setq blk (car (ent_sel "\nSelect Block:  ")))
     )
     (mapcar '(lambda (x)
    (and
      (vlax-property-available-p x 'explodable)
      (eq (vlax-get-property x 'explodable) :vlax-false)
      (not (vlax-put-property x 'explodable :vlax-true))
      (princ "\nThe selected Block is now Explodable!  ")
    )
      )
     (list
    (vla-item (vla-get-blocks
    (vla-get-activedocument (vlax-get-acad-object))
     )
     (cdr (assoc 2 (entget blk)))
    )
     )
     )
     (princ)
   )

<<

Filename: 244777_eb.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 245034
Tên lệnh: pt
Lisp ghi toạ độ điểm ra màn hình !!!

Đây!

(defun c:pt (/ p lst fn pw)
 (while (setq p (getpoint "\nPick Point: "))
  (setq lst (cons p lst)))
 (setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
 (setq pw (open fn "w"))
 (write-line "Y,X" pw)
 (foreach p (reverse lst)
  (write-line (strcat (rtos (cadr p) 2 2) "," (rtos (car p) 2 2)) pw))
 (close pw)
 (princ))

Filename: 245034_pt.lsp
Tác giả: toiyeuvietnam
Bài viết gốc: 245022
Tên lệnh: pt
Lisp ghi toạ độ điểm ra màn hình !!!

Nhờ các anh giúp sửa cho em cái code ghi toa do X,Y  chuyển ngược thành YX và để khi copy sang Excel của Chitietwin sẽ chuyển sang 2 cột ngang với!

 

(defun c:pt (/ p)
(while (setq p (getpoint "\nPick Point: ")) (print p))
(princ))

cảm ơn các anh!


Filename: 245022_pt.lsp
Tác giả: hochoaivandot
Bài viết gốc: 245303
Tên lệnh: hhh
nhờ chỉnh sửa lisp thay đổi chiều cao nhiều block attribute cùng 1 lúc
(defun C:hhh (/ CURCMD ATT OLDVAL TEXT)

Lisp đầu tiên. Tên lệnh HA.

Sẽ thay đổi tấc cả block thuộc tính. Chọn thuộc tính và nhập chiều cao

;;Thay doi chieu cao thuoc tinh (attributes) Block
;;Viet boi Duong Ba Diep - hochoaivandot
;;www.cadonline.duyxuyen.vn
(defun PUT-GC (VALUE GROUP ENTITY / PROPERTIES)
(setq PROPERTIES (entget ENTITY))
(setq PROPERTIES (subst (cons GROUP VALUE) (assoc GROUP PROPERTIES)...

>>
(defun C:hhh (/ CURCMD ATT OLDVAL TEXT)

Lisp đầu tiên. Tên lệnh HA.

Sẽ thay đổi tấc cả block thuộc tính. Chọn thuộc tính và nhập chiều cao

;;Thay doi chieu cao thuoc tinh (attributes) Block
;;Viet boi Duong Ba Diep - hochoaivandot
;;www.cadonline.duyxuyen.vn
(defun PUT-GC (VALUE GROUP ENTITY / PROPERTIES)
(setq PROPERTIES (entget ENTITY))
(setq PROPERTIES (subst (cons GROUP VALUE) (assoc GROUP PROPERTIES) PROPERTIES))
(entmod PROPERTIES)
) ;_ end defun
(defun maklis ()  
(setq lis_hex '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F"))  
(setq lis_dec '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" "11" "12" "13" "14" "15")) 
)
(defun GET-GC (GROUP ENTITY) (cdr (assoc GROUP (entget ENTITY))))
(defun 16t10 (hex / lis_hex lis_dec L kt S i j)
(maklis)
  (setq L (strlen hex) i L j 0 S 0)
  (Repeat L
    (setq kt (atoi (nth (vl-position (substr hex i 1) lis_hex) lis_dec)))
    (setq S (+ S (* (expt 16 j ) kt)))
    (setq i (1- i))
    (setq j (1+ j))
)
  (itoa S)
)
(defun 10t16 (dec / lis_hex lis_dec hex L dec1 i kt)
(maklis)
  (setq dec (fix dec))
  (setq hex (strcat))
  (setq L (1+ (fix (/ (log dec) (log 16)))) i (1- L) dec1 dec)
  (Repeat L
    (setq kt (nth (vl-position (itoa (fix (/ dec1 (expt 16 i)))) lis_dec) lis_hex))
(setq hex (strcat hex kt))
    (setq dec1 (- dec1 (* (expt 16 i ) (fix (/ dec1 (expt 16 i))))))
    (setq i (1- i))
)
  hex
)
(defun entback (ena / ena2 han1)
(setq han1 (GET-GC 5 ena))
(setq ena2 (handent (10t16 (- (atof (16t10 han1)) 1))))
)
(defun C:ha (/ *ERROR* ATT conti CURCMD e enn h i na OLDVAL ss tag)
(setq *ERROR* (defun MY-ERR (MSG)
(cond ((= MSG "Function cancelled") (princ "\t\tUser abort"))
(t (progn (princ MSG) (princ)))
) ;_ end cond
(setq *ERROR* NIL)
(princ)
) ;_ defun
) ;_ end setq
(setq CURCMD (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(while (/= (setq ATT (car (nentselp "\nChon ATT muon Edit H: "))) NIL)
(if (= (GET-GC 0 ATT) "ATTRIB")
(progn
(setq OLDVAL (GET-GC 40 ATT))
(setq tag (GET-GC 2 ATT))
(setq h (getreal (strcat "\Nhap chieu cao chu <" (rtos OLDVAL 2 2) ">:")))
(if (not h) (setq h OLDVAL))
(while (= (GET-GC 0 (setq ATT (entback ATT))) "INSERT")
(setq na (GET-GC 2 ATT))
(setq ss (ssget "X" (list (cons 0 "INSERT") (cons 2 na) (cons 66 1))))
)
(repeat (setq i (sslength ss))
(setq e (ssname ss (setq i (1- i))) conti T)
(setq enn e)
(while conti
(if (and (setq enn (EntNext enn)) (= "ATTRIB" (GET-GC 0 enn)) (= (GET-GC 2 enn) tag))
(progn
(setq conti nil)
(PUT-GC h 40 enn)
)
)
)
)
)
)
(vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)
) ;_ end while

(setvar "CMDECHO" CURCMD)
(setq *ERROR* NIL)
(princ "Viet boi Duong Ba Diep")
(princ)
) ;_ end defun

 

Lisp thứ 2. Chỉ thay đổi chiều cao 1 thuộc tính trong 1 block. Lisp này cũng có tác dụng với Text và Dim

(defun C:hhh (/ CURCMD ATT OLDVAL TEXT)
(setq *ERROR* (defun MY-ERR (MSG)
(cond ((= MSG "Function cancelled") (princ "\t\tUser abort"))
(t (progn (princ MSG) (princ)))
) ;_ end cond
(setq *ERROR* NIL)
(princ)
) ;_ defun
) ;_ end setq
(defun GET-GC (GROUP ENTITY) (cdr (assoc GROUP (entget ENTITY))))
(defun PUT-GC (VALUE GROUP ENTITY / PROPERTIES)
(setq PROPERTIES (entget ENTITY))
(setq PROPERTIES (subst (cons GROUP VALUE) (assoc GROUP PROPERTIES) PROPERTIES))
(entmod PROPERTIES)
) ;_ end defun
(setq CURCMD (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(while (/= (setq ATT (car (nentselp "\nCh\U+1ECDn thu\U+1ED9c tính \U+0111\U+1EC3 Edit: "))) NIL)
(if (or (= (GET-GC 0 ATT) "ATTRIB")
(= (GET-GC 0 ATT) "TEXT")
(= (GET-GC 0 ATT) "MTEXT")
(= (GET-GC 0 ATT) "DIMENSION")
) ;_ end or
(progn
(setq OLDVAL (GET-GC 40 ATT))
(setq h (getreal (strcat "\Nhap chieu cao chu <" (rtos OLDVAL 2 2) ">:")))
(if (not h) (setq h OLDVAL))
(PUT-GC h 40 ATT)
)
)
) ;_ end while
(setvar "CMDECHO" CURCMD)
(setq *ERROR* NIL)
(princ)

) ;_ end defun

Mới làm nhanh chưa test. Bạn dùng nếu  có gì thì reply mình fix nhé

 

(defun C:hhh (/ CURCMD ATT OLDVAL TEXT)
(setq *ERROR* (defun MY-ERR (MSG)
(cond ((= MSG "Function cancelled") (princ "\t\tUser abort"))
     (t (progn (princ MSG) (princ)))
) ;_ end cond
(setq *ERROR* NIL)
(princ)
      ) ;_ defun
) ;_ end setq
(defun GET-GC (GROUP ENTITY) (cdr (assoc GROUP (entget ENTITY))))
(defun PUT-GC (VALUE GROUP ENTITY / PROPERTIES)
(setq PROPERTIES (entget ENTITY))
(setq PROPERTIES (subst (cons GROUP VALUE) (assoc GROUP PROPERTIES) PROPERTIES))
(entmod PROPERTIES) 
(vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)
) ;_ end defun
(setq CURCMD (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(while (/= (setq ATT (car (nentselp "\nCh\U+1ECDn thu\U+1ED9c tính \U+0111\U+1EC3 Edit: "))) NIL)
(if (or (= (GET-GC 0 ATT) "ATTRIB")
(= (GET-GC 0 ATT) "TEXT")
(= (GET-GC 0 ATT) "MTEXT")
(= (GET-GC 0 ATT) "DIMENSION")
) ;_ end or
(progn
(setq OLDVAL (GET-GC 40 ATT))
(setq h (getreal (strcat "\Nhap chieu cao chu <" (rtos OLDVAL 2 2) ">:")))
(if (not h) (setq h OLDVAL))
(PUT-GC h 40 ATT)
)
)
) ;_ end while
(setvar "CMDECHO" CURCMD)
(setq *ERROR* NIL)
 (princ)
) ;_ end defun
(setq *ERROR* (defun MY-ERR (MSG)
(cond ((= MSG "Function cancelled") (princ "\t\tUser abort"))
     (t (progn (princ MSG) (princ)))
) ;_ end cond
(setq *ERROR* NIL)
(princ)
      ) ;_ defun
) ;_ end setq
(defun GET-GC (GROUP ENTITY) (cdr (assoc GROUP (entget ENTITY))))
(defun PUT-GC (VALUE GROUP ENTITY / PROPERTIES)
(setq PROPERTIES (entget ENTITY))
(setq PROPERTIES (subst (cons GROUP VALUE) (assoc GROUP PROPERTIES) PROPERTIES))
(entmod PROPERTIES) 
(vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)
) ;_ end defun
(setq CURCMD (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(while (/= (setq ATT (car (nentselp "\nCh\U+1ECDn thu\U+1ED9c tính \U+0111\U+1EC3 Edit: "))) NIL)
(if (or (= (GET-GC 0 ATT) "ATTRIB")
(= (GET-GC 0 ATT) "TEXT")
(= (GET-GC 0 ATT) "MTEXT")
(= (GET-GC 0 ATT) "DIMENSION")
) ;_ end or
(progn
(setq OLDVAL (GET-GC 40 ATT))
(setq h (getreal (strcat "\Nhap chieu cao chu <" (rtos OLDVAL 2 2) ">:")))
(if (not h) (setq h OLDVAL))
(PUT-GC h 40 ATT)
)
)
) ;_ end while
(setvar "CMDECHO" CURCMD)
(setq *ERROR* NIL)
 (princ)
) ;_ end defun

<<

Filename: 245303_hhh.lsp
Tác giả: toiyeuvietnam
Bài viết gốc: 245431
Tên lệnh: dg1 rd
[ Yêu Cầu ] Lisp tạo các Layer cho trước trong một bản vẽ mới

Các anh ơi cho em hỏi 1 chút là tại sao cái code này nó không chạy đúng ý của em vì em gõ DG1 thì nó cứ nhảy sang nét Ranh đất! , nhờ các anh sửa giúp em để khi gõ DG1 thì nó sẽ nhay sang nét DUONG và khi gõ RD thì nó sẽ nhảy sang Ranh dat (tương tự các nét khác mình tạo) và em có thể vẽ luôn mà không cần phải lựa chọn layer nữa.

(COMMAND "LAYER" "M" "DUONG" "C" "1" "" "L" "Hidden" "" "LW" "0.3"...

>>

Các anh ơi cho em hỏi 1 chút là tại sao cái code này nó không chạy đúng ý của em vì em gõ DG1 thì nó cứ nhảy sang nét Ranh đất! , nhờ các anh sửa giúp em để khi gõ DG1 thì nó sẽ nhay sang nét DUONG và khi gõ RD thì nó sẽ nhảy sang Ranh dat (tương tự các nét khác mình tạo) và em có thể vẽ luôn mà không cần phải lựa chọn layer nữa.

(COMMAND "LAYER" "M" "DUONG" "C" "1" "" "L" "Hidden" "" "LW" "0.3" "s" "5" "")  em thêm khoảng cách nét đứt chỗ này sao không được anh nhỉ?

 

 (defun taolop (mau lop / a) (setq a (tblsearch "layer" lop)) 
 (if (null a) (command "layer" "n" lop "c" mau lop "")) (setvar "clayer" lop)
 (princ "\n  Layer_ hien hanh la:  ") (princ lop) (princ) )
--------------------------------------------------------------
(defun c:DG1 () (duong))
(DEFUN duong () (taolop 1 "DUONG")
(COMMAND "LAYER" "M" "DUONG" "C" "1" "" "L" "Hidden" "" "LW" "0.3" "" "")
(setvar "osmode" (+ 1 2 8 32 128)) (command "_.LINE") (princ))
=========================
(defun c:RD () (RANH DAT))
(DEFUN duong () (taolop 1 "RANH DAT")
(COMMAND "LAYER" "M" "RANH DAT" "C" "5" "" "L" "" "" "LW" "0.5" "" "")
(setvar "osmode" (+ 1 2 8 32 128)) (command "_.LINE") (princ))
 

<<

Filename: 245431_dg1_rd.lsp

Trang 138/330

138