- page 121

Info

File

Tác giả: quansla
Bài viết gốc: 227099
Tên lệnh: copy cad txt

AutoLisp copy "TEXT" từ Cad sang Excel và ngược lại

Mình có một lisp để có thể thao tác sử lý chuyển đổi nhanh chóng và đơn giản (chỉ bằng 1 cú click chuột) tất cả các dữ liệu dạng "text" từ AutoCad sang Excel và ngược lại, rất tiện dụng cho các bác QA/QS tính toán với vô vàn con số.

Giờ đây các bạn hoàn toàn có thể copy cả một kho dữ liệu từ Cad sang...
>>

Mình có một lisp để có thể thao tác sử lý chuyển đổi nhanh chóng và đơn giản (chỉ bằng 1 cú click chuột) tất cả các dữ liệu dạng "text" từ AutoCad sang Excel và ngược lại, rất tiện dụng cho các bác QA/QS tính toán với vô vàn con số.

Giờ đây các bạn hoàn toàn có thể copy cả một kho dữ liệu từ Cad sang Excel mà không cần phải chuyển đổi qua lại để nhập vào Office nữa, nói chung là bạn sử dụng sẽ thấy rất tuyệt vời.

***

***

Update: Link download & use:

http://cauduongbkdn.com/f@rums/showthread.php?39316-Xu%E1%BA%A5t-d%E1%BB%AF-li%E1%BB%87u-t%E1%BB%AB-Cad-Sap-qua-Excel-v%C3%A0-ng%C6%B0%E1%BB%A3c-l%E1%BA%A1i

Hix, mình thì không có và nhìn sơ sơ thì có vẻ là mình không quen dùng, mình viết tạm cái lísp này vậy

Mới chỉ có khả năng copy text , Mtext từ Cad ra Txt thôi, phải thêm một công đoạn nữa nếu mún sang Excel

Còn từ Excel về Txt rồi qua Cad thì từ từ mình tính(hix, khả năng có hạn, mà cố quá khéo quá cố mất)

đây là líp. tên lệnh là copy_cad_txt . Cách sử dụng là gõ tên lệnh, chọn File Txt có sẵn(lưu ý sẽ bị ghi đè lên giữ liệu cũ) hoặc lưu vào File txt mới. Sau đó quét chẽ text bình thường

Anh Admin ơi sao giờ khó viết thế, anh chỉ em cách tắt Check chính tả và bật mấy cái vụ làm chữ đậm, in nghiêng, bôi đen tô mầu với

{ đoạn này em sửa được rồi, nhưng giờ ko nhanh như trước- chỉ còn đoạn tắt chính tả thôi- mong Ad giúp}

Đây là líp

