- page 122

Info

File

Tác giả: duy782006
Bài viết gốc: 229023
Tên lệnh: chuyenlay cvml

Lệnh là: CHUYENLAY

Nó dài thòn thòn là do làm cho hiện cái bảng danh sách layer hiện có trong bản vẽ để bạn chọn làm layer đích chứ còn bạn muốn chỉ định cố định layer đích thì chỉ cần dùng lệnh: CVML

và sửa

Lệnh là: CHUYENLAY

và sửa

(nth (atoi duy:bienluu_tenlayer) dsso)

Thành "tenlayer" là được!

(defun duy:vht_modau (tieudeht / tieudeht)
(setq sogan 2)
(setq solistgan 1)
(setq solistganb 1)
(setq soanhgan 1)
(setq soanhggan 1)
(setq filedcl (open "D:/htd.dcl" "w"))
(write-line (strcat "duyhopthoai : dialog { label = " "\"" tieudeht "\"" "\;") filedcl)
(setq filelsp (open "D:/ganhtd.lsp" "w"))
(write-line (strcat "\(" "defun ght " "\(" "\)") filelsp)
(setq filelsps (open "D:/ganhtds.lsp" "w"))
(write-line (strcat "\(" "defun ghts " "\(" "\)") filelsps)
(write-line (strcat "\(" "setq phepchon " "\(" "start_dialog" "\)" "\)") filelsps)
(write-line (strcat "\(" "cond") filelsps)
)

(defun duy:vht_ketthuckhongnut (noidung / noidung)
(write-line (strcat ": text {alignment  = centered" "\;" " label = " "\"" noidung "\"" "\;" "}") filedcl)
(write-line (strcat "}") filedcl)
(close filedcl)
(write-line "\)" filelsp)
(close filelsp)
(write-line "\))" filelsps)
(close filelsps)
)

(defun duy:vht_nutthoat (tennut dorong / tennut dorong)
(write-line (strcat ": button {alignment  = centered" "\;" " is_cancel = true" "\;" " width = " dorong "\;" " label = " "\"" tennut "\"" "\;" " key = " "\"" " accept" "\"" "\;" " is_default = true" "\;" "}") filedcl)
)

(defun duy:vht_textso (tieude dorong lisththi vitrimd gtnhan / tieude dorong lisththi vitrimd gtnhan)
(write-line (strcat ": popup_list {alignment  = centered" "\;" " edit_width = " dorong "\;" " label = " "\"" tieude "\"" "\;" " key = " "\"" "listthu" (itoa solistgan) "\"" "\;" "}") filedcl)
(write-line (strcat "\(" "start_list " "\"" "listthu" (itoa solistgan) "\"" "\)") filelsp)
(write-line (strcat "\(" "mapcar " "\'" "add_list " lisththi "\)") filelsp)
(write-line (strcat "\(" "end_list" "\)") filelsp)
(write-line (strcat "\(" "set_tile " "\"" "listthu" (itoa solistgan) "\" " "\(" "itoa " vitrimd "\)" "\)") filelsp)
(write-line (strcat "\(" "action_tile " "\"" "listthu" (itoa solistgan) "\" " "\"" "\(setq " gtnhan " \(get_tile " "\\" "\"" "listthu" (itoa solistgan) "\\" "\"" "\)" "\)" "\"" "\)") filelsp)
(setq solistgan (+ solistgan 1))
)   

(defun duy:vht_nut (tennut hamgoi dorong / tennut hamgoi dorong)
(write-line (strcat ": button {alignment  = centered" "\;" " width = " dorong "\;" " label = " "\"" tennut "\"" "\;" " key = " "\"" hamgoi "\"" "\;" "}") filedcl)
(write-line (strcat "\(" "action_tile " "\"" hamgoi "\" "  "\"" "\(" "done_dialog " (itoa sogan) "\)" "\"" "\)") filelsp)
(write-line (strcat "\(" "\(" "= phepchon " (itoa sogan) "\) " "\(" "c:" hamgoi "\)" "\)") filelsps)
(setq sogan (+ 1 sogan))
)

(defun duy:vht_goihopthoai (/ nda)
(setq DCL_ID (load_dialog "D:/htd.dcl"))
(new_dialog "duyhopthoai" DCL_ID)
(setq fileganhtd (open "D:/ganhtd.lsp" "r"))
(repeat 2
(setq nda (read-line fileganhtd))
)
(close fileganhtd)
(cond
((= nda "\)") (start_dialog) (unload_dialog dcl_id))
((/= nda "\)") (load "D:/ganhtd.lsp") (load "D:/ganhtds.lsp") (ght) (ghts))
)
)