(defun c:copy_cad_txt (/ Tieude TenFile f lst i xau N x y) (vl-load-com) (setq TenFile (getfiled "Chon file .txt:" "" "txt" 5)) (setq lst (vl-sort (acet-ss-to-list (ssget '(( 0 . "*text")))) '(lambda (x y / px py ) (if (not (equal (cadr (setq px (cdr(assoc 10 (entget x))))) (cadr (setq py (cdr(assoc 10 (entget y))))) 1E-3)) (> (cadr px) (cadr py)) (< (car px) (car py)) ) ) )) (setq Tieude (strcat (getvar "dwgprefix") (getvar "dwgname") "\n" "\n")) (setq xau (strcat Tieude (cdr (assoc 1 (entget (setq m1 (car lst))) ))) i 0 N (length lst)) (while (< i (1- N)) (if (equal (caddr(assoc 10 (entget (nth i lst)) )) (caddr(assoc 10 (entget (nth (1+ i) lst)) )) 1E-3) (setq xau (strcat xau "\t" (cdr (assoc 1 (entget (nth (1+ i) lst)))))) (setq xau (strcat xau "\n" (cdr (assoc 1 (entget (nth (1+ i) lst)))) )) ) (setq i (1+ i)) ) (progn (setq f (open TenFile "w")) (write-line xau f) (close f) ) (prompt (strcat "Da xuat cac Text duoc chon ra: " TenFile )) (princ) )

Download lisp

Filename: 227099_copy_cad_txt.lsp

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

[Yêu cầu] Lisp tạo viewport từ khung chọn bên model.

Bạn khaosatheco thân mến.

Lisp #54 vẫn chạy được nếu polyline kín của bạn chỉ có 5 điểm hoặc có 4 điểm đầu tiên trùng với 4 góc của khung hình chữ nhật. Tuy nhiên tôi đã sửa lại theo ý của bạn là chọn polyline kín thì lisp vẫn chạy được. Thậm chí nếu polyline có hình loằng ngoằng thì lisp vẫn tạo cho bạn viewport bao kín hình polyline đó đúng với tỷ lệ bạn nhập...

Bạn khaosatheco thân mến.

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

;========LISP TAO VIEWPORT TREN LAYOUT BANG CACH CHON O MODEL======== ;===============REV4i===================== (defun C:mtl( / lst khung X_min Y_min X_max Y_max X index taphop) (command "UNDO" "BE") (setvar "OSMODE" 0) (setq taphop(ssget )) (if (= Tyle nil) (setq Tyle1 1) (setq Tyle1 Tyle)) (setq Tyle (getreal (strcat "\n Ty le: <" (rtos Tyle1 2 0) "> "))) (if (= Tyle nil) (setq Tyle Tyle1)) (setq soluong (sslength taphop)) (setq index 0) (command "LAYOUT" "N" "Layout1") (command "LAYOUT" "S" "Layout1") (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" "Layout1") (command "RECTANG" (list X_min Y_min) (list X_max Y_max)) (command "MOVE" (entlast) "" (list X_min Y_min) (list X 0)) (command "SCALE" (entlast) "" (list X 0) (/ 1 tyle)) (command "MVIEW" "O" (entlast)) (command "MSPACE") (command "ZOOM" (list X_min Y_min) (list X_max Y_max)) (command "PSPACE") (setq X(+ X 50 (/ (abs(- X_max X_min)) tyle))) (command "ZOOM" "W" (list 0 0) (list (+ X 100) 0)) (setq index (+ index 1)) ) (command "MODEL") (command "UNDO" "END") (setvar "OSMODE" 15359) (princ) )

Download lisp

Filename: 227047_mtl.lsp

Tác giả: draftsman38751
Bài viết gốc: 181607
Tên lệnh: oval%3Cbr%3E

[Nhờ chỉnh sửa]Lisp vẽ hình oval

Nhờ các bác chỉnh sửa giúp em lisp này với!Cảm ơn các bác nhiều!!

(defun main
FasStringtables 0
FasStringtables 1
(defun main
nil
(setq C:OVAL <Func> C:OVAL)
(vl-ACAD-defun C:OVAL)
(defun C:OVAL
(_al-bind-alist '(*OVL:ERR* C_E C1 C2 R ANG O1 O2 O3 O4 CE))
(defun *OVL:ERR*
(M)
(cond (MEMBER M '("Function cancelled" "quit / exit abort" "console break")) (

Download lisp

Filename: 181607_oval%3Cbr%3E.lsp

Tác giả: phamngoctukts
Bài viết gốc: 116115
Tên lệnh: colorx colorxref colorxl colorxrefl

Đổi màu tất cả các đối tượng trên bản vẽ thành một màu duy nhất

Cái lisp này mình sưu tầm được trên mạng đã lâu. Nay thấy bạn có nhu cầu mình port lên bạn xem có vư ý không nhé.

Download lisp

Filename: 116115_colorx_colorxref_colorxl_colorxrefl.lsp

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

Thanks for every other informative site. Where else may I am getting that kind of info written in such an ideal way? I have a mission that I"m simply now running on, and I"ve been at the look out for such information.

Có thể dùng field như anh Ketxu nói để ngày tháng có thể update được.

Còn muốn cố định chúng và muốn dùng lisp thì quick code cho bạn đây:

;Doan Van Ha - CADViet.com - Ngay 13/3/2013.

;Chuc nang: Chen ngay thang vao *TEXT.

;Ghi chu:

;Kieu 1: 13/3/2013

;Kieu 2: 13/3/2013 16:35

(defun C:HA( / lst kieu ent)

(load "julian.lsp")

(setq lst (jtoc...

Download lisp

Filename: 228445_ha.lsp

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

Đưa bình đồ dạng đường đồng mức về bình đồ dạng cao độ

Bác tạo luôn block (bằng lisp) chứa text xong nổ nó ra sửa quách cho nó đỡ lẹo tẹo bác ạ!

Hề hề hề,

Đây là một cái block cd1 mình tạo ra cho nó phù hợp với bản vẽ của chủ thớt. Mọi người down về rồi tự hiệu chỉnh cho nó vừa khớp với bản vẽ của mỗi người và khớp với sở...

Download lisp

Filename: 228593_gcddm.lsp

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

Hỏi về Lisp (thuật toán, ý tưởng, coding,...)

Bản vẽ A đang mở. Bản vẽ B đang đóng. Trong B có chứa 1 số Block Attribute.

Việc lấy các block trong B để chèn vào A thì OK rồi.

Nhưng việc lấy các Att của từng block trong B thì sao tôi mần hoài không được.

Ai biết xin chỉ giùm với?

Hà tham khảo hàm get_attLst trích trong Lisp

Download lisp

Filename: 228557_test.lsp

Tác giả: Nguyen Hoanh
Bài viết gốc: 6023
Tên lệnh: cinvis

Viết Lisp theo yêu cầu

Lệnh CINVIS dưới đây giống lệnh INVIS ở trên nhưng ẩn đối tượng theo màu.

Download lisp

Filename: 6023_cinvis.lsp

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

Đưa bình đồ dạng đường đồng mức về bình đồ dạng cao độ

Giờ mới rảnh, lại tò mò!

1. Các bác chỉ dùm mình chổ nào (nút nào) để down cái lisp của bác Bình !<hình>

2. Mình Copy --> dán theo bác Bình chỉ thì đc cái này
(defun c:gcddm ( / pl plst ssdml cdmax chcd i els ssp cdt )
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(command...
>>

Download lisp

Filename: 228654_gcddm.lsp

Tác giả: Nguyen Hoanh
Bài viết gốc: 9704
Tên lệnh: c%3Cspan+styl

Viết Lisp theo yêu cầu

Đây là lệnh CNInvis theo đúng ý bạn. Chỉ việc thêm vài dòng code so với trước. Màu đỏ là mã tôi vừa thêm.

Download lisp

Filename: 9704_c%3Cspan+styl.lsp

Tác giả: xaydung
Bài viết gốc: 9700
Tên lệnh: cinvis

Viết Lisp theo yêu cầu

Đây là lisp Cinvis đã có trên diễn đàn, em đang cần 1 lisp tương tự nhưng ngược 1 chút có nghĩa là khi chọn đối tượng chứa 1 màu thì các đối tượng có màu giống màu đối tượng chọn được giữ lại còn các đối tương khác thì ẩn đi. Mong các anh giúp em, thanks!!

Download lisp

Filename: 9700_cinvis.lsp

Tác giả: crazylisp
Bài viết gốc: 17547
Tên lệnh: csvtocad

AutoCAD với Excel

Cái này của tôi chức năng không hề kém, nhưng free. Tiết kiếm cho bạn 30$ rồi nhé!
bạn sử dụng lệnh CsvToCad:

;;;*************************** ;;; CsvToCAD - free software, written by Crazylisp. (vl-load-com) (setq CaoHang 1 RongCot 2 ) (defun StrExp (Str / ListStr) (defun StrPos (sub st / l1 l2 index) (setq index 1 l1 (Strlen sub) l2 (Strlen st) ) (while (and (<= (+ index l1 -1) l2) (/= sub (subStr st index l1))) (setq index (1+...

Download lisp

Filename: 17547_csvtocad.lsp

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

Cần giúp lisp hiện mã màu plot style

Mình đang dùng cad 2013 nhưng nó cũng k hiện rõ màu số bao nhiêu mà chỉ hiện là bylayer thôi. mún biết màu số bao nhiêu phải bật LA lên mới thấy dc.

(Defun c:XML ( )

                   
(princ "\nChon doi tuong muon xem thuoc tinh")
(setq doituong1 (entsel))
(while
(null doituong1)
(princ "\nChon doi tuong...
>>

Mình đang dùng cad 2013 nhưng nó cũng k hiện rõ màu số bao nhiêu mà chỉ hiện là bylayer thôi. mún biết màu số bao nhiêu phải bật LA lên mới thấy dc.

(Defun c:XML ( )

                   
(princ "\nChon doi tuong muon xem thuoc tinh")
(setq doituong1 (entsel))
(while
(null doituong1)
(princ "\nChon doi tuong muon xem thuoc tinh")
(setq doituong1 (entsel))
)

(setq doituong (car doituong1))
(setq doituong (entget doituong))


 (setq LAYERDOITUONG (cdr (assoc 8 doituong)))
 (setq COLORDOITUONG (cdr (assoc 62 doituong)))

  (setq TENLOP (TBLOBJNAME "LAYER" LAYERDOITUONG))
  (setq DOCLOP (entget TENLOP))
  (setq MAULOP (cdr (assoc 62 DOCLOP)))

 (Cond
  ((= COLORDOITUONG nill) 
  (setq COLORDOITUONG (strcat "BYLAYER <" (itoa MAULOP) ">"))
  )
  ((/= COLORDOITUONG nill) 
  (setq COLORDOITUONG (itoa COLORDOITUONG))
  )
  )

(alert (strcat 
    "\n -LAYER               : " LAYERDOITUONG
   "\n -COLOR              : " COLORDOITUONG))

(PRINC))

Download lisp

Filename: 228801_xml.lsp

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

Xin lisp giống lệnh trim

đây là đoạn code em đã copy ở #16.
đoạn hỏi: Phia cat va xoa bo : anh có thể chọn bằng cách pick về phía cần cắt xóa

trong hoặc ngoài được không ạ! cảm ơn anh

Download lisp

Filename: 228239_ee.lsp

Tác giả: npham
Bài viết gốc: 169194
Tên lệnh: demo

Lisp cộng trừ text độ, phút, giây...

Bạn xem cái này vừa ý không.
Format:
Space: 123 00 00
Dot: 123.0000
Comma: 123,0000
Dash: 123-00-00
Degress:123d00'00"

Toán tử: +, -

Nếu bỏ qua thì format và toán tử sẽ lấy lần nhập trước. Cái này có kiểm tra phím nhập, do đó khi nhập toán tử bạn phải nhập đúng ký tự +, -

(defun c:demo (/ e e1 e2 key #func)

Download lisp

Filename: 169194_demo.lsp

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

Will I be paid weekly or monthly? generic nizoral cream If a patient presents with these problems, it is often these that are treated, while the underlying alcohol problem is missed.

Download lisp

Filename: 229017_chuyenlay_cvml.lsp

Tác giả: hiepttr
Bài viết gốc: 228597
Tên lệnh: gcddm

Đưa bình đồ dạng đường đồng mức về bình đồ dạng cao độ

Giờ mới rảnh, lại tò mò!

1. Các bác chỉ dùm mình chổ nào (nút nào) để down cái lisp của bác Bình !<hình>

2. Mình Copy --> dán theo bác Bình chỉ thì đc cái này

(defun c:gcddm ( / pl plst ssdml cdmax chcd i els ssp cdt )
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(command "undo" "be")
(setq...
>>

Giờ mới rảnh, lại tò mò!

1. Các bác chỉ dùm mình chổ nào (nút nào) để down cái lisp của bác Bình !<hình>

2. Mình Copy --> dán theo bác Bình chỉ thì đc cái này

(defun c:gcddm ( / pl plst ssdml cdmax chcd i els ssp cdt )
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(command "undo" "be")
(setq pl (car (entsel "\n Chon duong dan"))
          plst (acet-geom-vertex-list pl ) )
 
(setq ssdml (acet-ss-to-list (ssget "f" plst (list (cons 0 "lwpolyline") (cons 62 30)) ))) 
(setq cdmax (getreal "\n Nhap cao do bat dau: ")
          chcd (getreal "\n Nhap do chenh cao giua cac duong dong muc: ")
          i 0 )
 (foreach dm ssdml
         (setq els (entget dm)
                  cdt  (+ cdmax (* i chcd))
                  els (subst (cons 38 cdt ) (assoc 38 els) els)
                  els (subst (cons 62 2) (assoc 62 els) els) )
         (entmod els)
         (command "measure" dm   200)
         (setq ssp (acet-ss-to-list (ssget "p")))
         (foreach pt ssp
               (command "insert" "cd1" (cdr (assoc 10 (entget pt))) 1 1 0 (rtos cdt 2 0) )
         )
         (setq i (1+ i)  )
)
(command "erase" pl "")
(command "undo" "e")
(setvar "osmode" oldos)
(princ)
)

Vẽ thử vài đường PL để chạy thử thì thấy nó bị lỗi này <hình>. Nhờ các bác xem hộ !

Download lisp

Filename: 228597_gcddm.lsp

Tác giả: 3d.decor
Bài viết gốc: 151036
Tên lệnh: clear

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

vẫn khônh được bác pham thanh binh a
bác thử sửa từ lisp này xem
nhưng trừ layer: cut,glass,hide,hatch,funitures,tree,text,center
lisp này không biết pro nào viết tẩy cả block và dim cực kỳ pro
mong pro nào rảnh giúp đỡ

sory pro ketxu
mong pro giúp amater cái
chuyển tất cả nhưng trừ lại một số layer: cut,glass,hide,hatch,funitures,tree,text,center
không cần chuyển dim,...

Download lisp

Filename: 151036_clear.lsp

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

Vấn đề về màu layer

Tình hình là mình có một nhóm đối tượng gồm nhiều layer khác nhau và mình muốn chuyển tất cả những layer đó về cùng một layer mà màu của chúng vẫn giữ nguyên. Bác nào biết cách nào làm được điều đó hoặc lisp nào làm được thì chỉ mình với!

Bạn dùng cái này xem. Lệnh kk sau...

Tình hình là mình có một nhóm đối tượng gồm nhiều layer khác nhau và mình muốn chuyển tất cả những layer đó về cùng một layer mà màu của chúng vẫn giữ nguyên. Bác nào biết cách nào làm được điều đó hoặc lisp nào làm được thì chỉ mình với!

Bạn dùng cái này xem. Lệnh kk sau đó chọn đối tượng. Toàn bộ đối tượng được chọn sẽ chuyển về Layer hiện hành.

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

(defun C:kk()
  (command "UNDO" "BE")
  (setq taphop(ssget))
  (setq soluong (sslength taphop))
  (setq index 0)
  (while (< index soluong)
    (setq obj(entget(ssname taphop index)))
    (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 (list (cons 62 Color)) obj))
	(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 index (+ index 1))
    )
  (command "UNDO" "END")
  (princ)
  )

Download lisp

Filename: 229014_kk.lsp

Tác giả: luiz
Bài viết gốc: 229035
Tên lệnh: toado td

các pro giúp mình sửa lisp này với

mình có lisp xuất tọa độ này,nhưng tọa độ xuất ra là ở 1 block hơi xấu. mình muốn sửa việc xuất các thông số X, Y, tên nút ra block này, Cảm ơn mọi người http://www.cadviet.com/upfiles/3/117742_cm_1.dwg

;************************* Ch¬ng tr×nh chÝnh

(DEFUN C:TOADO()

(setq os (getvar...

;************************* Ch¬ng tr×nh chÝnh

(DEFUN C:TOADO()

(setq os (getvar "OSMODE"))

(command "UNDO" "G")

; T¹o kiÓu ch÷ míi

(setq cst (getvar "TEXTSTYLE"))

(command "STYLE" "VNARIALNARROW" ".VNARIAL NARROW" "" "" "" "" "")

; ThiÕt lËp kiÓu ghi kÝch thíc

(setvar "DIMASZ" 4);kÝch thíc mòi tªn

(setvar "DIMTXT" 4); kichs thíc ch÷

(setvar "DIMTAD" 0); ch÷ c©n gi÷a

; T×m khèi BANGTOADO (nÕu cha cã th× t¹o ra)

(if (not (tblsearch "BLOCK" "BANGTOADO"))

(progn

(setvar "OSMODE" 0)

(setq cla (getvar "CLAYER") cec (getvar "CECOLOR"))

(setvar "CLAYER" "0")

(setvar "CECOLOR" "BYBLOCK")

(setq ssline (ssadd))

(command "PLINE" '(0 0) '(30.5 0) '(30.5 13.5) '(0 13.5) "c")

(ssadd (entlast) ssline)

(command "LINE" '(7.5 0) '(7.5 13.5) "")

(ssadd (entlast) ssline)

(command "LINE" '(7.5 6.75) '(30.5 6.75) "")

(ssadd (entlast) ssline)

(command "CIRCLE" '(3.75 6.75) 3.5)

(ssadd (entlast) ssline)

(command "ATTDEF" "" "SH" "Sè hiÖu" "" "Middle" '(3.75 6.75) 4 0)

(setq ssatt_sh (ssadd))(ssadd (entlast) ssatt_sh)

(command "ATTDEF" "" "XXXXXX.XXXX" "To¹ ®é X" "" '(8.1 8.1) 4 0)

(setq ssatt_xx (ssadd))(ssadd (entlast) ssatt_xx)

(command "ATTDEF" "" "YYYYYY.YYYY" "To¹ ®é Y" "" '(8.1 1.1) 4 0)

(setq ssatt_yy (ssadd))(ssadd (entlast) ssatt_yy)

(command "BLOCK" "BANGTOADO" '(0 0) ssline ssatt_sh ssatt_xx ssatt_yy "")

(setvar "CLAYER" cla)(setvar "CECOLOR" cec)

);progn

);if

(if (not tenmocChinh)

(setq tenmocChinh "1")

);if

(if (not tenmocPhu)

(setq tenmocPhu "")

);if

(if (not tenmoc)

(setq tenmoc (strcat tenmocChinh tenmocPhu))

)

(if (not sle)

(setq sle 2)

);if

(if (not ShowMode)(setq ShowMode "X"))

(setq loop T)

(while loop

(setvar "OSMODE" os)

(initget "M T X L"); Mèc - Thêng - XÞn - Sè lÎ

(setq mark (getpoint (strcat "\nsè LÎ <" (itoa sle) ">/H×nh thøc (Thêng/XÞn) <" ShowMode ">/tªn Mèc <" tenmoc ">/<ChØ ®iÓm>: ")))

(cond

((= mark "M")

(setq tenmoc0 (getstring (strcat "\nTªn Mèc míi (theo d¹ng : 1, 1a, A, A1...) <" tenmoc ">: ")))

(if (/= tenmoc0 "")

(progn

; ph©n tÝch tªn mèc ®Ó nhËn biÕt chÝnh-phô

(tachMoc tenmoc0)

(if (or (>= (ascii tenmocChinh) 57)(<= (ascii tenmocChinh) 48)); mèc chÝnh lµ ch÷

(setq tenmocChinh (strcase tenmocChinh))

);if

(setq tenmoc (strcat tenmocChinh tenmocPhu))

);progn

);if

)

((= mark "T")

(setq ShowMode "T")

)

((= mark "X")

(setq ShowMode "X")

)

((= mark "L")

(setq sle0 (getint (strcat "\nSè ch÷ sè thËp ph©n (Tèi ®a=2; tèi thiÓu=0) <" (itoa sle) ">: ")))

(if sle0

(progn

(if (< sle0 0)(setq sle0 0))

(if (> sle0 2)(setq sle0 2))

(setq sle sle0)

);progn

);if

)

(if mark

(progn

(cond

((= ShowMode "T");thêng

(setq toadoX (cadr (trans mark 1 0)))

(setq toadoY (car (trans mark 1 0)))

(setq p (getpoint mark "\nVÞ trÝ: "))

(setvar "OSMODE" 0)

(command "LEADER" mark p "" (rtos toadoX 2 sle) (rtos toadoY 2 sle) "")

;(command "PLINE" mark p "@11,0" "")

;(command "TEXT" (list (+ (car p) 0.5) (+ (cadr p) 0.5)) "" "0" (rtos toadoX 2 4))

;(command "TEXT" "TL" (list (+ (car p) 0.5) (- (cadr p) 0.5)) "" "0" (rtos toadoY 2 4))

)

((= ShowMode "X");XÞn

(setq toadoX (cadr (trans mark 1 0)))

(setq toadoY (car (trans mark 1 0)))

(setq p (getpoint mark "\nVÞ trÝ: "))

(setvar "OSMODE" 0)

(command "LEADER" mark p "" "" "Block" "BANGTOADO" p 1 1 0 tenmoc (rtos toadoX 2 sle) (rtos toadoY 2 sle))

; t¨ng gi¸ trÞ mèc

(tachmoc tenmoc)

(if (= tenmocPhu ""); kh«ng cã mèc phô

(if (and (<= (ascii tenmocChinh) 57)(>= (ascii tenmocChinh) 48)); mèc chÝnh lµ sè

(setq tenmoc (itoa (+ (atoi tenmocChinh) 1)))

(progn; else mèc chÝnh lµ ch÷

(setq tenmocASCII (+ (ascii tenmocChinh) 1))

(while (or (= (strcase (chr tenmocASCII)) "I")(= (strcase (chr tenmocASCII)) "O")

(= (strcase (chr tenmocASCII)) "V")(= (strcase (chr tenmocASCII)) "X")

(= (strcase (chr tenmocASCII)) "J"))

(setq tenmocASCII (+ tenmocASCII 1))

);while

(setq tenmoc (chr tenmocASCII))

);progn else

);if

;else cã mèc phô

(if (and (<= (ascii tenmocChinh) 57)(>= (ascii tenmocChinh) 48)); mèc chÝnh lµ sè (mèc phô lµ ch÷)

(progn

(setq tenmocASCII (+ (ascii tenmocPhu) 1))

(while (or (= (strcase (chr tenmocASCII)) "I")(= (strcase (chr tenmocASCII)) "O")

(= (strcase (chr tenmocASCII)) "V")(= (strcase (chr tenmocASCII)) "X")

(= (strcase (chr tenmocASCII)) "J"))

(setq tenmocASCII (+ tenmocASCII 1))

);while

(setq tenmocPhu (chr tenmocASCII))

(setq tenmoc (strcat tenmocChinh tenmocPhu))

);progn

(progn; else mèc chÝnh lµ ch÷ (mèc phô lµ sè)

(setq tenmocPhu (itoa (+ (atoi tenmocPhu) 1)))

(setq tenmoc (strcat tenmocChinh tenmocPhu))

);progn

);if

)

);cond

(setvar "OSMODE" os)

);progn

(setq loop nil);else

);if

)

) ; end of cond

) ; end of while

(setvar "TEXTSTYLE" cst)

) ; end of program

(Defun C:TD()

(c:toado)

)

;******************************* Thèng kª *****************************************

(defun C:TK()

(command "UNDO" "G")

(setq tableStatus "")

(setq btk (ssget "X" '((2 . "BANGTHONGKE"))))

(if btk

(setq TableStatus "On Board")

(progn;else

(if (tblsearch "BLOCK" "BANGTHONGKE")

(setq TableStatus "Hiding Block")

(setq TableStatus "Doesn't Exist")

);if

);progn else

);if

(if (or (= TableStatus "Doesn't Exist") (= TableStatus "Hiding Block"))

(setq sp (getpoint "\nX¸c ®Þnh vÞ trÝ gãc trªn-tr¸i cña b¶ng: "))

(progn ;else (On Board)

(setq btk_name (ssname btk 0))

(setq btk_ent (entget btk_name))

(setq sp (cdr(assoc 10 btk_ent)))

);progn else

);if

(setq luuChu '() luuSo '())

(setq bang (ssget "X" '((2 . "BANGTOADO"))))

(if bang

(progn

(setq i 1 chu_i 1 so_i 1)

(repeat (sslength bang)

(setq b_i (ssname bang (- i 1)))

; doc doi tuong thuoc tinh SH

(setq bi_sh (entnext b_i))

(setq bi_sh_ent (entget bi_sh))

(setq sh (cdr(assoc 1 bi_sh_ent)))

; ®äc gi¸ trÞ toa ®é X

(setq bi_X (entnext bi_sh))

(setq bi_X_ent (entget bi_X))

(setq X (cdr(assoc 1 bi_X_ent)))

; ®äc gi¸ trÞ toa ®é Y

(setq bi_Y (entnext bi_X))

(setq bi_Y_ent (entget bi_Y))

(setq Y (cdr(assoc 1 bi_Y_ent)))

; cap nhat vao bang luu

(tachMoc sh)

(if (and (<= (ascii tenmocChinh) 57)(>= (ascii tenmocChinh) 48)); mèc chÝnh lµ sè

(progn

(setq luuSo (cons (list so_i sh X Y) luuSo))

(setq so_i (+ so_i 1))

);progn

(progn ; else mèc chÝnh lµ ch÷

(setq luuChu (cons (list chu_i sh X Y) luuChu))

(setq chu_i (+ chu_i 1))

)

);if

(setq i (+ i 1))

);repeat

; s¾p xÕp theo thø tù t¨ng dÇn cña sè hiÖu (SH) trong danh s¸ch luuChu

(setq i 1)

(while (<= i (- (length luuChu) 1))

(setq j (+ i 1))

(while (<= j (length luuChu))

(setq SH_tmpi (cadr (assoc i luuChu)))

(tachMoc SH_tmpi)

(setq SHi (ascii tenmocChinh))

(setq SH_tmpj (cadr (assoc j luuChu)))

(tachMoc SH_tmpj)

(setq SHj (ascii tenmocChinh))

(cond

((< SHj SHi); ch÷ sau cã m· ascii nhá h¬n sè tríc th× ®æi chç

(setq Xi (caddr (assoc i luuChu)))

(setq Yi (cadddr (assoc i luuChu)))

(setq Xj (caddr (assoc j luuChu)))

(setq Yj (cadddr (assoc j luuChu)))

(setq luuChu (subst (list i SH_tmpj Xj Yj) (assoc i luuChu) luuChu))

(setq luuChu (subst (list j SH_tmpi Xi Yi) (assoc j luuChu) luuChu))

)

((= SHj SHi); cïng tªn mèc - > kiÓm tra mèc phô

(tachMoc SH_tmpi)

(setq ChisoPhu_i tenmocPhu)

(tachMoc SH_tmpj)

(setq ChisoPhu_j tenmocPhu)

(if (< ChisoPhu_j ChisoPhu_i);sè sau nhá h¬n sè tríc th× ®æi chç

(progn

(setq Xi (caddr (assoc i luuChu)))

(setq Yi (cadddr (assoc i luuChu)))

(setq Xj (caddr (assoc j luuChu)))

(setq Yj (cadddr (assoc j luuChu)))

(setq luuChu (subst (list i SH_tmpj Xj Yj) (assoc i luuChu) luuChu))

(setq luuChu (subst (list j SH_tmpi Xi Yi) (assoc j luuChu) luuChu))

);progn

);if

)

);cond

(setq j (+ j 1))

);while j

(setq i (+ i 1))

);while i

; s¾p xÕp theo thø tù t¨ng dÇn cña sè hiÖu (SH) trong danh s¸ch luuSo

(setq i 1)

(while (<= i (- (length luuSo) 1))

(setq j (+ i 1))

(while (<= j (length luuSo))

(setq SH_tmpi (cadr (assoc i luuSo)))

(tachMoc SH_tmpi)

(setq SHi (atoi tenmocChinh))

(setq SH_tmpj (cadr (assoc j luuSo)))

(tachMoc SH_tmpj)

(setq SHj (atoi tenmocChinh))

(cond

((< SHj SHi); sè sau nhá h¬n sè tríc th× ®æi chç

(setq Xi (caddr (assoc i luuSo)))

(setq Yi (cadddr (assoc i luuSo)))

(setq Xj (caddr (assoc j luuSo)))

(setq Yj (cadddr (assoc j luuSo)))

(setq luuSo (subst (list i SH_tmpj Xj Yj) (assoc i luuSo) luuSo))

(setq luuSo (subst (list j SH_tmpi Xi Yi) (assoc j luuSo) luuSo))

)

((= SHj SHi); cïng tªn mèc - > kiÓm tra mèc phô

(tachMoc SH_tmpi)

(setq ChisoPhu_i (ascii tenmocPhu))

(tachMoc SH_tmpj)

(setq ChisoPhu_j (ascii tenmocPhu))

(if (< ChisoPhu_j ChisoPhu_i);ký tù sau cã m· ascii nhá h¬n sè tríc th× ®æi chç

(progn

(setq Xi (caddr (assoc i luuSo)))

(setq Yi (cadddr (assoc i luuSo)))

(setq Xj (caddr (assoc j luuSo)))

(setq Yj (cadddr (assoc j luuSo)))

(setq luuSo (subst (list i SH_tmpj Xj Yj) (assoc i luuSo) luuSo))

(setq luuSo (subst (list j SH_tmpi Xi Yi) (assoc j luuSo) luuSo))

);progn

);if

)

);cond

(setq j (+ j 1))

);while j

(setq i (+ i 1))

);while i

; bæ sung tiªu ®Ò vµo danh s¸ch

(setq luuChu (cons (list 0 "Mèc" "X" "Y") luuChu))

; KÎ b¶ng

(setq os (getvar "OSMODE"))

(setvar "OSMODE" 0)

(setq n (length luuChu) m (length luuSo))

(setq i 0 dem 0 test nil kc 15 objs (ssadd))

(repeat (+ n m)

(if (and (< dem n) (not test))

(setq luu luuChu test nil)

(progn

(setq luu luuSo)

(if (not test)

(setq test T dem 1)

);if

);progn

);if

; ghi so hieu

(setq start (list (car sp) (- (cadr sp) (* (getvar "TEXTSIZE") i 1.8))))

(command "TEXT" "M" start "" "" (cadr (assoc dem luu)))

(ssadd (entlast) objs)

; ghi X

(setq start (list (+ (car start) (/ kc 1.5)) (cadr start)))

(command "TEXT" "M" start "" "" (caddr (assoc dem luu)))

(ssadd (entlast) objs)

; ghi Y

(setq start (list (+ (car start) kc) (cadr start)))

(command "TEXT" "M" start "" "" (cadddr (assoc dem luu)))

(ssadd (entlast) objs)

; KÎ ®êng n»m ngang phÝa trªn

(command "LINE" (list (- (car sp) (/ kc 5)) (+ (cadr start) (* (getvar "TEXTSIZE") 0.9)))

"@35,0" "")

(ssadd (entlast) objs)

(setq i (+ i 1) dem (+ dem 1))

);repeat

;vex ddwowngf ker cuoois cungf

(command "LINE" (list (- (car sp) (/ kc 5)) (- (cadr start) (* (getvar "TEXTSIZE") 0.9)))

"@35,0" "")

(ssadd (entlast) objs)

;VÏ ®êng däc

(command "LINE" (list (- (car sp) (/ kc 5)) (+ (cadr sp) (* (getvar "TEXTSIZE") 0.9)))

(list (- (car sp) (/ kc 5)) (- (cadr start) (* (getvar "TEXTSIZE") 0.9))) "")

(ssadd (entlast) objs)

(command "LINE" (list (- (car sp) (/ kc 5) -35) (+ (cadr sp) (* (getvar "TEXTSIZE") 0.9)))

(list (- (car sp) (/ kc 5) -35) (- (cadr start) (* (getvar "TEXTSIZE") 0.9))) "")

(ssadd (entlast) objs)

(cond

((= TableStatus "On Board")

(COMMAND "BLOCK" "BANGTHONGKE" "Y" sp objs "")

)

((= TableStatus "Hiding Block")

(COMMAND "BLOCK" "BANGTHONGKE" "Y" sp objs "")

(command "INSERT" "BANGTHONGKE" sp "1" "1" "0")

)

((= TableStatus "Doesn't Exist")

(COMMAND "BLOCK" "BANGTHONGKE" sp objs "")

(command "INSERT" "BANGTHONGKE" sp "1" "1" "0")

)

);cond

(setvar "OSMODE" os)

);progn

);if

(command "UNDO" "E")

)

http://www.cadviet.com/upfiles/3/117742_cm_2.dwg

Download lisp

Filename: 229035_toado_td.lsp

Trang 121/330

121