(defun duy:taolist (kieu / kieu nl lkq)
(setq lkq'())
(setq nl (tblnext kieu T))
(while nl
(setq lkq (append lkq (list (cdr (assoc 2 nl)))))
(setq nl (tblnext kieu))
)
lkq)

(defun c:chuyenlay ()
(duy:vht_modau "Chuyen layer")
(duy:vht_nut "Chon doi tuong" "cvml" "0")
(setq dsso (duy:taolist "layer"))
(cond
((= nill duy:bienluu_tenlayer) (setq tenlayerluu "0") (setq duy:bienluu_tenlayer "0"))
((/= nill duy:bienluu_tenlayer) (setq tenlayerluu duy:bienluu_tenlayer))
)
(duy:vht_textso "Layer:" "12" "dsso" tenlayerluu "duy:bienluu_tenlayer")
(duy:vht_nutthoat "Thoat" "0")
(duy:vht_ketthuckhongnut "Viet boi: Duy782006")
(duy:vht_goihopthoai)
(Princ))

(defun c:cvml ()
(princ "Chon cac doi tuong muon chuyen layer !")
(setq dchon (ssget))

(setq sttd 0)
(while (setq LAY (ssname dchon sttd))

(setq kqcolor (cdr (assoc 62 (entget LAY))))
  (Cond
  ((= kqcolor nill) 
  (setq kqcolor (cdr (assoc 62 (entget (TBLOBJNAME "LAYER" (cdr (assoc 8 (entget LAY))))))))
  )
  ((/= kqcolor nill) 
  (setq kqcolor kqcolor)
  )
  )

(command "chprop" LAY "" "layer" (nth (atoi duy:bienluu_tenlayer) dsso) "color" kqcolor "")

(setq sttd (1+ sttd))
)

(princ))

Download lisp

Filename: 229023_chuyenlay_cvml.lsp

Tác giả: Doan Van Ha
Bài viết gốc: 229218
Tên lệnh: ha

Lisp Đo + chia

(defun C:HA()

(setq p1 (getpoint "\nDiem thu 1: "))

(setq p2 (getpoint p1 "\nDiem thu 2: "))

(setq chia (getreal "\nNhap so chia: "))

(alert (rtos (+ (/ (distance p1 p2) chia) 1) 2 2)))

Download lisp

Filename: 229218_ha.lsp

Tác giả: gia_bach
Bài viết gốc: 79427
Tên lệnh: hg

Lisp thay thế lệnh Replace all !!!

với text thì bạn dùng cái này

Download lisp

Filename: 79427_hg.lsp

Tác giả: KangKung
Bài viết gốc: 229319
Tên lệnh: kk

I really appreciate this post. Iˇve been looking all over for this! Thank goodness I found it on Bing. You"ve made my day! Thanks again

trong bản vẽ của mình có rất nhiều block , mình muốn chuyển tất cả các đối tượng trong tất cả các block về cùng 1 layer thì làm thế nào mong các bác giúp em với, chỉ thực hiện 1 lệnh thui chứ làm từng cái thì lâu quá

Đây Lisp của cụ đây. Lệnh KK rồi chọn block. Các đối tượng trong...

trong bản vẽ của mình có rất nhiều block , mình muốn chuyển tất cả các đối tượng trong tất cả các block về cùng 1 layer thì làm thế nào mong các bác giúp em với, chỉ thực hiện 1 lệnh thui chứ làm từng cái thì lâu quá

Đây Lisp của cụ đây. Lệnh KK rồi chọn block. Các đối tượng trong block sẽ chuyển về Layer hiện hành.

Cụ chạy ngon lành thì vui lòng bấm nút mũi tên màu xanh phía dưới bên phải của bài viết này hộ cái nhé.

http://www.cadviet.com/upfiles/3/71162_chuyen_cac_doi_tuong_trong_block_ve_cung_1_layer.lsp

;=====LISP CHUYEN CAC DOI TUONG TRONG BLOCK VE CUNG 1 LAYER=======
;===================KANGKUNG 22/03/2013===========================
(defun C:kk()
  (vl-load-com)
  (command "UNDO" "BE")
  (setq taphop(ssget))
  (setq soluong (sslength taphop))
  (setq index 0)
  (setq items (list))
  (while (< index soluong)
    (if (= (cdr (assoc 0 (setq nfo (entget (ssname taphop index))))) "INSERT")
      (vlax-for item (vla-item (vla-get-blocks(vla-get-activedocument(vlax-get-acad-object)))
			       (cdr (assoc 2 nfo)))
	(setq items (cons (vlax-vla-object->ename item) items))
	)
      )
    (foreach obj1 items
      (setq obj(entget obj1))
      (if (= (assoc 62 obj) nil)
	(setq Color (cdr (assoc 62 (entget (TBLOBJNAME "LAYER" (cdr (assoc 8 obj)))))))
	(setq Color (cdr(assoc 62 obj))))
      (if (= (assoc 62 obj) nil)
	(progn
	  (setq obj(append obj (list (cons 62 Color))))
	  (entmod obj))
	(entmod (subst (cons 62 Color) (assoc 62 obj) obj))
	)
      (setq Layer (getvar "Clayer"))
      (entmod (subst (cons 8 Layer) (assoc 8 obj) obj))
      )
    (setq items (list))
    (setq index (+ index 1))
    )
  (command "UNDO" "END")
  (princ)
  )
(princ "\nNhap KK de chay chuong trinh\n")

Download lisp

Filename: 229319_kk.lsp

Tác giả: KangKung
Bài viết gốc: 229393
Tên lệnh: kk

chuyển các đối tượng trong block về cùng 1 layer

Hàng mới của cụ thanhphatld đây. Đã sửa code theo góp ý của Ketxu tuy nhiên đang lằng nhằng ở đoạn block trong block nên mới chỉ sử dụng được với các block đơn giản thôi nhé.

http://www.cadviet.com/upfiles/3/71162_chuyen_cac_doi_tuong_trong_block_ve_cung_1_layer_rev1.lsp

;=====LISP...
>>

http://www.cadviet.com/upfiles/3/71162_chuyen_cac_doi_tuong_trong_block_ve_cung_1_layer_rev1.lsp

;=====LISP CHUYEN CAC DOI TUONG TRONG BLOCK VE CUNG 1 LAYER - REV1=======
;======================KANGKUNG 23/03/2013===============================
(defun C:kk()
  (vl-load-com)
  (command "UNDO" "BE")
  (setq taphop(ssget '((0 . "INSERT"))))
  (setq soluong (sslength taphop))
  (setq index 0)
  (setq items (list))
  (while (< index soluong)
    (setq nfo (entget (ssname taphop index)))
    (vlax-for item (vla-item (vla-get-blocks(vla-get-activedocument(vlax-get-acad-object)))
			     (cdr (assoc 2 nfo)))
      (progn
	(setq kt 0)
	(foreach abcdef items
	  (if (eq abcdef (vlax-vla-object->ename item))
	    (setq kt 1)))
	(if (= kt 0)
	  (setq items (cons (vlax-vla-object->ename item) items)))
	))
    (setq index (+ index 1))
    )
  (foreach item items
    (if (= (vlax-get-property (vlax-ename->vla-object item) 'Color) 256)
      (setq Color (cdr (assoc 62 (entget (TBLOBJNAME "LAYER" (vlax-get-property (vlax-ename->vla-object item) 'Layer))))))
      (setq Color (vlax-get-property (vlax-ename->vla-object item) 'Color))
	)
    (vlax-put-property (vlax-ename->vla-object item) 'color Color)
    (vlax-put-property (vlax-ename->vla-object item) 'Layer (getvar "CLAYER"))
    )
  (command "REGEN")
  (command "UNDO" "END")
  (princ)
  )
(princ "\nNhap KK de chay chuong trinh\n")

Download lisp

Filename: 229393_kk.lsp

Tác giả: KangKung
Bài viết gốc: 229418
Tên lệnh: kk

chuyển các đối tượng trong block về cùng 1 layer

Lisp mới chuyển toàn bộ các đối tượng trong block về cùng 1 Layer, giữ nguyên màu sắc. Block đơn giản hay phức tạp cũng chơi hết. :D

Load lisp rồi nhập kk là xong. Không cần phải chọn đối tượng làm gì, toàn bộ block có trong bản vẽ sẽ được chuyển hết.

Lisp mới chuyển toàn bộ các đối tượng trong block về cùng 1 Layer, giữ nguyên màu sắc. Block đơn giản hay phức tạp cũng chơi hết. :D

Load lisp rồi nhập kk là xong. Không cần phải chọn đối tượng làm gì, toàn bộ block có trong bản vẽ sẽ được chuyển hết.

http://www.cadviet.com/upfiles/3/71162_chuyen_cac_doi_tuong_trong_block_ve_cung_1_layer_rev2.lsp

PS: Cụ thanhphatld muốn che đối tượng nằm dưới block thì dùng wipeout trong block là OK ngay.

;=====LISP CHUYEN CAC DOI TUONG TRONG BLOCK VE CUNG 1 LAYER - REV2=======
;======================KANGKUNG 24/03/2013===============================
(defun C:kk()
  (vl-load-com)
  (command "UNDO" "BE")
  (vlax-for for-item (vla-get-blocks(vla-get-activedocument(vlax-get-acad-object)))
    (vlax-for item (vla-item (vla-get-blocks(vla-get-activedocument(vlax-get-acad-object))) (vla-get-name for-item))
      (if (= (vlax-get-property item 'Color) 256)
	(setq color (cdr (assoc 62 (entget (TBLOBJNAME "LAYER" (vlax-get-property item 'Layer))))))
	(setq color (vlax-get-property item 'Color)))
      (vlax-put-property item 'Color color)
      (vlax-put-property item 'Layer (getvar "CLAYER"))
      )
    )
  (command "UNDO" "END")
  (princ)
  (alert "Well done!")
  )
(princ "\n                Written By KangKung\n")
(princ "\n           Nhap KK de chay chuong trinh\n")

Download lisp

Filename: 229418_kk.lsp

Tác giả: KangKung
Bài viết gốc: 229417
Tên lệnh: kk

lisp lọc tất cả các đối tượng theo màu

Theo mình, Quick Select và Filter hoàn toàn không đáp ứng được nhu cầu. Mình xin diễn giải nhu cầu của chủ thớt như sau:

- Tự động tìm kiếm xem trên bản vẽ có bao nhiêu màu (bao gồm cả màu đối tượng và màu của layer). Giả sử có 2 màu là 1 và 2.

- Tạo lớp Color001 và lọc tất cả các đối tượng có...
>>

Theo mình, Quick Select và Filter hoàn toàn không đáp ứng được nhu cầu. Mình xin diễn giải nhu cầu của chủ thớt như sau:

- Tự động tìm kiếm xem trên bản vẽ có bao nhiêu màu (bao gồm cả màu đối tượng và màu của layer). Giả sử có 2 màu là 1 và 2.

- Tạo lớp Color001 và lọc tất cả các đối tượng có màu số 1, bao gồm

     + Tất cả đối tượng có màu 1.

     + Tất cả đối tượng có màu bylayer nằm trên layer có màu 1.

     + Tất cả đối tượng con trong Block đáp ứng 2 điều kiện trên.

      -> sau đó chuyển về tất cả về lớp Color001.

- Tiếp tục cho lớp Color002.

- Kết quả: Sau khi thực hiện xong Lisp, màu của bản vẽ không có gì thay đổi, trong bản vẽ có bao nhiêu màu thì sẽ có bấy nhiêu layer được tạo ra và chứa đúng đối tượng có màu đó. Riêng với đối tượng Dimension mình chưa biết phải làm thế nào, vì nó là đối tượng phức và bản thân nó có thể có nhiều màu khác nhau (cho mũi tên, text và đường gióng nữa).

Đây là yêu cầu, còn thực hiện nó không hề đơn giản chỉ một câu lệnh.

Lisp đây lisp đây.....

Lisp này chuyển tất tần tật các loại đối tượng trên bản vẽ (Model hay Layout đều chơi tất) có màu giống nhau về layer tương ứng với màu đó. (chả biết có chuyển được hết tất cả các đối tượng không nhưng mà test thử nhiều loại đối tượng như Text, Qleader, Xline, Mline, Hatch v.v... thì OK rồi, Dimension và các đối tượng con trong block của bác LoveLisp cũng chuyển ngon lành luôn).

Các bác dùng xem có vấn đề gì không rồi cho ý kiến và nhớ đừng quên Like em đấy nhé.

http://www.cadviet.com/upfiles/3/71162_lisp_chuyen_doi_tuong_cung_mau_ve_cung_layer.lsp

;========LISP CHUYEN DOI TUONG CUNG MAU VE CUNG LAYER==========
;=================KANGKUNG 24/03/2013==========================
(defun C:KK()
  (vl-load-com)
  (command "UNDO" "BE")
  (vlax-for for-item (vla-get-modelspace(vla-get-activedocument (vlax-get-acad-object)))
    (progn
      (if (= (vla-get-color for-item) 256)
	(setq color(cdr (assoc 62 (entget (TBLOBJNAME "LAYER" (vla-get-layer for-item))))))
	(setq color(vla-get-color for-item))
	)
      (if (= (tblsearch "Layer" (strcat "Color_" (rtos color 2 0))) nil)
	(progn
	  (command "LAYER" "N" (strcat "Color_" (rtos color 2 0)) "C" color (strcat "Color_" (rtos color 2 0)) "")
	  (vla-put-layer for-item (strcat "Color_" (rtos color 2 0)))
	  )
	(vla-put-layer for-item (strcat "Color_" (rtos color 2 0)))
	)
      )
    )
  (vlax-for for-item (vla-get-blocks(vla-get-activedocument(vlax-get-acad-object)))
    (vlax-for item (vla-item (vla-get-blocks(vla-get-activedocument(vlax-get-acad-object))) (vla-get-name for-item))
      (if (= (vlax-get-property item 'Color) 256)
	(setq color (cdr (assoc 62 (entget (TBLOBJNAME "LAYER" (vlax-get-property item 'Layer))))))
	(setq color (vlax-get-property item 'Color))
	)
      (if (= 0 color) (setq color 7))
      (if (= (tblsearch "Layer" (strcat "Color_" (rtos color 2 0))) nil)
	(progn
	  (command "LAYER" "N" (strcat "Color_" (rtos color 2 0)) "C" color (strcat "Color_" (rtos color 2 0)) "")
	  (vlax-put-property item 'Layer (strcat "Color_" (rtos color 2 0)))
	  )
	(vlax-put-property item 'Layer (strcat "Color_" (rtos color 2 0)))
	)
      )
    )
  (command "UNDO" "END")
  (princ)
  (alert "Well done!")
  )
(princ "\n                Written By KangKung\n")
(princ "\n           Nhap KK de chay chuong trinh\n")

Download lisp

Filename: 229417_kk.lsp

Tác giả: ketxu
Bài viết gốc: 229424
Tên lệnh: bl1

chuyển các đối tượng trong block về cùng 1 layer

Hầy, sửa đi một tẹo của bạn KK. Code tường minh ở chỗ nào cần tường minh thôi ^^

(defun C:bl1(/ lay m)
	(vl-load-com)	
	(command "UNDO" "BE")
	(setq lay (getvar 'CLAYER))(setvar 'cmdecho 0)
	(vlax-for blks (vla-get-blocks(vla-get-activedocument(vlax-get-acad-object)))
		(vlax-for e blks 
			(vla-put-color e 
				(cond 
					((/= (setq m (vla-get-color e)) 256) m)
					((cdr (assoc 62 (entget (TBLOBJNAME "LAYER" (vla-get-Layer...
>>

Hầy, sửa đi một tẹo của bạn KK. Code tường minh ở chỗ nào cần tường minh thôi ^^

(defun C:bl1(/ lay m)
	(vl-load-com)	
	(command "UNDO" "BE")
	(setq lay (getvar 'CLAYER))(setvar 'cmdecho 0)
	(vlax-for blks (vla-get-blocks(vla-get-activedocument(vlax-get-acad-object)))
		(vlax-for e blks 
			(vla-put-color e 
				(cond 
					((/= (setq m (vla-get-color e)) 256) m)
					((cdr (assoc 62 (entget (TBLOBJNAME "LAYER" (vla-get-Layer e))))))
				)
			)
			(vla-put-layer e lay)  
		)
	)
	(command "UNDO" "END")
(princ)
)

Download lisp

Filename: 229424_bl1.lsp

Tác giả: Chiron
Bài viết gốc: 227695
Tên lệnh: %3Cspan+clas

[nhờ giúp đỡ] lisp tính các phép tính toán cơ bản với text

Có phải bạn muốn thế này:

(defun c:tinh (/ ss ent sobitru sotru sobichia sochia ssle1 kqua)
(vl-load-com)

(initget "+ - * /")
(setq ptinh1 (getkword "Chon phep tinh <+ - * />: "))

(if ptinh1
(setq ptinh ptinh1)
)

(cond ((= ptinh "+")
;;; cong
(prompt "\nChon text de cong:")
(setq ss (ssget '((0 . "TEXT")))
kqua 0
)
(while (and ss (> (sslength ss) 0))
(setq kqua
(+ kqua
(atof (cdr (assoc 1...

Download lisp

Filename: 227695_%3Cspan+clas.lsp

Tác giả: phamthanhbinh
Bài viết gốc: 229548
Tên lệnh: upsl

[ yêu cầu ] Lisp up nội dung từ Excel vào Cad

Mình có một file excel và Cad, muốn up nội dung từ excel vào cad theo thứ tự của tên ô trên các vòng tròn kí hiệu.

Dựa và tên ô chèn và thay thế nội dung CCTC, dientich, khoiluong và đúng vị trì nó.

File gởi kèm:

>>
Mình có một file excel và Cad, muốn up nội dung từ excel vào cad theo thứ tự của tên ô trên các vòng tròn kí hiệu.

Dựa và tên ô chèn và thay thế nội dung CCTC, dientich, khoiluong và đúng vị trì nó.

File gởi kèm:

http://www.cadviet.com/upfiles/3/114381_02_s_1.dwg

http://www.cadviet.com/upfiles/3/114381_02_kl_01.rar

Rất mong được giúp đỡ. Cám ơn

Similar topics from web:

Hề hề hề,

Bạn thử dùng cái này xem có phù hợp không nhé. Sử dụng với file bản vẽ bạn gửi nhé. Nếu OK bạn có thể sử dụng và chỉnh sửa cho phù hợp với các bản vẽ khác nhau.

(defun c:upsl ( / oldos ssc fn f str ans txl txt p0 et1 et2 et3 )

(vl-load-com)

(setq oldos (getvar "osmode"))

(setvar "osmode" 0)

(command "undo" "be")

(setq ssc (acet-ss-to-list (ssget (list (cons 0 "text") (cons 8 "Main_DTOV") (cons 62 3)))))

(setq fn (getfiled "Select Data File" "" "csv" 0)

f (open fn "r")

ans "Y"

)

(while (and (/= (setq str (read-line f)) nil) (= (strcase ans) "Y") (/= ssc nil) )

(setq txl (separate str (chr 44)) )

(foreach etxt ssc

(setq txt (cdr (assoc 1 (entget etxt))))

(if (= txt (nth 0 txl))

(progn

(setq p0 (cdr (assoc 11 (entget etxt))))

(setq et1 (ssname (ssget "w" (list (- (car p0) 2.5) (- (cadr p0) 5)) (list (+ (car p0) 2.5) (+ (cadr p0) 2.5))

(list (cons 0 "text") (cons 8 "Main_CDTC") (cons 62 130))) 0)

et2 (ssname (ssget "w" (list (- (car p0) 2.5) (- (cadr p0) 5)) (list (+ (car p0) 2.5) (+ (cadr p0) 2.5))

(list (cons 0 "text") (cons 8 "Main_DTOV") (cons 62 2))) 0)

et3 (ssname (ssget "w" (list (- (car p0) 2.5) (- (cadr p0) 5)) (list (+ (car p0) 2.5) (+ (cadr p0) 2.5))

(list (cons 0 "text") (cons 8 "Main_KLOV") (cons 62 31))) 0)

)

(entmod (subst (cons 1 (nth 1 txl)) (assoc 1 (entget et1)) (entget et1)))

(entmod (subst (cons 1 (nth 2 txl)) (assoc 1 (entget et2)) (entget et2)))

(entmod (subst (cons 1 (nth 3 txl)) (assoc 1 (entget et3)) (entget et3)))

(setq ssc (vl-remove etxt ssc))

)

)

)

)

(close f)

(command "undo" "e")

(setvar "osmode" oldos)

(princ)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun Separate (S sym / i L ch)

(setq i 0 L nil)

(while (< i (strlen S))

(setq i (1+ i) ch (substr S i 1))

(if (= ch sym) (progn

    (setq

     L (append L (list (substr S 1 (- i 1))))

     S (substr S (1+ i) (- (strlen S) i))

     i 0

    )

))

)

(append L (list S))

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

http://www.cadviet.com/upfiles/3/5194_updatetemdc.lsp

Chúc bạn vui.

<<

Download lisp

Filename: 229548_upsl.lsp

Tác giả: KangKung
Bài viết gốc: 229549
Tên lệnh: kk

Vấn đề về màu layer

Cụ tientracdia này có khả năng giải thích mà ai nghe hiểu được là chết liền :D :D :D

Đây là lisp chuyển các đối tượng về cùng 1 Layer (Current Layer) hoặc chuyển về Layer tương ứng theo màu đồng thời giữ nguyên kiểu đường. Lisp #11của KangKung và #12 của bác Duy mới chỉ chuyển được các đối tượng bình thường thôi chứ chưa xử được thằng block. Lisp mới này chơi hết...

Cụ tientracdia này có khả năng giải thích mà ai nghe hiểu được là chết liền :D :D :D

Hướng dẫn: Lệnh KK, Lisp sẽ hỏi chuyển các đối tượng về cùng 1 layer hay không. Nếu chọn Y thì toàn bộ đối tượng trong bản vẽ sẽ về layer hiện hành, nếu chọn N thì đối tượng màu 1,2,3 ... sẽ về layer Color_1, Color_2, Color_3 ...

;========LISP CHUYEN TAT CA CAC DOI TUONG VE CUNG LAYER HOAC VE LAYER THEO MAU==========
;=======================GIU NGUYEN MAU SAC, LINETYPE====================================
;===========================KANGKUNG 25/03/2013=========================================
(defun C:KK()
  (vl-load-com)
  (command "UNDO" "BE")
  (initget 1 "Y N")
  (setq hoi(getkword "\n Chuyen ve cung 1 Layer? (Y or N): "))
  (setq Clayer(getvar "CLAYER"))
  (vlax-for for-item (vla-get-blocks(vla-get-activedocument(vlax-get-acad-object)))
    (vlax-for item for-item
      (setq color (cond ((/= (setq color (vla-get-color item)) 256) color)
			((cdr (assoc 62 (entget (TBLOBJNAME "LAYER" (vla-get-Layer item))))))
			)
	    )
      (if (= 0 color) (setq color 255))
      (if (= (vla-get-linetype item) "ByLayer")
	(setq Ltype(vla-get-linetype (vlax-ename->vla-object (TBLOBJNAME "LAYER" (vla-get-Layer item)))))
	(setq Ltype(vla-get-linetype item)))
      
      (vla-put-linetype item Ltype)
      (vla-put-color item color)
      (if (= hoi "Y")
	(vla-put-layer item Clayer)
	(if (= (tblsearch "Layer" (strcat "Color_" (rtos color 2 0))) nil)
	  (progn
	    (command "LAYER" "N" (strcat "Color_" (rtos color 2 0)) "C" color (strcat "Color_" (rtos color 2 0)) "")
	    (vla-put-layer item (strcat "Color_" (rtos color 2 0)))
	    )
	  (vla-put-layer item (strcat "Color_" (rtos color 2 0)))
	  )
	)
      )
    )
  (command "REGEN")
  (command "UNDO" "END")
  (princ)
  (alert "Well done!")
  )
(princ "\n                Written By KangKung\n")
(princ "\n           Nhap KK de chay chuong trinh\n")

Download lisp

Filename: 229549_kk.lsp

Tác giả: KangKung
Bài viết gốc: 229560
Tên lệnh: kk

Lisp up nội dung từ Excel vào Cad

Không muốn dùng Block Attribute thì chơi Lisp này, đúng theo yêu cầu luôn.

http://www.cadviet.com/upfiles/3/71162_update_so_lieu_tu_excel_vao_cad_rev1_1.lsp

;=====LISP UPDATE SO LIEU TU FILE TXT VAO CAD - REV1==========
;================KANGKUNG 25/03/2013==========================
(defun C:KK()
  (command "UNDO" "BE")
  (setq...
>>

Không muốn dùng Block Attribute thì chơi Lisp này, đúng theo yêu cầu luôn.

http://www.cadviet.com/upfiles/3/71162_update_so_lieu_tu_excel_vao_cad_rev1_1.lsp

;=====LISP UPDATE SO LIEU TU FILE TXT VAO CAD - REV1==========
;================KANGKUNG 25/03/2013==========================
(defun C:KK()
  (command "UNDO" "BE")
  (setq taphop(ssget '((0 . "TEXT"))) os(getvar "OSMODE"))
  (if (not Path) (setq Path(getvar "dwgprefix")))
  (setq file(getfiled "Select File:" Path "txt" 2) Path file index 0 TEXT_LIST (list))
  (while (< index (sslength taphop))
    (setq TEXT (entget (ssname taphop index)))
    (if (/= (read (cdr(assoc 1 TEXT))) (atof (cdr(assoc 1 TEXT))))
      (progn
	(setq String(cdr(assoc 1 TEXT)))
	(if (= (+ (cdr(assoc 72 TEXT)) (cdr(assoc 73 TEXT))) 0)
	  (setq InsertPoint(cdr(assoc 10 TEXT)))
	  (setq InsertPoint(cdr(assoc 11 TEXT))))
	(setq TEXT_LIST (append (list (list String InsertPoint)) TEXT_LIST))))
    (setq index (1+ index)))
  (setq file_in(open file "R") lst_solieu(list))
  (while(setq txt(read-line file_in))
    (if (/= txt nil) (setq lst (read (strcat "(" txt ")"  ))))
    (foreach dt TEXT_LIST
      (if (= (car dt) (vl-princ-to-string(car lst)))
	(progn
	  (setq pt1(cadr dt) pt2(list (- (car pt1) 1.0757) (- (cadr pt1) 1.3762)) pt3(list (+ (car pt1) 1.2744) (- (cadr pt1) 1.3762)) pt4(list (car pt1) (- (cadr pt1) 2.7500)))
	  (entmakex (list '(0 . "TEXT") (cons 8 "Main_DTOV") (cons 62 3) (cons 10 pt1) (cons 40 0.5) (cons 1 (vl-princ-to-string(car lst))) (cons 72 1) (cons 11 pt1) (cons 73 2)))
	  (entmakex (list '(0 . "TEXT") (cons 8 "Main_CDTC") (cons 62 130) (cons 10 pt2) (cons 40 0.5) (cons 1 (rtos (cadr lst) 2 2)) (cons 72 1) (cons 11 pt2) (cons 73 2)))
	  (entmakex (list '(0 . "TEXT") (cons 8 "Main_DTOV") (cons 62 2) (cons 10 pt3) (cons 40 0.5) (cons 1 (rtos (caddr lst) 2 2)) (cons 72 1) (cons 11 pt3) (cons 73 2)))
	  (entmakex (list '(0 . "TEXT") (cons 8 "Main_KLOV") (cons 62 31) (cons 10 pt4) (cons 40 0.5) (cons 1 (rtos (cadddr lst) 2 2)) (cons 72 1) (cons 11 pt4) (cons 73 2)))
	  )
	)
      )
    )
  (COMMAND "ERASE" TAPHOP "")
  (close file_in)
  (command "UNDO" "END")
  )
(princ "\n                Written By KangKung - 25/03/2013\n")
(princ "\n                  Nhap KK de chay chuong trinh\n")

Download lisp

Filename: 229560_kk.lsp

Tác giả: Thaistreetz
Bài viết gốc: 192484
Tên lệnh: rsv+nil

[Đã xong] - Lisp theo dõi sự thay đổi biến hệ thống trong quá trình vẽ

Đôi khi ta cần biết những biến hệ thống nào đã bị thay đổi trong và sau khi thực hiện 1 lệnh nào đó trong quá trình vẽ. Việc lấy ra danh sách giá trị của tất cả biến hệ thống trước và sau khi thực hiện lệnh rồi so sánh thực sự vất vả mà kết quả không được đây đủ chi tiết nếu bạn lấy không đủ danh sách biến.
Lisp này có tác dụng theo dõi và thống kê cho bạn biết những biến hệ thống nào của cad đã bị thay đổi khi thực hiện 1 lệnh cad, 1 lệnh lisp hay bất kỳ lệnh nào gây ra sự thay đổi biến hệ thống, đồng thời ghi ra luôn giá trị trước và sau khi thay đổi là bao nhiêu để bạn nắm được sự thay đổi đó.
;;;Copyright 2012 Thaistreetz from Cadviet.com
(defun C:RSV nil
(if (vlr-reactors :VLR-SysVar-Reactor)
(and (vlr-remove-all :VLR-SysVar-Reactor)
(prompt "<< Da Tat che do theo doi bien he thong >>"))
(and (vlr-sysvar-reactor "Sysvar Reactor: Sysvar Change" '((:vlr-sysvarwillchange . callback-sysvarchang) (:vlr-sysvarchanged . callback-sysvarchang)))
(prompt "<< Da Bat che do theo doi bien he thong >>"))) (princ))
(defun callback-sysvarchang (reactor sysvar)
(if (= (vlr-current-reaction-name) :vlr-sysvarwillchange)
(setq *sysvar* (getvar (car sysvar)))
(if (not (equal *sysvar* (getvar (car sysvar))))
(progn (princ (strcat "\n" (car sysvar) " : <" )) (princ *sysvar*) (princ ">") (princ " ----> <" ) (princ (getvar (car sysvar))) (princ ">")))))
Lưu ý: Hiện tại lisp này không nhận biết được sự thay đổi biến hệ thống qua việc thay đổi các lựa chọn trong hộp thoại Option của cad nhé. Mình dùng cad 2010 nó không nhận. các bản Cad khác thì mình chưa thử. Còn với command hay các lệnh lisp hoặc lệnh tạo bằng các ngôn ngữ khác nó nhận biết bình thường.
Bạn có thể bật hoặc tắt chế độ theo dõi bằng 1 lệnh duy nhất là RSV (reactor Sysvar)

Có thể cũng bạn quan tâm: Lisp so sánh sự khác nhau giữa các biến hệ thống của 2 bản vẽ

Download lisp

Filename: 192484_rsv+nil.lsp

Tác giả: KangKung
Bài viết gốc: 229616
Tên lệnh: kk

[ yêu cầu ] Lisp up nội dung từ Excel vào Cad

digital performer 5 upgrade HTC, the first maker of phones using software from GoogleInc., was a contract manufacturer before it began promoting itsown brand in 2006. The company had a short-lived reign at thetop of the U.S. market in the third quarter of 2011, when itaccounted for 24 percent of smartphone shipments, according toresearcher Canalys.
ashwagandha q dosage The amount of exertion of a typical sexual activity is the equivalent of climbing two flights of stairs or a very brisk walk, she added. "So we"re not talking about ... running a marathon here. Typically, this is a very safe thing to do and important thing to do for recovery.
viarex power up She joked about someone in her position trying to ensure her “new boss” would “like me immediately” and recommended meeting “office people outside the office” as a way to integrate with new colleagues.
erectafil 60 The law was adopted in 2010 but two of its main pillars, the health exchanges and the expansion of Medicaid, take effect in 2014. Household names like UnitedHealth Group Inc, Aetna Inc, WellPoint Inc and Humana Inc will sell plans on at least some exchanges. Newcomers such as Medicaid specialist Molina Healthcare Inc will also play a role.
febrex 500 mg Emerging-market stocks, bonds and currencies took major hits earlier this year after Fed officials indicated they could soon begin withdrawing the bank’s extraordinary stimulus. The promise of rising returns in the U.S. amid waning growth prospects and potential over-investment in emerging markets prompted investors to pull their capital out in droves. Markets have since calmed as the Fed tempered expectations for an earlier exit.
semenax 120 "I want to just make very clear right now: I do not think it"s appropriate to boycott the Olympics," the president said, adding, "nobody"s more offended than me by some of the anti-gay and -lesbian legislation."
male enhancement sinrex "As we continue to eliminate human beings from the execution of security trading," said Stephen Massocca, managing director of Wedbush Equity Management LLC in San Francisco, "these events are going to take place, given the level of automation."
disadvantages of manforce tablet The justice department had said that Garzon would likely testify before a judge Saturday, but said in a statement it intended now to wait until the 52-year-old is able to appear in court rather than having a judge come to his hospital bedside.
is zyrexin over the counter Britain"s leading Muslim organisation warned tonight that a judge"s landmark ruling that women should not give evidence in court whilst wearing the veil threatened to undermine the nation"s long-standing tradition of religious tolerance.

Download lisp

Filename: 229616_kk.lsp

Tác giả: KangKung
Bài viết gốc: 229632
Tên lệnh: kk1 kk2

nhờ giúp đở cách đổi đường nét trong block

Mình mới tham gia vào diển đàn.rất mong các bác giúp đỡ.mình cần chuyển các đối tượng trong bản vẽ về layer,linetype khác.vd:
Tất cả layer 0-->layer 10
Layer 2 -->layer 90
Nét dash-->dash2
....
Mình đã tạo được lisp chuyển được các đối tượng về layer,linetype,linescale mong muốn rồi.NGOẠI TRỪ các...
>>

Mình mới tham gia vào diển đàn.rất mong các bác giúp đỡ.mình cần chuyển các đối tượng trong bản vẽ về layer,linetype khác.vd:
Tất cả layer 0-->layer 10
Layer 2 -->layer 90
Nét dash-->dash2
....
Mình đã tạo được lisp chuyển được các đối tượng về layer,linetype,linescale mong muốn rồi.NGOẠI TRỪ các đối tượng nằm trong BLOCK.các bác chỉ giùm mình cách truy cập các đối tượng trong block mà không phải rã block ra( có rất nhiều block,rã ra rồi phải ngồi block lại)mình cũng mới biết chút ít về autolisp thôi.cảm ơn các bác nhiều.

Yêu cầu của bạn tương tự yêu cầu ở Topic Vấn đề về màu Layer:

http://www.cadviet.com/forum/topic/69447-van-de-ve-mau-layer/

và Topic lisp lọc tất cả các đối tượng theo màu

http://www.cadviet.com/forum/topic/42436-yeu-cau-lisp-loc-tat-ca-cac-doi-tuong-theo-mau/

có chăng khác nhau ở chỗ bạn muốn chuyển từ Layer này sang Layer khác và từ Linetype này sang kiểu khác mà thôi.

Còn đây là Lisp theo yêu cầu của bạn. Lệnh KK1 để chuyển layer, lệnh KK2 để chuyển Linetype. Phải load linetype trước khi chạy lệnh KK2 nhé. Khi chạy lisp thì không riêng gì block mà toàn bộ đối tượng khác đều bị hết. Nói tóm lại là lisp này dùng cho toàn bộ đối tượng trên bản vẽ

http://www.cadviet.com/upfiles/3/71162_chuyeni_layer_linetype.lsp

;========LISP CHUYEN LAYER LINETYPE==========
;===========KANGKUNG 26/03/2013==============
(defun C:KK1()
  (vl-load-com)
  (command "UNDO" "BE")
  (setq lay1(getstring T "\n Nhap ten Layer can chuyen: "))
  (setq lay2(getstring T "\n Nhap ten Layer chuyen den: "))
  (vlax-for for-item (vla-get-blocks(vla-get-activedocument(vlax-get-acad-object)))
    (vlax-for item for-item
      (if (= (vla-get-Layer item) lay1)
	(vla-put-layer item lay2)
	)
      )
    )
  (command "UNDO" "END")
  (alert "Well done!")
  )
(defun C:KK2()
  (vl-load-com)
  (command "UNDO" "BE")
  (setq type1(strcase(getstring T "\n Nhap ten LineType can chuyen: ")))
  (setq type2(strcase(getstring T "\n Nhap ten LineType chuyen den: ")))
  (vlax-for for-item (vla-get-blocks(vla-get-activedocument(vlax-get-acad-object)))
    (vlax-for item for-item
      (if (= (vla-get-linetype item) "ByLayer")
	(setq Ltype(vla-get-linetype (vlax-ename->vla-object (TBLOBJNAME "LAYER" (vla-get-Layer item)))))
	(setq Ltype(vla-get-linetype item)))
      (if (= Ltype type1)
	(vla-put-linetype item type2)
	)
      )
    )
  (command "UNDO" "END")
  (alert "Well done!")
  )
(princ "\n                Written By KangKung - 26/03/2013\n")
(princ "\n           Nhap KK1 de chuyen Layer KK2 de chuyen LineType\n")

Download lisp

Filename: 229632_kk1_kk2.lsp

Tác giả: phamthanhbinh
Bài viết gốc: 229658
Tên lệnh: xtdc

[ yêu cầu ] Lisp up nội dung từ Excel vào Cad

Vẫn không xuất ra txt được bạn ơi. Bạn xem lại giúp

Hề hề hề,

Không xuất được là do bạn chưa làm đúng theo ý của bác Kang Kung. bạn phải sử dụng lisp #3 của bác ấy để chuyển các nhóm tẽt này thành block thuộc tính đã bạn ạ.

Đây là líp có thể xuất thẳng các nhóm text này ra...

Download lisp

Filename: 229658_xtdc.lsp

Tác giả: ketxu
Bài viết gốc: 229682
Tên lệnh: ee

Xin lisp giống lệnh trim

Srr dạo ni mình bận quá :(

Lỗi của bạn do ACET k trả biến highlight về

Mình ngại code inside outside, mà xét về vấn đề đã trích thì phải xoá ngoài chứ, đúng k ^^ Nên để thế này thôi cho nhanh (qqcode)

(defun C:EE ( / e ss lst ssall bbox   *error*) 
(defun *error* (msg)(alert (strcat "Error found :\n\n" msg))(setvar 'Highlight 1)(vl-cmdf "undo" "end"))
(vl-load-com)(command "undo"...
>>

Srr dạo ni mình bận quá :(

Lỗi của bạn do ACET k trả biến highlight về

Mình ngại code inside outside, mà xét về vấn đề đã trích thì phải xoá ngoài chứ, đúng k ^^ Nên để thế này thôi cho nhanh (qqcode)

(defun C:EE ( / e ss lst ssall bbox   *error*) 
(defun *error* (msg)(alert (strcat "Error found :\n\n" msg))(setvar 'Highlight 1)(vl-cmdf "undo" "end"))
(vl-load-com)(command "undo" "be")(setvar 'cmdecho 0)
(if (null etrim)(load "extrim.lsp"))
(prompt "\nChon duong bao <Pline> :")
(while (not (setq e (ssget ":S" (list (cons 0 "*POLYLINE"))))))
(if	(> (acet-dxf 90 (entget (setq e(ssname e 0)))) 2)
(progn
	(setq 	bbox (ACET-ENT-GEOMEXTENTS e)
			bbox (mapcar '(lambda(x)(trans x 0 1)) bbox)
			lst (ACET-GEOM-OBJECT-POINT-LIST e 1e-3)
	)
	(ACET-SS-ZOOM-EXTENTS (ACET-LIST-TO-SS (list e)))
	(command "_.Zoom" "0.95x") 
	(setq ssall (ssget "_X" (list (assoc 410 (entget e)))))	  
	(etrim e '(0 0 0))
	(setq ss (ssget "_CP" lst))		
	(setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
				(foreach e1 lst (ssdel e1 ssall))
				(ACET-SS-ENTDEL ssall)
)
(alert "\nChon Pline lon hon 2 dinh")
)
(setvar 'Highlight 1)(command "undo" "be")
(princ))

Download lisp

Filename: 229682_ee.lsp

Tác giả: phamthanhbinh
Bài viết gốc: 229689
Tên lệnh: blndt

Nhờ viết lisp tạo block từ các đối tượng giống nhau hay từ block đã bị phá

Những vấn đề nảy sinh mình đã cho trong này rồi nhé

mong bạn Phan Thanh Bình động não tiếp giúp mình và những người quan tâm

http://www.cadviet.com/upfiles/3/46537_vi_du_tiep.rar

Hề hề hề,

Đây là lisp mở rộng cho phép chọn đường bao là...

Download lisp

Filename: 229689_blndt.lsp

Tác giả: tientracdia
Bài viết gốc: 228311
Tên lệnh: ee

xenical,

Download lisp

Filename: 228311_ee.lsp

Tác giả: KangKung
Bài viết gốc: 229550
Tên lệnh: kk

[ yêu cầu ] Lisp up nội dung từ Excel vào Cad

Thêm 1 Lisp nữa cho bạn đây.

http://www.cadviet.com/upfiles/3/71162_update_so_lieu_tu_excel_vao_cad.lsp

Lệnh KK nhé. Sau đó chọn file số liệu (chuyển sang dạng txt ngăn cách bởi dấu tab hoặc space) rồi chọn số liệu trên bản vẽ.

Tuy nhiên để chạy lisp này thì bạn copy file sau đây vào thư mục Support trong CAD

Thêm 1 Lisp nữa cho bạn đây.

http://www.cadviet.com/upfiles/3/71162_update_so_lieu_tu_excel_vao_cad.lsp

Lệnh KK nhé. Sau đó chọn file số liệu (chuyển sang dạng txt ngăn cách bởi dấu tab hoặc space) rồi chọn số liệu trên bản vẽ.

Tuy nhiên để chạy lisp này thì bạn copy file sau đây vào thư mục Support trong CAD

http://www.cadviet.com/upfiles/3/71162_a.dwg

;========LISP UPDATE SO LIEU TU FILE TXT VAO CADU==========
;================KANGKUNG 25/03/2013=======================
(defun C:KK()
  (command "UNDO" "BE")
  (setq os(getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (if (not Path)
    (setq Path(getvar "dwgprefix")))
  (setq file(getfiled "Select File:" Path "txt" 2))
  (setq Path file)
  (setq taphop(ssget '((0 . "TEXT"))))
  (setq index 0)
  (setq TEXT_LIST (list))
  (while (< index (sslength taphop))
    (setq TEXT (entget (ssname taphop index)))
    (if (/= (read (cdr(assoc 1 TEXT))) (atof (cdr(assoc 1 TEXT))))
      (progn
	(setq String(cdr(assoc 1 TEXT)))
	(if (= (+ (cdr(assoc 72 TEXT)) (cdr(assoc 73 TEXT))) 0)
	  (setq InsertPoint(cdr(assoc 10 TEXT)))
	  (setq InsertPoint(cdr(assoc 11 TEXT)))
	  )
	(setq TEXT_LIST (append (list (list String InsertPoint)) TEXT_LIST))
	)
      )
    (setq index (1+ index))
    )
  (setq file_in(open file "R"))
  (setq lst_solieu(list))
  (while(setq txt(read-line file_in))
    (if (/= txt nil) (setq lst (read (strcat "(" txt ")"  ))))
    (foreach dt TEXT_LIST
      (if (= (car dt) (vl-princ-to-string(car lst)))
	(command "insert"  "a"  (cadr dt)  "1" "1" "0"
		   (vl-princ-to-string(car lst))
		   (vl-princ-to-string(cadr lst))
		   (vl-princ-to-string(caddr lst))
		   (vl-princ-to-string(cadddr lst)))
	)
      )
    )
  (COMMAND "ERASE" TAPHOP "")
  (close file_in)
  (setvar "OSMODE" os)
  )
(princ "\n                Written By KangKung - 25/03/2013\n")
(princ "\n                  Nhap KK de chay chuong trinh\n")

Download lisp

Filename: 229550_kk.lsp

Trang 122/330