Jump to content
InfoFile
Tác giả: Nguyen Hoanh
Bài viết gốc: 14217
Tên lệnh: 00
Lisp Bigfont Unicode

Bạn chọn font chữ trọng mục Font name là Romans, sau đó click vào ô Use big font, bạn sẽ thấy tên file vừa copy nằm trong mục Font style.

Filename: 14217_00.lsp
Tác giả: trinhhoanghieu090
Bài viết gốc: 332846
Tên lệnh: clt
Lisp nội suy cao độ thiết kế tim đường
(defun c:CLT (/         CAODO1 CAODO2 CAODO3 CHIEUCAO    D      D1
          D2     DH        DHZ       ITEM1  ITEM2     PT1    PT2    PT3
          STT    TDO1   TDO2   TEMP1  TEMP2     X1    X2     X3
          Y1     Y2        Y3       Z1      Z2     Z3    loop
         )
  (defun *error* (msg)
    (if    Olmode
      (setvar 'osmode Olmode)
    )
    (if    (not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nError: " msg))
    )
    (princ)
 ...
>>
(defun c:CLT (/         CAODO1 CAODO2 CAODO3 CHIEUCAO    D      D1
          D2     DH        DHZ       ITEM1  ITEM2     PT1    PT2    PT3
          STT    TDO1   TDO2   TEMP1  TEMP2     X1    X2     X3
          Y1     Y2        Y3       Z1      Z2     Z3    loop
         )
  (defun *error* (msg)
    (if    Olmode
      (setvar 'osmode Olmode)
    )
    (if    (not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )
  (prompt "Made by thanhduan2407, Edit By trinhhoanghieu090")

;  (or *chieucao* (setq *chieucao* 1))
;  (setq
;   chieucao (getreal (strcat "\nNh\U+1EADp chi\U+1EC1u cao Text <"
;                  (rtos *chieucao* 2 2)
;                  "> :"
;              )
;         )
;  )
;  (if (not chieucao)
;    (setq chieucao *chieucao*)
 ;   (setq *chieucao* chieucao)
;  )
  (setq Olmode (getvar "OSMODE"))
  (if (not sle)
    (setq sle 2)
  )
  (setq    sle0
     (getint
       (strcat
         "\nChon So Le Thap Phan <"
         (itoa sle)
         ">: "
       )
     )
  )
  (if sle0
    (progn
      (if (< sle0 0)
    (setq sle0 0)
      )
      (if (> sle0 10)
    (setq sle0 10)
      )
      (setq sle sle0)
    )
  )
  (if (and
        (setq tdo1 (getpoint "\nChon Diem Thap:"))
        (setq item1 (entsel "\nChon Text Diem Thap:"))
        (setq tdo2 (getpoint "\nChon Diem Cao:"))
        (setq item2 (entsel "\nChon Text Diem Cao:"))
      )
    (progn
      (progn

    (setq temp1 (entget (car item1)))
;    (setq Tdo1 (TD:Text-Base (car item1)))

    (setq Caodo1 (cdr (assoc 1 temp1))
          x1     (car Tdo1)
          y1     (cadr Tdo1)
    )
    (setq pt1 (list x1 y1))
    (setq z1 (atof Caodo1))

    (setq temp2 (entget (car item2)))
;    (setq Tdo2 (TD:Text-Base (car item2)))
    (setq Caodo2 (cdr (assoc 1 temp2))
          x2     (car Tdo2)
          y2     (cadr Tdo2)
    )
    (setq pt2 (list x2 y2))
    (setq z2 (atof Caodo2))
      )
      (setq loop T)
      (while loop
    (setq
      pt3 (getpoint
        "\nChon Vi Tri Can Noi Suy Cao Do:"
          )
    )
    (cond
      (T
       (if pt3
         (progn
;           (setvar "OSMODE" 512)
           (setq x3 (car pt3))
           (setq y3 (cadr pt3))
;           (setq d1 (distance pt1 pt3))
;           (setq d2 (distance pt2 pt3))
;           (setq d (+ d1 d2))
;           (setq dh (- z2 z1))
;           (setq dhz (* dh (/ d1 d)))
;           (setq z3 (+ z1 dhz))
           (setq d1 (distance pt1 pt2))
           (setq d2 (distance pt1 pt3))
           (setq dh (- z2 z1))
           (setq dhz (* dh (/ d2 d1)))
           (setq z3 (+ z1 dhz))


           (setq Caodo3 (rtos z3 2 sle))
;          (setq pt3 (getpoint pt3 "\nChon Diem Dat Cao Do:"))
           (setq pt3 (list (car pt3) (cadr pt3) z3))

           (entmake
                  (list    
                  (cons 0 "TEXT")
                  (cons 10 pt3)
                  (cons 1 Caodo3)
                  (assoc 8 temp1)
                  (assoc 7 temp1)
                  (assoc 40 temp1)
                  (assoc 50 temp1)
                    )
                    
           )
         )
         (setq loop nil)
       )
      )
    )

      )

    )
  )
  (setvar "OSMODE" Olmode)
  (princ)
)

Tặng bạn, mình đã làm cả cho trường hợp tổng quát nằm phía bên ngoài 2 đầu đoạn thẳng rồi đó (nhưng 3 điểm vẫn phải thẳng hàng thì nội suy mới đúng)


<<

Filename: 332846_clt.lsp
Tác giả: Nguyen Hoanh
Bài viết gốc: 14224
Tên lệnh: 00
Tịnh tiến đường cong để tiếp xúc với đường thẳng

Xin lỗi, tôi đã hơi máy móc trong suy nghĩ.

Với lisp trên, muốn cho đường cong tiếp xúc với đường thẳng bạn làm như sau:

1. Move đường cong đi 1 chút sao nó nằm trọn vẹn trong góc tạo bởi 2 đường thẳng (không giao với đường thẳng nào).
2. Vẽ 2 vector tịnh tiến bằng cách dùng 2 lần lệnh VTT với lần lượt 2 đường thẳng (sẽ tạo được 2 vector màu đỏ).
>>

Xin lỗi, tôi đã hơi máy móc trong suy nghĩ.

Với lisp trên, muốn cho đường cong tiếp xúc với đường thẳng bạn làm như sau:

1. Move đường cong đi 1 chút sao nó nằm trọn vẹn trong góc tạo bởi 2 đường thẳng (không giao với đường thẳng nào).
2. Vẽ 2 vector tịnh tiến bằng cách dùng 2 lần lệnh VTT với lần lượt 2 đường thẳng (sẽ tạo được 2 vector màu đỏ).
3. Tạo vector tịnh tiến bằng tổng 2 vector tịnh tiến vừa vẽ (vector màu vàng).
4. Move đường cong theo vector tịnh tiến tổng (vector màu vàng).

Đây là hình vẽ:
http://www.cadviet.com/upfiles/vectotinhtien.gif
<<

Filename: 14224_00.lsp
Tác giả: San_Mocmoc
Bài viết gốc: 333679
Tên lệnh: pdm chuyencot
Lisp phun điểm mia

Nhờ các anh chi em sưa giúp lisp phun diem mia. Mình muốn bỏ phần cao độ Z đi

;CHUONG TRINH PHUN DIEM MIA X,Y,Z
;CAC DIEM TRAM MAY CO CODE=1 SE DUOC NOI LAI VOI NHAU
;-------------DINH DANG MAU----------------------
;TENDIEM   X      Y    Z    CODE
;KV1         0      0    0    1
;KV2       10      0    0    1
;1       5      10    0
;2       10  ...
>>

Nhờ các anh chi em sưa giúp lisp phun diem mia. Mình muốn bỏ phần cao độ Z đi

;CHUONG TRINH PHUN DIEM MIA X,Y,Z
;CAC DIEM TRAM MAY CO CODE=1 SE DUOC NOI LAI VOI NHAU
;-------------DINH DANG MAU----------------------
;TENDIEM   X      Y    Z    CODE
;KV1         0      0    0    1
;KV2       10      0    0    1
;1       5      10    0
;2       10      6    0
;KV3       10      10    0    1
(defun c:pdm (/ ms PR FN thunhat tentram caodotram xtram ytram
        htram tentrammay tendh
        )
  (bdau)
  (setq tam ())
  (setq i 0)
 ;  (setq ms 1000)
  (setq
    FN (getfiled "NhËp file nguån : "
         ""
         ""
         4
       )
  )
 (SETQ MS (GETREAL "Nhap vao mau so ty le ban do : "))
(setq ms (* ms 2))
  (progn
    (command "-osnap" "")
    (setvar "cmdecho" 0)
    (setvar "luprec" 8)
    (setvar "pdmode" 0)          
    (command "-layer" "m" "diem" "c" "red" "" "")
    (command "-layer" "m" "caodo" "c" "cyan" "" "")
    (command "-layer" "m" "sothutu" "c" "magenta" "" "")
    (command "-layer" "m" "khongche" "c" "red" "" "")
    (setq st (/ ms 1000))
    (setq st1 st)
    (command "-style" "diemmia" "txt.shx" st1 "1" "0" "n" "n" "n")
    (setq FN (open FN "r"))
    (while (and (setq PR (read-line FN)) (/= PR ""))
      (progn
        (setq PR (strcat "(" PR ")"))
        (setq PR (read PR))
        (thuchien)
    (if (= (nth 4 PR) 1);neu code= 1 thi ve
    (ve)
        )
      )                    ;end progn
    )                    ;end while
  );end progn
  (close FN)
  (command "zoom" "e")
  (kthuc)
  (princ)
)
(defun thuchien (/ TEN )
  (setq ten (convtostr (nth 0 PR)));chuyen tu symbol sang string
  (setq td (list (nth 2 PR) (nth 1 PR) (nth 3 PR)))
  (setq tam (append tam td));dua toa do diem thu n vao trong list tam
  (command "-layer" "s" "diem" "")
  (command "point" td)
  (command "-style" "diemmia" "txt.shx" st1  "1" "0" "n" "n" "n")
  (command "-layer" "s" "sothutu" "")
  (command "text" td "" ten)
  (command "-style" "diemmia" "txt.shx" st1 "1" "0" "n" "n" "n")
  (command "-layer" "s" "caodo" "")
  (command "text" "tl" td "" (rtos (nth 3 PR) 2 1))
)
(defun ve ()
  (setq diemcuoi td)
  (if (/= i 0)
    (progn
      (command "line" diemdau diemcuoi "")
    )
  )
  (setq diemdau diemcuoi)
  (setq i (+ i 1))
)
;CHUONG TRINH CHUYEN HAI COT X VA Y CHO NHAU
;---------DINH DANG MAU----------
;TEN       X      Y     Z    CODE
;KV1    100.00    50.00    1.5    1
;KV2    200.00    31.00    2.1
(defun c:chuyencot(/ FN FD i ch PR TEN X Y Z CODE TD XUAT)
  (setq
    FN (getfiled "NhËp file nguån : "
         ""
         ""
         4
       )
  )
  (setq i (strlen FN))
  (setq ch "")
     (while (/= ch "\\")
       (setq ch (substr FN i 1))
       (setq i (- i 1))
     )
     (setq xuat (substr FN 1  (+ i 1)))
  (setq FD (getstring "Nhap ten file ket qua : "))
  (setq FD (strcat xuat FD))
  (setq FD (open FD "w"))
  (setq FN (open FN "r"))
  (while (and (setq PR (read-line FN)) (/= PR ""))
      (progn
        (setq PR (strcat "(" PR ")"))
        (setq PR (read PR))
    (setq ten (dd (convtostr (nth 0 PR))))
        (setq x (dd (convtostr (nth 1 PR))))
    (setq y (dd (convtostr (nth 2 PR))))
    (setq z (dd (convtostr (nth 3 PR))))
    (setq code (nth 4 PR))
    (if (/= code nil)
      (setq td (strcat ten y x z (convtostr code)))
      (setq td (strcat ten y x z))
    )
    (write-line td FD)
      )                    ;end progn
    )                    ;end while
  (close FD)
  (close FN)
)

(defun bdau ()
  (command "_.undo" "begin")
  (setq cmd (getvar "cmdecho"))
  (setq plwid (getvar "plinewid"))
  (setq elev (getvar "elevation"))
  (setq thick (getvar "thickness"))
  (setq hh (getvar "osmode"))
  (setq clay (getvar "clayer"))
)
(defun kthuc ()
  (command "plinewid" plwid)
  (command "elevation" elev)
  (command "thickness" thick)
  (command "osmode" hh)
  (command "_.undo" "end")
  (command "clayer" clay)
  (command "cmdecho" cmd)
)
(defun ConvtoStr (Sym)
  (setq ftemp "temp.tmp")
  (setq ftmp (open ftemp "w"))
  (princ Sym ftmp)
  (close ftmp)
  (setq ftmp (open ftemp "r"))
  (setq sym (read-line ftmp))
  (close ftmp)
  (princ sym)
)
(defun *error*(msg)
       (princ "\nerror:")
       (princ msg)
(command "osmode" h "")
(command "_.undo" "end")
(command "clayer" clay)
(command "u" "")
(alert          "  - - - - ha ha ha- - - -
<Chaudaubac 0913.167111> ")
    (setq *error* olderr)
(princ)
)
(defun dd (nhap)
  (setq len (strlen nhap))
  (cond ((= len 1)(setq xuat (strcat nhap "        ")))
        ((= len 2)(setq xuat (strcat nhap "       ")))
        ((= len 3)(setq xuat (strcat nhap "      ")))
        ((= len 4)(setq xuat (strcat nhap "     ")))
        ((= len 5)(setq xuat (strcat nhap "    ")))
        ((= len 6)(setq xuat (strcat nhap "   ")))
        ((= len 7)(setq xuat (strcat nhap "  ")))
        ((= len 8)(setq xuat (strcat nhap " ")))
        ((= len 9)(setq xuat (strcat nhap "")))
  )
)
 
________________________________________________

File So Lieu

1    2339097.81    549068.55    1
2    2339127.18    549077.58    2
3    2339131.33    549078.35    3
4    2339135.72    549077.89    4
5    2339139.53    549076.32    5
6    2339142.77    549073.78    6
7    2339302.5    548908.23    7
8    2339294.43    548887.96    8
9    2339402.91    548767.01    9
10    2339273.21    548697.27    10
11    2339253.31    548705.86    11
12    2339231.99    548709.79    12
13    2339210.33    548708.84    13
14    2339175.48    548820.72    14
15    2339172.28    548830.99    15
16    2339114.96    549015.01    16
17    2339106.61    549041.66    17

http://www.cadviet.com/upfiles/4/139428_


<<

Filename: 333679_pdm_chuyencot.lsp
Tác giả: nhoclangbat
Bài viết gốc: 333832
Tên lệnh: kkl
[Yêu cầu] viết lisp vẽ Point có cao độ Z

- ý bạn phải vậy hem ^^

(defun c:kkl (/ te1 te2 pt *error* dxf1 dxf2)
;===================================================================
 (defun *error* ( msg )
        (if (not (member msg '("Function cancelled" "quit / exit abort")))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
;==================================================================
 (while (and (setq te1 (car (entsel "\nChon text 1"))) (setq te2(car...
>>

- ý bạn phải vậy hem ^^

(defun c:kkl (/ te1 te2 pt *error* dxf1 dxf2)
;===================================================================
 (defun *error* ( msg )
        (if (not (member msg '("Function cancelled" "quit / exit abort")))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
;==================================================================
 (while (and (setq te1 (car (entsel "\nChon text 1"))) (setq te2(car (entsel "\nChon text 2")))
(setq pt (getpoint "\nChon diem dat point :")))
;/////////////////////////////////
(setq dxf1 (cdr (assoc 1 (entget te1))) dxf2 (cdr (assoc 1 (entget te2))))
(setq caodo (- (* (distof dxf1) -1) (/ (distof dxf2) 10.0)))
(setq pt (subst caodo (last pt) pt))
(entmake (list
			(cons 0 	"POINT")
			(cons 100 	"AcDbPoint")
			(cons 10	pt)
			))
)
(princ)
)

<<

Filename: 333832_kkl.lsp
Tác giả: Tue_NV
Bài viết gốc: 52873
Tên lệnh: lte
Lisp vẽ 1 đường Line(có 2 đoạn) sau đó cho phép người dùng nhập ký tự vào 2 text1, text2

Đây bạn :
Điều kiện 2 : Chỉ cần Line2 song song với line là đủ rồi bạn ạ
Bạn nên rút kinh nghiệm khi post bài phải nói rõ ràng nhé :

Chúc thành công. :undecided:

Filename: 52873_lte.lsp
Tác giả: nhoclangbat
Bài viết gốc: 333957
Tên lệnh: cdx
Lisp điền cao độ bị lỗi!!!

- ngón này nhoc ko rành lắm, nhoc thử sữa lại theo ý bạn, bạn xem có đúng ko ^^, nhoc chỉ sợ lượt bớt nhiều quá làm sai kết quả ^^

(defun DXFcn (code elist) (cdr (assoc code elist)))
;============================================================
(prompt "\n - GHI CAO DO DIEM TREN TRAC NGANG by Thaistreetz - huuthais@yahoo.com\n")
;============================================================
(defun c:Cdx (/ DZ pt  ptside ang...
>>

- ngón này nhoc ko rành lắm, nhoc thử sữa lại theo ý bạn, bạn xem có đúng ko ^^, nhoc chỉ sợ lượt bớt nhiều quá làm sai kết quả ^^

(defun DXFcn (code elist) (cdr (assoc code elist)))
;============================================================
(prompt "\n - GHI CAO DO DIEM TREN TRAC NGANG by Thaistreetz - huuthais@yahoo.com\n")
;============================================================
(defun c:Cdx (/ DZ pt  ptside ang OT sc1 scale tx ty tx1 ty1 y H0) ; 
(command "Undo" "BEGIN")
(if (= tx nil) 
	(setq tx 1))
(if (= ty nil) 
	(setq ty 1))
	(setq 		  tx1 (getreal (strcat "\nTy le theo phuong X <1/"(rtos tx 2 2)">: 1/")) 
		  ty1 (getreal (strcat "\nTy le theo phuong Y <1/"(rtos ty 2 2)">: 1/"))
	)
(if tx1 (setq tx tx1))
(if ty1 (setq ty ty1))
(setq ATLAST (getvar "Attreq"))
(setq CMLAST (getvar "cmdecho"))
(setq OSLAST (getvar "OSMODE"))
(setq DZ (getvar "DIMZIN"))
(setq OT (getvar "ORTHOMODE"))
(setvar "ORTHOMODE" 0)
(setvar "cmdecho" 0)
(command "osmode" 99)
(setq pt0 (osnap (getpoint "Diem tim TN tu nhien") "end")) (print)
(setq x0 (car pt0) y0 (cadr pt0))
;(setvar 'osmode 0)
(setq ed (entget (car (entsel "\nChon cao do tim: "))))
(setq H0 (read (DXFcn 1 ed))) 
(While (and (setq pt (getpoint "\nChon diem chuan : ")) (setq doitt (car (entsel "\nChon text de chinh sua: "))))
(Progn
	(setq y (- (cadr pt) y0 (- H0)))
(cond 
	((> y 0) (entmod (subst (cons 1 (strcat "+" (rtos (* y ty) 2 2))) (assoc 1 (entget doitt)) (entget doitt))))
	((< y 0) (entmod (subst (cons 1 (rtos (* y ty) 2 2)) (assoc 1 (entget doitt)) (entget doitt)))) 
	((= y 0) (entmod (subst (cons 1 "%%p0.00") (assoc 1 (entget doitt)) (entget doitt))))
)

);progn
);while 
(setvar "OSMODE" OSLAST)(setvar "ORTHOMODE" OT)(setvar "cmdecho" CMLAST)
(prompt "\n by Thaistreetz - huuthais@yahoo.com\n")
(command "Undo" "End")
(princ)
);end

<<

Filename: 333957_cdx.lsp
Tác giả: quansla
Bài viết gốc: 334050
Tên lệnh: taodim
Tạo hàm Lisp từ các lệnh của cad

Chào anh em ! :)  :)
Mình đang gặp khó khăn trong việc sử dụng các hàm có sẵn của Cad để viết Lisp. :wacko:  :wacko:  :wacko:
Ví dụ như: 
- Tạo layer
   (command " layer " "m" "ten_layer" "c" "1" "w" "0.4" "" "")
- thay đổi thông số đơn vị bản vẽ
   (command "units" "2" "3" "2" "3" "" "")
 
Đoạn code như trên...

>>

Chào anh em ! :)  :)
Mình đang gặp khó khăn trong việc sử dụng các hàm có sẵn của Cad để viết Lisp. :wacko:  :wacko:  :wacko:
Ví dụ như: 
- Tạo layer
   (command " layer " "m" "ten_layer" "c" "1" "w" "0.4" "" "")
- thay đổi thông số đơn vị bản vẽ
   (command "units" "2" "3" "2" "3" "" "")
 
Đoạn code như trên mình muốn hiểu thì phải thử, tuy nhiên nếu mình muốn thiết lập nhiều thông số như trong cad thì phải code Lisp viết như thế nào? 
ví dụ như tạo dimstyle
mình sưu tập code thì thấy có đoạn như sau:
(command "dimtxt" 2) ; chiều cao text
(command "dimscale" 100) ; tỷ lệ
......
Vậy cho mình hỏi làm sao để mình biết các từ khoá "dimtxt" "dimscale"....để còn biết và viết code ạ
 
Trân thành cảm ơn anh em nhé :)  :)  :)  :)


Không ngưng học hỏi bạn ạ,tích luỹ dần dần rồi sẽ có thôi
C1/ Dành cho việc tự nghiên cứu, không dùng tài liệu, Chịu khó khi mở Cad, tìm hiểu các biến liên quan của Cad, ví dụ bạn có thể (với cad đời cao - ví dụ 2012 như máy mình) : mở hộp thoại Dimmentision Mânger di chuột lại gần một thiết lập nào đó, dừng chuột lại đó chờ cho trợ giúp của Cad hiện nên (rất nhanh, khoảng 1-1.5 s thôi) trong đó có thể sẽ có biến liên quan đến thông số đó mà bạn cần. ví dụ DimGap khi di chuột lại gần thông số khoảng cách TextDim và đường ghi kích thước.
C2/ Bạn hãy sử dụng lệnh "SYSVDLG" (hoặc menu Express Tool / System variable Editor...) để có thông số về toàn bộ biến của Cad, cùng các trợ giúp liên quan. Bạn có thể sửa giá trị của chúng lẻ lẻ ra ví dụ 1,321342342 sau đó suất ra tập tin svf(sau này cần đổi lại thành txt để đọc) để dễ tìm giá trị của chúng khi thay đổi, hoặc tinh ý tìm ra thay đổi của chúng trên bản vẽ.
C3/ Đọc Help của Cad, dò thông tin trên mạng. Hỏi trực tiếp khi gặp vướng mắc.


trên là cách mà mình tìm hiểu biến hệ thống của Cad ngày trước, khá hữu ích. Bạn muón sửa thông số Cad có thể sử dụng cách này.

Đương nhiên sẽ có nhiều thông số mà bạn không tìm được (không có, không dễ thấy) . bạn có thể tìm cách thiết lập chúng bằng nhiều cách khác. Chẳng hạn dùng lệnh (Scrip/ Líp/ VBA) thực hiện lệnh để làm thiết lập lần lượt như khi thực hiện thủ công



Tham khảo nha: Tạo dim style

(defun c:taodim()
(setvar "cmdecho" 0)
(command
"DIMBLK" "archtick" "DIMASZ" 1.2 "DIMCEN" 2
"DIMTIH" "off" "DIMTDEC" 2 "DIMZIN" 8
"DIMAZIN" 2 "DIMTOH" "off" "DIMTIH" "off"
"DIMDEC" 2 "DIMCLRT" 6 "DIMTIX" "on"
"DIMTXT" 2.5 "DIMTAD" 1 "DIMGAP" 0.5
"DIMCLRD" 8 "DIMLTYPE" "bylayer" "DIMLWD" -1
"DIMDLE" 1
;"DIMSCALE" 100
"DIMCLRE" 8 "DIMLTEX1" "bylayer"
"DIMLTEX2" "bylayer" "DIMEXE" 1 "DIMEXO" 0
"DIMLWE" -1 "DIMATFIT" 3 "DIMTMOVE" 0
"DIMTOFL" "on" "DIMDEC" 2 "DIMDSEP" "."
"DIMLUNIT" 2 "DIMLWD" -1 "DIMLWE" -1
"DIMJUST" 0 "DIMTAD" 1 "DIMTFILL" 0
)
(IF (NOT (TBLSEARCH "STYLE" "DIM"))
(command "-style"
"DIM"
"tahoma.TTF"
""
""
""
""
""
(while (> (getvar "cmdactive") 0) (command ""))
)
)
(COMMAND "DIMTXSTY" "DIM")
(if (not (tblsearch "DIMSTYLE" "xxxxx100"))
(Command ".dimstyle" "s" "xxxxx100")
)
(prompt "da tao xong dim xxxxx100 " )
(setvar "cmdecho" 1)
(princ)
)



hoặc ví dụ về tạo Text Style


(defun taotxt(name font txh )
(IF (NOT (TBLSEARCH "STYLE" name ))
(command "-style"
name
font
txh
"" "" "" ""
(while (> (getvar "cmdactive") 0)(command ""))
)
)
)
(defun c:taotxt()
(tblsearch "style" "t3")
(setvar "cmdecho" 0)
(taotxt "Dim" "vnromadi.shx" 0 )
(taotxt "Dim2" "tvsimli.shx" 0 )
(taotxt "T1" "vnromadi.shx" 0 )
(taotxt "T2" "VHHELS.TTF" 0 )
(taotxt "T3" "VHAVAN.TTF" 0 )
(princ "\nda tao xong cac text Style ")
(setvar "cmdecho" 1)
(princ)
)

<<

Filename: 334050_taodim.lsp
Tác giả: quansla
Bài viết gốc: 334050
Tên lệnh: taotxt
Tạo hàm Lisp từ các lệnh của cad

Chào anh em ! :)  :)
Mình đang gặp khó khăn trong việc sử dụng các hàm có sẵn của Cad để viết Lisp. :wacko:  :wacko:  :wacko:
Ví dụ như: 
- Tạo layer
   (command " layer " "m" "ten_layer" "c" "1" "w" "0.4" "" "")
- thay đổi thông số đơn vị bản vẽ
   (command "units" "2" "3" "2" "3" "" "")
 
Đoạn code như trên...

>>

Chào anh em ! :)  :)
Mình đang gặp khó khăn trong việc sử dụng các hàm có sẵn của Cad để viết Lisp. :wacko:  :wacko:  :wacko:
Ví dụ như: 
- Tạo layer
   (command " layer " "m" "ten_layer" "c" "1" "w" "0.4" "" "")
- thay đổi thông số đơn vị bản vẽ
   (command "units" "2" "3" "2" "3" "" "")
 
Đoạn code như trên mình muốn hiểu thì phải thử, tuy nhiên nếu mình muốn thiết lập nhiều thông số như trong cad thì phải code Lisp viết như thế nào? 
ví dụ như tạo dimstyle
mình sưu tập code thì thấy có đoạn như sau:
(command "dimtxt" 2) ; chiều cao text
(command "dimscale" 100) ; tỷ lệ
......
Vậy cho mình hỏi làm sao để mình biết các từ khoá "dimtxt" "dimscale"....để còn biết và viết code ạ
 
Trân thành cảm ơn anh em nhé :)  :)  :)  :)


Không ngưng học hỏi bạn ạ,tích luỹ dần dần rồi sẽ có thôi
C1/ Dành cho việc tự nghiên cứu, không dùng tài liệu, Chịu khó khi mở Cad, tìm hiểu các biến liên quan của Cad, ví dụ bạn có thể (với cad đời cao - ví dụ 2012 như máy mình) : mở hộp thoại Dimmentision Mânger di chuột lại gần một thiết lập nào đó, dừng chuột lại đó chờ cho trợ giúp của Cad hiện nên (rất nhanh, khoảng 1-1.5 s thôi) trong đó có thể sẽ có biến liên quan đến thông số đó mà bạn cần. ví dụ DimGap khi di chuột lại gần thông số khoảng cách TextDim và đường ghi kích thước.
C2/ Bạn hãy sử dụng lệnh "SYSVDLG" (hoặc menu Express Tool / System variable Editor...) để có thông số về toàn bộ biến của Cad, cùng các trợ giúp liên quan. Bạn có thể sửa giá trị của chúng lẻ lẻ ra ví dụ 1,321342342 sau đó suất ra tập tin svf(sau này cần đổi lại thành txt để đọc) để dễ tìm giá trị của chúng khi thay đổi, hoặc tinh ý tìm ra thay đổi của chúng trên bản vẽ.
C3/ Đọc Help của Cad, dò thông tin trên mạng. Hỏi trực tiếp khi gặp vướng mắc.


trên là cách mà mình tìm hiểu biến hệ thống của Cad ngày trước, khá hữu ích. Bạn muón sửa thông số Cad có thể sử dụng cách này.

Đương nhiên sẽ có nhiều thông số mà bạn không tìm được (không có, không dễ thấy) . bạn có thể tìm cách thiết lập chúng bằng nhiều cách khác. Chẳng hạn dùng lệnh (Scrip/ Líp/ VBA) thực hiện lệnh để làm thiết lập lần lượt như khi thực hiện thủ công



Tham khảo nha: Tạo dim style

(defun c:taodim()
(setvar "cmdecho" 0)
(command
"DIMBLK" "archtick" "DIMASZ" 1.2 "DIMCEN" 2
"DIMTIH" "off" "DIMTDEC" 2 "DIMZIN" 8
"DIMAZIN" 2 "DIMTOH" "off" "DIMTIH" "off"
"DIMDEC" 2 "DIMCLRT" 6 "DIMTIX" "on"
"DIMTXT" 2.5 "DIMTAD" 1 "DIMGAP" 0.5
"DIMCLRD" 8 "DIMLTYPE" "bylayer" "DIMLWD" -1
"DIMDLE" 1
;"DIMSCALE" 100
"DIMCLRE" 8 "DIMLTEX1" "bylayer"
"DIMLTEX2" "bylayer" "DIMEXE" 1 "DIMEXO" 0
"DIMLWE" -1 "DIMATFIT" 3 "DIMTMOVE" 0
"DIMTOFL" "on" "DIMDEC" 2 "DIMDSEP" "."
"DIMLUNIT" 2 "DIMLWD" -1 "DIMLWE" -1
"DIMJUST" 0 "DIMTAD" 1 "DIMTFILL" 0
)
(IF (NOT (TBLSEARCH "STYLE" "DIM"))
(command "-style"
"DIM"
"tahoma.TTF"
""
""
""
""
""
(while (> (getvar "cmdactive") 0) (command ""))
)
)
(COMMAND "DIMTXSTY" "DIM")
(if (not (tblsearch "DIMSTYLE" "xxxxx100"))
(Command ".dimstyle" "s" "xxxxx100")
)
(prompt "da tao xong dim xxxxx100 " )
(setvar "cmdecho" 1)
(princ)
)



hoặc ví dụ về tạo Text Style


(defun taotxt(name font txh )
(IF (NOT (TBLSEARCH "STYLE" name ))
(command "-style"
name
font
txh
"" "" "" ""
(while (> (getvar "cmdactive") 0)(command ""))
)
)
)
(defun c:taotxt()
(tblsearch "style" "t3")
(setvar "cmdecho" 0)
(taotxt "Dim" "vnromadi.shx" 0 )
(taotxt "Dim2" "tvsimli.shx" 0 )
(taotxt "T1" "vnromadi.shx" 0 )
(taotxt "T2" "VHHELS.TTF" 0 )
(taotxt "T3" "VHAVAN.TTF" 0 )
(princ "\nda tao xong cac text Style ")
(setvar "cmdecho" 1)
(princ)
)

<<

Filename: 334050_taotxt.lsp
Tác giả: nhoclangbat
Bài viết gốc: 334067
Tên lệnh: kko
Nhờ viết LISP xuất dữ liệu ra file excel

- hi mấy lsp dạng này trên 4rum mình nhiều lắm, tết rãnh nhoc luyện viết thử xem ^^


;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/119469-nho-viet-lisp-xuat-du-lieu-ra-file-excel/
(defun ss2ent (ss / i Le e) ;;;Convert ss to list of ename
(setq i 0)
(repeat (sslength ss)     
(setq e (ssname ss i)        
Le (append Le (list e))        
i (1+ i)...
>>

- hi mấy lsp dạng này trên 4rum mình nhiều lắm, tết rãnh nhoc luyện viết thử xem ^^


;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/119469-nho-viet-lisp-xuat-du-lieu-ra-file-excel/
(defun ss2ent (ss / i Le e) ;;;Convert ss to list of ename
(setq i 0)
(repeat (sslength ss)     
(setq e (ssname ss i)        
Le (append Le (list e))        
i (1+ i)    ))
Le)
;=================================================================================
(defun Length1(e) 
(vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
;=======================================================================
(defun c:kko (/ ss ds_ent ds_laydis layer dis info)
(prompt "Quet chon cac Multiline ")
(setq ss (ssget '( (0 . "MLINE"))))
(if ss 
	(progn 
		(setq ds_ent (ss2ent ss))
			(foreach k ds_ent
				(setq info (entget k))
				(setq layer (acet-dxf 8 info))
				(setq dis (add_mline info))
				(setq ds_laydis (append ds_laydis (list (list layer dis))))
			)
		)
)
(xls ds_laydis '("LAYER" "CHIEU DAI") nil "Thong ke")
;(princ ds_laydis)
(princ)
)
;==============================================================================================================================================
(vl-load-com)
(defun xls (Data-list	   header	  Colhide	 Name_list
	    /		   *aplexcel*	  *books-colection*
	    Currsep	   *excell-cells* *new-book*	 *sheet#1*
	    *sheet-collection*		  col		 iz_listo
	    row		   cell		  cols
	   )
  (defun Letter	(N / Res TMP)
    (setq Res "")
    (while (> N 0)
      (setq TMP	(rem N 26)
	    TMP	(if (zerop TMP)
		  (setq	N   (1- N)
			TMP 26
		  )
		  TMP
		)
	    Res	(strcat (chr (+ 64 TMP)) Res)
	    N	(/ N 26)
      )
    )
    Res
  )
  (if (null Name_list)
    (setq Name_list "")
  )
  (setq *AplExcel* (vlax-get-or-create-object "Excel.Application"))
  (if (setq *New-Book* (vlax-get-property *AplExcel* "ActiveWorkbook"))
    (setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
	  *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
	  *Sheet#1*	     (vlax-invoke-method *Sheet-Collection* "Add")
    )
    (setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
	  *New-Book*	     (vlax-invoke-method *Books-Colection* "Add")
	  *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
	  *Sheet#1*	     (vlax-get-property *Sheet-Collection* "Item" 1)
    )
  )
  (setq *excell-cells* (vlax-get-property *Sheet#1* "Cells"))
  (setq	Name_list (if (= Name_list "")
		    (vl-filename-base (getvar "DWGNAME"))
		    (strcat (vl-filename-base (getvar "DWGNAME"))
			    "&"
			    Name_list
		    )
		  )
	col	  0
	cols	  nil
  )
  (if (> (strlen Name_list) 26)
    (setq Name_list
	   (strcat (substr Name_list 1 10)
		   "..."
		   (substr Name_list (- (strlen Name_list) 13) 14)
	   )
    )
  )
  (vlax-for sh *Sheet-Collection*
    (setq cols (cons (strcase (vlax-get-property sh 'Name)) cols))
  )
  (setq row Name_list)
  (while (member (strcase row) cols)
    (setq row (strcat Name_list " (" (itoa (setq col (1+ col))) ")"))
  )
  (setq Name_list row)
  (vlax-put-property *Sheet#1* 'Name Name_list)
  (setq Currsep (vlax-get-property *AplExcel* "UseSystemSeparators"))
  (vlax-put-property
    *AplExcel*
    "UseSystemSeparators"
    :vlax-false
  ) ;_?? ???????????? ????????? ?????????
  (vlax-put-property *AplExcel* "DecimalSeparator" ".") ;_??????????? ??????? ? ????? ?????
  (vlax-put-property *AplExcel* "ThousandsSeparator" " ") ;_??????????? ???¤???
  (vla-put-visible *AplExcel* :vlax-true)
  (setq	row 1
	col 1
  )
  (if (null header)
    (setq header '("X" "Y" "Z"))
  )
  (repeat (length header)
    (vlax-put-property
      *excell-cells*
      "Item"
      row
      col
      (vl-princ-to-string (nth (1- col) header))
    )
    (setq col (1+ col))
  )
  (setq	row 2
	col 1
  )
  (repeat (length Data-list)
    (setq iz_listo (car Data-list))
    (repeat (length iz_listo)
      (vlax-put-property
	*excell-cells*
	"Item"
	row
	col
	(vl-princ-to-string (car iz_listo))
      )
      (setq iz_listo (cdr iz_listo)
	    col	     (1+ col)
      )
    )
    (setq Data-list (cdr Data-list))
    (setq col 1
	  row (1+ row)
    )
  )
  (setq	col (1+ (length header))
	row (1+ row)
  )
  (setq	cell (vlax-variant-value
	       (vlax-invoke-method
		 *Sheet#1*
		 "Evaluate"
		 (strcat "A1:" (letter col) (itoa row))
	       )
	     )
  ) ;_ end of setq
  (setq cols (vlax-get-property cell 'Columns))
  (vlax-invoke-method cols 'Autofit)
  (vlax-release-object cols)
  (vlax-release-object cell)
  (foreach item	ColHide
    (if	(numberp item)
      (setq item (letter item))
    )
    (setq cell (vlax-variant-value
		 (vlax-invoke-method
		   *Sheet#1*
		   "Evaluate"
		   (strcat item "1:" item "1")
		 )
	       )
    )
    (setq cols (vlax-get-property cell 'Columns))
    (vlax-put-property cols 'hidden 1)
    (vlax-release-object cols)
    (vlax-release-object cell)
  )
  (vlax-put-property *AplExcel* "UseSystemSeparators" Currsep)
  (mapcar 'vlax-release-object
	  (list	*excell-cells*	    *Sheet#1*
		*Sheet-Collection*  *New-Book*
		*Books-Colection*   *AplExcel*
	       )
  )
  (setq *AplExcel* nil)
  (gc)
  (gc)
  (princ)
)
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;http://www.cadviet.com/forum/topic/763-routine-tinh-tong-chieu-dai-cac-doi-tuong/
(defun add_mline ( elist / pt1 mline_len pt2 tot_len)
(setq tot_len 0.0)
  (foreach k	elist
    (cond ((= 10 (car k))
	   (setq pt1	   (cdr k)
		 mline_len 0.0
	   )
	  )
	  ((= 11 (car k))
	   (setq pt2	   (cdr k)
		 mline_len (+ mline_len (distance pt2 pt1))
		 pt1	   pt2
	   )
	  )
    )
  )
  (setq tot_len (+ tot_len mline_len))
 )

<<

Filename: 334067_kko.lsp
Tác giả: nhoclangbat
Bài viết gốc: 334134
Tên lệnh: kko
Nhờ viết LISP xuất dữ liệu ra file excel

- hi công nhận viết mấy lsp dạng xử lý danh sách nhức đầu thật, nhoc còn yếu khoảng này ^^, nhìn vô thì thêm có mấy dòng mà mất cả sáng mới nghĩ ra ^^, bạn test thử xem hen ^^

(defun ss2ent (ss / i Le e) ;;;Convert ss to list of ename
(setq i 0)
(repeat (sslength ss)     
(setq e (ssname ss i)        
Le (append Le (list e))        
i (1+ i)   ...
>>

- hi công nhận viết mấy lsp dạng xử lý danh sách nhức đầu thật, nhoc còn yếu khoảng này ^^, nhìn vô thì thêm có mấy dòng mà mất cả sáng mới nghĩ ra ^^, bạn test thử xem hen ^^

(defun ss2ent (ss / i Le e) ;;;Convert ss to list of ename
(setq i 0)
(repeat (sslength ss)     
(setq e (ssname ss i)        
Le (append Le (list e))        
i (1+ i)    ))
Le)
;=================================================================================
(defun Length1(e) 
(vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
;=======================================================================
(defun c:kko (/ ss ds_ent ds_laydis layer dis info ds_tk ten_layer sl ds_new ko ds_tkk k1 k2 k3 K_join_ds)
;============================
(defun K_join_ds ( lst1 lst2 / tam  i ds_moi)
(setq i 0)
(foreach m lst1
(setq tam (append (nth i lst2) (list m)))
(setq ds_moi (append ds_moi (list tam)))
(setq i (1+ i))
)
ds_moi)
;================================================
(prompt "Quet chon cac Multiline ")
(setq ss (ssget '( (0 . "MLINE"))))
(if ss 
	(progn 
		(setq ds_ent (ss2ent ss))
			(foreach k ds_ent
				(setq info (entget k))
				(setq layer (acet-dxf 8 info))
				(setq dis (add_mline info))
				(setq ds_laydis (append ds_laydis (list (list  layer dis))))
			)
		(setq ds_new (LM:_UniqueFuzz ds_laydis 0.00001))
		(setq sl (mapcar '(lambda (z) (apply '+ (mapcar '(lambda (j) (if (equal j z 0.00001) 1 0)) ds_laydis))) ds_new))
		(setq ds_tk (K_join_ds sl ds_new))
	  (foreach u ds_tk
	  (setq k1 (LM:InsertNth "\t" 1 u) k2 (LM:InsertNth "\t" 2 k1) k3 (LM:InsertNth "\t" 4 k2))
	  (setq ds_tkk (append ds_tkk (list k3)))
	  )
	)
)
(xls ds_tkk '("LAYER" "\t" "\t" "CHIEU DAI" "\t" "SO LUONG") nil "Thong ke")
(princ)
)
;============================================================================================================================
(defun LM:InsertNth ( x n l )
  (
    (lambda ( i )
      (apply 'append
        (mapcar '(lambda ( a ) (if (= n (setq i (1+ i))) (list x a) (list a))) l)
      )
    )
    -1
  )
)
;============================================================================================================================================
(defun LM:_UniqueFuzz ( l fz )
    (if l
      (cons (car l)
        (LM:_UniqueFuzz
          (vl-remove-if '(lambda ( x ) (equal x (car l)  fz)) (cdr l)) fz
        )
      )
    )
)
;==============================================================================================================================================
(vl-load-com)
(defun xls (Data-list	   header	  Colhide	 Name_list
	    /		   *aplexcel*	  *books-colection*
	    Currsep	   *excell-cells* *new-book*	 *sheet#1*
	    *sheet-collection*		  col		 iz_listo
	    row		   cell		  cols
	   )
  (defun Letter	(N / Res TMP)
    (setq Res "")
    (while (> N 0)
      (setq TMP	(rem N 26)
	    TMP	(if (zerop TMP)
		  (setq	N   (1- N)
			TMP 26
		  )
		  TMP
		)
	    Res	(strcat (chr (+ 64 TMP)) Res)
	    N	(/ N 26)
      )
    )
    Res
  )
  (if (null Name_list)
    (setq Name_list "")
  )
  (setq *AplExcel* (vlax-get-or-create-object "Excel.Application"))
  (if (setq *New-Book* (vlax-get-property *AplExcel* "ActiveWorkbook"))
    (setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
	  *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
	  *Sheet#1*	     (vlax-invoke-method *Sheet-Collection* "Add")
    )
    (setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
	  *New-Book*	     (vlax-invoke-method *Books-Colection* "Add")
	  *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
	  *Sheet#1*	     (vlax-get-property *Sheet-Collection* "Item" 1)
    )
  )
  (setq *excell-cells* (vlax-get-property *Sheet#1* "Cells"))
  (setq	Name_list (if (= Name_list "")
		    (vl-filename-base (getvar "DWGNAME"))
		    (strcat (vl-filename-base (getvar "DWGNAME"))
			    "&"
			    Name_list
		    )
		  )
	col	  0
	cols	  nil
  )
  (if (> (strlen Name_list) 26)
    (setq Name_list
	   (strcat (substr Name_list 1 10)
		   "..."
		   (substr Name_list (- (strlen Name_list) 13) 14)
	   )
    )
  )
  (vlax-for sh *Sheet-Collection*
    (setq cols (cons (strcase (vlax-get-property sh 'Name)) cols))
  )
  (setq row Name_list)
  (while (member (strcase row) cols)
    (setq row (strcat Name_list " (" (itoa (setq col (1+ col))) ")"))
  )
  (setq Name_list row)
  (vlax-put-property *Sheet#1* 'Name Name_list)
  (setq Currsep (vlax-get-property *AplExcel* "UseSystemSeparators"))
  (vlax-put-property
    *AplExcel*
    "UseSystemSeparators"
    :vlax-false
  ) ;_?? ???????????? ????????? ?????????
  (vlax-put-property *AplExcel* "DecimalSeparator" ".") ;_??????????? ??????? ? ????? ?????
  (vlax-put-property *AplExcel* "ThousandsSeparator" " ") ;_??????????? ???¤???
  (vla-put-visible *AplExcel* :vlax-true)
  (setq	row 1
	col 1
  )
  (if (null header)
    (setq header '("X" "Y" "Z"))
  )
  (repeat (length header)
    (vlax-put-property
      *excell-cells*
      "Item"
      row
      col
      (vl-princ-to-string (nth (1- col) header))
    )
    (setq col (1+ col))
  )
  (setq	row 2
	col 1
  )
  (repeat (length Data-list)
    (setq iz_listo (car Data-list))
    (repeat (length iz_listo)
      (vlax-put-property
	*excell-cells*
	"Item"
	row
	col
	(vl-princ-to-string (car iz_listo))
      )
      (setq iz_listo (cdr iz_listo)
	    col	     (1+ col)
      )
    )
    (setq Data-list (cdr Data-list))
    (setq col 1
	  row (1+ row)
    )
  )
  (setq	col (1+ (length header))
	row (1+ row)
  )
  (setq	cell (vlax-variant-value
	       (vlax-invoke-method
		 *Sheet#1*
		 "Evaluate"
		 (strcat "A1:" (letter col) (itoa row))
	       )
	     )
  ) ;_ end of setq
  (setq cols (vlax-get-property cell 'Columns))
  (vlax-invoke-method cols 'Autofit)
  (vlax-release-object cols)
  (vlax-release-object cell)
  (foreach item	ColHide
    (if	(numberp item)
      (setq item (letter item))
    )
    (setq cell (vlax-variant-value
		 (vlax-invoke-method
		   *Sheet#1*
		   "Evaluate"
		   (strcat item "1:" item "1")
		 )
	       )
    )
    (setq cols (vlax-get-property cell 'Columns))
    (vlax-put-property cols 'hidden 1)
    (vlax-release-object cols)
    (vlax-release-object cell)
  )
  (vlax-put-property *AplExcel* "UseSystemSeparators" Currsep)
  (mapcar 'vlax-release-object
	  (list	*excell-cells*	    *Sheet#1*
		*Sheet-Collection*  *New-Book*
		*Books-Colection*   *AplExcel*
	       )
  )
  (setq *AplExcel* nil)
  (gc)
  (gc)
  (princ)
)
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;http://www.cadviet.com/forum/topic/763-routine-tinh-tong-chieu-dai-cac-doi-tuong/
(defun add_mline ( elist / pt1 mline_len pt2 tot_len)
(setq tot_len 0.0)
  (foreach k	elist
    (cond ((= 10 (car k))
	   (setq pt1	   (cdr k)
		 mline_len 0.0
	   )
	  )
	  ((= 11 (car k))
	   (setq pt2	   (cdr k)
		 mline_len (+ mline_len (distance pt2 pt1))
		 pt1	   pt2
	   )
	  )
    )
  )
  (setq tot_len (+ tot_len mline_len))
 )


<<

Filename: 334134_kko.lsp
Tác giả: Nguyen Hoanh
Bài viết gốc: 334292
Tên lệnh: spa
Tăng tốc (làm nhẹ) AutoCAD
Nhiều người sử dụng AutoCAD phiên bản mới trên các máy có cấu hình không cao. Hệ quả là máy sẽ giật và chậm.

Trong bài viết ACAD đời mới chạy trên máy đời cũ
Đã hướng dẫn cách làm nhẹ phần mềm AutoCAD, tuy nhiên, mỗi lần làm lại phải rà soát nhiều tên biến.

Lisp dưới đây với...
>>
Nhiều người sử dụng AutoCAD phiên bản mới trên các máy có cấu hình không cao. Hệ quả là máy sẽ giật và chậm.

Trong bài viết ACAD đời mới chạy trên máy đời cũ
Đã hướng dẫn cách làm nhẹ phần mềm AutoCAD, tuy nhiên, mỗi lần làm lại phải rà soát nhiều tên biến.

Lisp dưới đây với mục đích làm nhẹ AutoCAD bằng cách thay đổi các biến hệ thống, và thực hiện các lệnh để giảm bớt một số tính năng về hiển thị và quản lý trong AutoCAD nhưng về cơ bản không hạn chế các tính năng liên quan đến công việc của AutoCAD.

Tên lệnh là SPA (Speed uP Autocad)


(defun c:spa ( / svl cml rgl old x)
(setq
svl '(
("DYNMODE" . 0)
("QPMODE" . 0)
("DRAWORDERCTL" . 0)
("HPDLGMODE" . 1)
("UCSDETECT" . 0)
("LAYERDLGMODE" . 0)
("ROLLOVERTIPS" . 0)
("SELECTIONCYCLING" . 0)
("LOCKUI" . 15)
("LAYERDLGMODE" . 0)
("HPQUICKPREVIEW" . 0)
("NAVVCUBEDISPLAY" . 0)
("NAVBARDISPLAY" . 0)
("INDEXCTL" . 3)
("GRIPOBJLIMIT" . 0)
("SIGWARN" . 0)
("PALETTEOPAQUE" . 1)
("SELECTIONAREA" . 0)
("MAXACTVP" . 5)
("LWDISPLAY" . 0)
("VTENABLE" . 0)
)

cml '(
(".IMAGEQUALITY" "DRAFT")
(".VIEWRES" "Y" "20")
)

rgl '(
("InfoCenter" "InfoCenterOn" 0)
)
)

(setq old (getvar "cmdecho"))
(setvar "cmdecho" 0)
(mapcar 'setvar (mapcar 'car svl) (mapcar 'cdr svl))
(foreach x cml (mapcar 'command x))
(foreach x rgl (vl-registry-write (strcat "HKEY_CURRENT_USER" (chr 92) (vlax-user-product-key) (chr 92) (nth 0 x)) (nth 1 x) (nth 2 x)))
(setvar "cmdecho" old)
(alert "\u+0110\u+00E3 ho\u+00E0n t\u+1EA5t thi\u+1EBFt l\u+1EADp \u+0111\u+1EC3 AutoCAD nh\u+1EB9 h\u+01A1n")
(princ)
)

<<

Filename: 334292_spa.lsp
Tác giả: thanhduan2407
Bài viết gốc: 333676
Tên lệnh: 00
BÀI TOÁN XỬ LÝ DANH SÁCH

Chào các anh/chị/em!

Em đang viết 1 chương trình tính diện tích hàng loạt dựa trên một thuật toán nhưng em đang vướng ở khâu xử lý danh sách.

Trong file đính kèm em mô tả và có hình vẽ chi tiết nên các bác xem có thể trợ giúp em được cách xử lý không ạ?

Em cảm ơn các bác nhiều!

Chào các anh/chị/em!

Em đang viết 1 chương trình tính diện tích hàng loạt dựa trên một thuật toán nhưng em đang vướng ở khâu xử lý danh sách.

Trong file đính kèm em mô tả và có hình vẽ chi tiết nên các bác xem có thể trợ giúp em được cách xử lý không ạ?

Em cảm ơn các bác nhiều!

http://www.cadviet.com/upfiles/4/36665_danh_sach_tao_vung_2.dwg

(defun C:00 (   / FLAT I ID ID+1 L1 L2 LTSREPNT_)
(setq i 0)
(setq l2 (list))
(setq LtsRePnt_ (list '(1 2 3) '(2 6 4 1) '(3 4 5 1) '(4 6 3 2) '(5 7 3) '(6 7 4 2) '(7 5 6)))
(while (< i (- (length LtsRePnt_) 1))
	(setq l1 (list))
  	(setq Flat nil)
  	(setq ID (car (nth i LtsRePnt_)))
  	(setq ID+1 (cadr (nth i LtsRePnt_)))  ;;(LM:sublst LtsRePnt_ 2 (- (length LtsRePnt_) 2))
  	(setq l1 (list ID ID+1))
  	(setq j 0)
  	(while (and (< j (- (length LtsRePnt_) 1)) (< ID ID+1) (>= j i))
	    (progn
	      (foreach Lts1 (LM:sublst LtsRePnt_ (- ID+1 1) (- (length LtsRePnt_) (- ID+1 1)))
		(if (equal (+ (GetVitribyItem ID+1 lts1) 1) (GetVitribyItem ID lts1) )
		    (progn
			(setq ID  ID+1)
		      	(setq ID+1 (mapcar '(lambda (x)(nth (+ (GetVitribyItem ID+1 x) 1)  x)) (LM:sublst LtsRePnt_ (- ID 1) (- (length LtsRePnt_) (- ID 1)))))
			(setq l1 (append (list ID) (list ID+1)))
		    )
		)
;;;	  	(if (not (equal (+ (GetVitribyItem ID+1 lts1) 1) (GetVitribyItem ID lts1) ))
;;;		    (progn
;;;			(setq ID  ID+1)
;;;			(setq ID+1  (nth (- (GetVitribyItem ID lts1) 1)  lts1))
;;;		      	(setq l1 (list ID ID+1))
;;;		    )
;;;		)
	       )
	      )
	      (setq Flat T)
	      (setq j (1+ j))
	 )
	  
	(setq l2 (append l2 (list l1)))
  	(setq i (1+ i))
)
(princ l2)
(textscr)
(princ)
)



;;;;TIM VI TRI TRONG DANH SACH
;;(GetVitribyItem "D" (list 2 3 4 "D" "R" "er"))
(defun GetVitribyItem (Item Ltstim / i )
(setq i 0)
(while (<= i (length Ltstim))
       (if (equal Item (nth i Ltstim))
	   (setq Vtri i)
       )
  	(setq i (1+ i))
)
  Vtri
)

;;;(LM:sublst '(1 2 3 4 5 6 7 8) 2 4)
;;;(LM:sublst '(1 2 3 4 5 6 7 8) 2 nil)
(defun LM:sublst ( lst idx len / rtn )
    (setq len (if len (min len (- (length lst) idx)) (- (length lst) idx))
          idx (+  idx len)
    )
    (repeat len (setq rtn (cons (nth (setq idx (1- idx)) lst) rtn)))
)



<<

Filename: 333676_00.lsp
Tác giả: thanhduan2407
Bài viết gốc: 334393
Tên lệnh: 99
BÀI TOÁN XỬ LÝ DANH SÁCH

với các biên là pline, arc, circle, elip, spline thì có tính được không vậy bạn?

Em mới viết với các đối tượng Line thôi bác ạ! Còn các đối tượng là đường cong thì em chưa viết! Chương trình viết mới dựa trên thuật toán tạo vùng TOPOLOGY của em.

>>

với các biên là pline, arc, circle, elip, spline thì có tính được không vậy bạn?

Em mới viết với các đối tượng Line thôi bác ạ! Còn các đối tượng là đường cong thì em chưa viết! Chương trình viết mới dựa trên thuật toán tạo vùng TOPOLOGY của em.

(vl-load-com)
(prompt (strcat "\nCh\U+01B0\U+01A1ng tr\U+00ECnh t\U+00EDnh di\U+1EC7n t\U+00EDch h\U+00E0ng lo\U+1EA1t"
		"\nL\U+1EC7nh: TOPOLOGY"
		"\nNg\U+01B0\U+1EDDi vi\U+1EBFt: Nguy\U+1EC5n Th\U+00E0nh Du\U+00E2n"
		"\nEmail: heaven2407@gmail.com"
		"\nMobile: 0972.0168.25"
	)
)
;;;(Alert (strcat "\nCh\U+01B0\U+01A1ng tr\U+00ECnh t\U+00EDnh di\U+1EC7n t\U+00EDch h\U+00E0ng lo\U+1EA1t"
;;;		"\nL\U+1EC7nh: TOPOLOGY"
;;;		"\nNg\U+01B0\U+1EDDi vi\U+1EBFt: Nguy\U+1EC5n Th\U+00E0nh Du\U+00E2n"
;;;		"\nEmail: heaven2407@gmail.com"
;;;		"\nMobile: 0972.0168.25"
;;;	)
;;;)
(defun c:99 ( /  LTSAREA LTSGETAREA LTSIDLINE LTSIDPNT LTSLINE LTSPNT LTSPV_ID X S1 S2);;;;TOPOLOGY
(setvar "CMDECHO" 0)
 ;;;;;LAM VIEC VOI POINT
(setq LtsLine (acet-ss-to-list (ssget (list (cons 0 "LINE")))))
  (or *Caochu* (setq *Caochu* 0.2))
  (setq	Caochu
	 (getreal
	   (strcat
	     "\nNh\U+1EADp chi\U+1EC1u cao Text ghi di\U+1EC7n t\U+00EDch <"
	     (rtos *Caochu* 2 2)
	     ">: "
	   )
	 )
  )
  (if (not Caochu)
    (setq Caochu *Caochu*)
    (setq *Caochu* Caochu)
  )
(setq s1 ((lambda (sec) (+ (* 86400 (- sec (fix sec))) 60)) (getvar "DATE")))
 ;;;;;CONVERT, FILTER AND SORT XY
(setq LtsPnt (SortAB (CVLine2Pnt LtsLine)))
 ;;;;GET ID POINT
(setq LtsIDPnt (GetIDPnt LtsPnt))
;;;(mapcar '(lambda(x) (wtxt (rtos (car x) 2 0) (cadr x) 15.0 0 "L" 2)) LtsIDPnt)
 ;;;;DANH SO HIEU VA LOC CANH TRUNG
(setq LtsIDLine (SortAB (GetIDLine LtsLine LtsIDPnt)))
;;; ;;;  ;;;;;LAP QUAN HE GIUA CAC DIEM DUA VAO GOC PHUONG VI
(setq LtsPV_ID (RelationPntIDbyGPV LtsIDPnt LtsIDLine ))
 ;;;;;;  ;;;;;;;;;;;;;;;;TAO VUNG;;;;;;;;;;;;;;;;;;;;;;;;;
(setq LtsArea  (GetAreabyID  LtsPV_ID))
 ;;; ;;;	;;;;;;TINH DIEN TICH VA TOA DO TAM VUNG
(setq LtsGetArea (mapcar '(lambda(x) (GetArea_TamVung x LtsIDPnt)) LtsArea))
(mapcar '(lambda(x) (wtxt (rtos (car x) 2 3) (cadr x) 10 0 "C" 4)) LtsGetArea)
(setq s2 ((lambda (sec) (+ (* 86400 (- sec (fix sec))) 60)) (getvar "DATE")))
(prompt (strcat   "Thoi gian thuc hien chuong trinh la: " (rtos (- s2 s1) 2 3) " giay"))
(princ)
)
  ;;;(RemovePnt (list '(1 3) '(2 3) '(3 5) '(4 8) '(5 6) '(6 34)  '(7 334) '(8 76))  (list '(1 2) '(1 5) '(2 3) '(3 2) '(3 5) '(3 7)))
(defun RemovePnt ( l1 l2  /  I ID ID1 L1A  )
(setq l1a l1)
(foreach v l2
	(setq i 0)
  	(setq ID1 (car v))
	(while (< i  (length l1))
	       (setq ID (car (nth i l1)))
	       (if  (equal ID ID1)
		    (setq l1 (vl-remove (nth i l1) l1))
	       )
	(setq i (1+ i))
	)
)
(setq LtsFilterIDPnt (LM:ListDifference l1a l1))
LtsFilterIDPnt
)


;;;;CONVERT LINE TO POINT AND FILTER 
(defun CVLine2Pnt (LtsLine / L1 P1 P2 )
(setq l1 (list))
(foreach e LtsLine
  	(setq P1 (cdr (assoc 10 (entget e))))
  	(setq P2 (cdr (assoc 11 (entget e))))
  	(setq l1 (append l1 (list P1) (list P2)))
)
(setq LtsPnt1 (TD:FilterDeldup l1 0.000001 ))
LtsPnt1
)
;;;;;;;;;;;LOC DIEM TRUNG;;;;;;;;;;;;;;
(defun TD:FilterDeldup (l fz )
  (if l
    (cons (car l)
	  (TD:FilterDeldup  (vl-remove-if '(lambda (x) (equal x (car l) fz )) (cdr l)) fz)
    )
  )
)


;;;;;;;;;;SAP XEP THEO X , NEU X BANG NHAU THI SAP XEP THEO Y;;;;
(defun SortAB (lstPnt /)
  (setq  Lts-Sort (vl-sort (vl-sort lstPnt '(lambda (e1 e2) (< (cadr e1) (cadr e2)))) '(lambda (e1 e2)(< (car e1) (car e2)))))
  Lts-Sort
)
(defun SortX (lstPnt /)
  (setq  Lts-Sort (vl-sort lstPnt  '(lambda (e1 e2)(< (car e1) (car e2)))))
  Lts-Sort
)

(defun SortXT (lstPnt /)
  (setq  Lts-Sort (vl-sort lstPnt  '(lambda (e1 e2)(< (car e1) (car e2)))))
  Lts-Sort
)

(defun SortYT (lstPnt /)
  (setq  Lts-Sort (vl-sort lstPnt  '(lambda (e1 e2)(< (cadr e1) (cadr e2)))))
  Lts-Sort
)

;;;;DANH SO HIEU CHO POINT
(defun GetIDPnt (ss_list / I ID_PNT  )
  (setq i 0)
  (setq LtsIDpnt (list))
  (while (< i (length ss_list))
    (progn
      (setq ID_Pnt (list))
      (setq ID_Pnt (list (+ i 1) (nth i ss_list)))
      (setq LtsIDpnt (append LtsIDpnt (list ID_Pnt)))
    )
    (setq i (1+ i))
  )
  LtsIDpnt
)



;;;;;;;GAN SO HIEU CHO LINE, LOC CANH TRUNG VA SAP XEP
(defun GetIDLine (LtsLine LtsIDPoint / ID1 ID2 L1 L2 L3 P1 P2 X )
(setq l2 (list))
(setq l3 (list))
(foreach e LtsLine
  	(setq l1 (list))
	(setq P1 (cdr (assoc 10 (entget e))))
	(setq P2 (cdr (assoc 11 (entget e))))
  	(setq ID1 (last (vl-remove nil (mapcar '(lambda(x) (if (equal P1 (cadr x) 0.01) (car x) nil)) LtsIDPoint))))
  	(setq ID2 (last (vl-remove nil (mapcar '(lambda(x) (if (equal P2 (cadr x) 0.01) (car x) nil)) LtsIDPoint))))
  	(setq l1 (list ID1 ID2))
  	(setq l2 (list ID2 ID1))
	(setq l3 (append l3 (list l1) (list l2)))
)
(setq LtsIDLine (Remove_SHLineOne (TD:FilterDeldup l3 0.0000001)))
LtsIDLine
)

 ;;;;XOA DANH SACH LINE THEO SO HIEU ID1 VA ID2 ;;;;;;
 ;;;(Remove_LineID 2 3 (setq l (list '(1 2) '(1 5) '(2 3) '(3 2) '(3 5))))
(defun Remove_LineID (ID1 ID2 l1 / )
(vl-remove nil (mapcar '(lambda(x)(if (or (and (equal ID1 (car x)) (equal ID2 (cadr x)))
					  (and (equal ID1 (cadr x)) (equal ID2 (car x)))
				       )
				       nil x)) l1)
)
)


 ;;;;;;;XOA DANH SACH LINE THEO SO HIEU ID DAU TIEN ;;;;;;VD:
 ;;;;;(Remove_SHLineOne  (list '(1 2) '(1 5) '(2 3) '(3 2) '(3 5) '(3 7)))
(defun Remove_SHLineOne (l / ID1 ID2 IDLINE L1 V X)
(foreach v l
	(setq l1 (vl-remove nil (mapcar '(lambda(x) (if (= (car x) (car v)) x nil)) l)))
	(if (= (length l1) 1)
	    (progn
		(setq IDLine (last l1))
	      	(setq ID1 (car IDLine))
	        (setq ID2 (cadr IDLine))
		(setq l (Remove_LineID ID1 ID2 l))
	    )
	)
)
l
)

;;;;;;;;;;;;;;;;;;DOI RADIAN SANG DO;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun Rad2Deg (radian / Do)
  (setq Do (/ (* radian 180.0) pi))
)

;;;;;;;;;;;;;;;;;;;;;;RADIAN SANG DO PHUT GIAY ;;;;;;;;;;;;;;;;;;
(defun R2DPG (gocR / DO GIAY PHUT PHUT1 TOANDO)
  (setq DPG (list))
  (setq Toando (Rad2Deg gocR))
  (setq Do (fix Toando))
  (setq Phut1 (* (- Toando Do) 60.0))
  (setq Phut (fix Phut1))
  (setq Giay (atof (rtos (* (- phut1 phut) 60.0) 2 3)))
  (setq DPG (list Do Phut giay))
  DPG
)
(defun D2DPG (Toando / DO GIAY PHUT PHUT1 )
  (setq DPG (list))
  (setq Do (fix Toando))
  (setq Phut1 (* (- Toando Do) 60.0))
  (setq Phut (fix Phut1))
  (setq Giay (atof (rtos (* (- phut1 phut) 60.0) 2 3)))
  (setq DPG (list Do Phut giay))
  DPG
)

;;;;;;;LAP MOI QUAN HE GIUA CAC DIEM THEO GOC PHUONG VI
;;(setq LtsPV_ID (RelationPntIDbyGPV LtsIDPnt LtsIDLine ))
(defun RelationPntIDbyGPV (LtsIDPnt LtsIDLine  / ID ID1 ID2 L1 L2 L2A L2B LTSIDLINE2 LTSIDPOINT1 P1 P2 PV12 X )
(setq LtsIDPoint1 (RemovePnt LtsIDPnt LtsIDLine))
(setq LtsRePnt (list))
(foreach e1 LtsIDPoint1
  	(setq l2a (list))
	(setq ID (car e1))
  	(setq LtsIDLine2 (vl-remove nil (mapcar '(lambda(x) (if (= (car x) ID) x nil)) LtsIDLine)))
  	(foreach  e2 LtsIDLine2
	  (setq l1 (list))
  	  (setq ID1 (car e2))
	  (setq  P1 (GetPntbyID ID1 LtsIDPoint1 ))
	  (setq ID2 (cadr e2))
	  (setq  P2 (GetPntbyID ID2 LtsIDPoint1 ))
	  (setq PV12 (TinhPV P1 P2))
	  (setq l1 (list PV12 ID1 ID2))
	  (setq l2a (append l2a (list l1)))
	  (setq l2b (vl-sort l2a '(lambda (x1 x2) (< (car x1) (car x2)))))
         )
  	  (setq l2 (append (list ID) (mapcar '(lambda(x) (caddr x)) l2b)))
  	  (setq LtsRePnt (append LtsRePnt (list l2)))
)
  LtsRePnt
)

  ;;;;GET POINT BY ID;;;;;;;
(defun GetPntbyID (ID LtsIDPoint2 /  )
(setq PntbyID (last (vl-remove nil (mapcar '(lambda(x) (if (equal ID (car x)) (cadr x) nil)) LtsIDPoint2))))
  PntbyID
)


(defun TinhPV (P1 P2 /  )
  (setq GocPV (rem (- 450.0 (* (angle p1 p2) (/ 1 pi) 180.0)) 360.0))
  GocPV
)


(defun GhepList ( l / l1 ID1 ID2)
(setq l1 (list))
(setq l2 (list))
(setq ID1 (car l))
(setq i 0)
(while (< i (- (length l) 1))
       (setq ID2 (nth (+ i 1) l))
       (setq l1 (list ID1 ID2))
       (setq l2 (append l2 (list l1)))
(setq i (1+ i))
)
l2
)


(defun GetAreabyID ( LtsRePnt_  /  1-VT FLAG ID ID+1 ID+N L1 L2 L3 L6 PTDT V1 VT)
(setq l3 (list))
(setq l4 (list))
(foreach v2  LtsRePnt_
	(setq v1 (GhepList v2))
  	(setq l1 (list))
  	(setq l2 (list))
	(foreach v v1
		(if (and (not (member v l6)) (< (car v) (cadr v)))
			(progn
			  	(setq ID (car v)
				      PTDT (car v)
				    ID+1 (cadr v)
				    Flag T
				    l1 (list ID ID+1)
				)
				(while Flag
				        (setq ID+n (assoc ID+1 LtsRePnt_)   
						vt (vl-position ID ID+n)
					      1-vt (nth (1- vt) ID+n)
				        )
				  	(if (/= ID+1 PTDT)
				        	(if  (/= 1-vt ID+1)
					            (setq l1 (append l1 (list (nth (1- vt) ID+n)))
							 ID ID+1
							 ID+1 (nth (1- vt) ID+n)
							  l6 (append l6  (list (list ID ID+1)))
					            )
						    (if (= 1-vt ID+1)
							(setq l1 (append l1 (list (nth (- (length ID+n) 1) ID+n)))
							      ID ID+1
							      ID+1 (nth (- (length ID+n) 1) ID+n)
							       l6 (append l6  (list (list ID ID+1)))
						        )
						    )
						 )
					     (setq Flag nil)
					  )
				  	  
				)
			  	
	  			(setq l2 (append l2 (list l1)))
	  		)
		  )
	)
  	(setq l3 (append l3 l2))
)
(setq l4 (cdr (SortLength (TD:LoaiVung1 l3))))
l4
)




(defun TD:LoaiVungtrung (l fz)
  (if l
    (cons (car l)
	  (TD:LoaiVungtrung  (vl-remove-if '(lambda (x) (equal (Sort1PT x) (Sort1PT (car l)) fz ) ) (cdr l)) fz)
    )
  )
)

(defun FilterArea ( LtsVung  /  I ID1 ID1A  )
(setq DsArea (TD:LoaiVungtrung LtsVung 0.0001))
(foreach v DsArea
	(setq i 0)
	(while (< i (- (length v) 2))
	       (setq ID1 (nth i v))
	       (setq ID1a (nth (+ i 2) v))
	       (if (equal ID1 ID1a)
		   (setq DsArea (vl-remove v DsArea))
	       )
	(setq i (1+ i))
	)
)
DsArea
)

(defun PV_LineEnd ( Vung LtsIDPnt /   Id_c Id_gc P1 P2 )
(setq Id_c (nth (- (length Vung) 1) Vung))
(setq Id_gc (nth (- (length Vung) 2) Vung))
(setq  P1 (GetPntbyID Id_c LtsIDPnt ))
(setq  P2 (GetPntbyID Id_gc LtsIDPnt ))
(setq PVLineEnd (TinhPV P2 P1))
PVLineEnd
)



;;;(Tachlist (list 4 7 11 12 15 16 13 14 10 8 6 5 3 2 1 4))
;;;====>>>> ((4 7) (7 11) (11 12) (12 15) (15 16) (16 13) (13 14) (14 10) (10 8) (8 6) (6 5) (5 3) (3 2) (2 1) (1 4))

(defun Tachlist ( l / l1 ID1 ID2)
(setq l1 (list))
(setq l2 (list))
(setq i 0)
(while (< i (- (length l) 1))
       (setq ID1 (nth i l))
       (setq ID2 (nth (+ i 1) l))
       (setq l1 (list ID1 ID2))
       (setq l2 (append l2 (list l1)))
(setq i (1+ i))
)
l2
)



(defun Sort1PT (lstPnt /)
  (setq  Lts-Sort1 (vl-sort lstPnt '(lambda (e1 e2) (< e1  e2))))
  Lts-Sort1
)
(defun SortLength (lstPnt /)
  (setq  Lts-Sort1 (vl-sort lstPnt '(lambda (e1 e2) (> (length e1)  (length e2)))))
  Lts-Sort1
)

;;;;;;(LM:ListDifference '(1 2 3 4 5) '(2 4 6 7 8 8 9 888 999 999 9 7 5)  )
(defun LM:ListDifference ( l1 l2 )
  (if l1
    (if (member (car l1) l2)
      (LM:ListDifference (cdr l1) l2)
      (cons (car l1) (LM:ListDifference (cdr l1) l2))
    )
  )
)

;;HAM LAY RA CAC PHAN TU GIONG NHAU TU 2 DANH SACH  
;;;;(TD:ListSemilar '(2 4 6 45 67 76) '(1 2 ) )
(defun TD:ListSemilar ( l1 l2 )
  (if l1
    (if (not (member (car l1) l2))
        (TD:ListSemilar (cdr l1) l2)
        (cons (car l1) (TD:ListSemilar (cdr l1) l2))
    )
  )
)

(defun TD:LoaiVung1 (l / )
  (if l
    (cons (car l)
	  (TD:LoaiVung1  (vl-remove-if '(lambda (x) (TD:ListSemilar (Tachlist x) (Tachlist (car l)) ) ) (cdr l)))
    )
  )
)


(defun GetAreabyLtsID ( LtsID LtsIDPnt / DT1 DT2 I L1 L2 LTSIDPNT LTSPNT P1 P2 PTT X)
(setq l1 (mapcar '(lambda(x) (GetPntbyID x LtsIDPnt)) LtsID))
(setq LtsPnt (append l1 (list (car l1))))
(setq i 0)
(setq DT2 (list))
(setq Dtich 0)
(while (< i (- (length LtsPnt) 1))
  	(setq DT1 (list))
  	(setq P1 (nth i LtsPnt))
  	(setq P2 (nth (+ i 1) LtsPnt))
        (setq DT1 (list (/ (* (+ (cadr P1) (cadr P2)) (- (car P2) (car P1))) 2)))
  	(setq DT2 (append DT2  DT1))
        (setq i (1+ i))
)
(setq Dtich (abs (apply '+ DT2)))
Dtich
)

(defun GetArea_TamVung ( LtsID LtsIDPnt / DT1 I L1 LTSIDPNT LTSXTB LTSYTB P1 P2 X XTB YTB )
(setq Dtich (GetAreabyLtsID  LtsID LtsIDPnt ))
(setq l1 (mapcar '(lambda(x) (GetPntbyID x LtsIDPnt)) LtsID))
(setq Xmin (caar (SortXT l1)))
(setq Xmax (car (last (SortXT l1))))
(setq Ymin (cadar (SortYT l1)))
(setq Ymax (cadr (last (SortYT l1))))
(setq Xtb (/ (+ Xmin Xmax) 2))
(setq Ytb (/ (+ Ymin Ymax) 2))
(setq DT_TV (list Dtich (list Xtb  Ytb  )))
DT_TV
)



(defun wtxt (string Point Height Ang justify Color / Lst)
 (setq Lst (list '(0 . "TEXT")
   (cons 10 point)
   (cons 40 Height)
   (cons 1 string)
   (cons 62 Color)		 
   (if Ang (cons 50 Ang))
   (cons 7 (if Style Style (getvar "Textstyle"))))
  justify (strcase justify))
 (cond ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))
       		((= justify "L") (setq Lst (append Lst (list (cons 72 0)(cons 73 0) (cons 10 point)))))
        	((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))
        	((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))
        	((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))))
        	((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))))
        	((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))))   
        	((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))))
        	((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))))
        	((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))))
        	((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))))
        	((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))))
        	((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1))))))
 (entmake Lst)
)

File Test

http://www.cadviet.com/upfiles/4/36665_test.dwg


<<

Filename: 334393_99.lsp
Tác giả: pphung183
Bài viết gốc: 334456
Tên lệnh: chtd
Lisp gán DIMSTYLE và TEXTSTYLE

Chào cách bác ! Năm mới e khai xuân câu hỏi mới nhờ các bác chỉ giúp

Bản vẽ của em có nhiều dimstyle và textstyle, em muốn nhờ các bác viết hộ lisp khi chọn đối tượng là : Dim hoặc text thì có thể gán dimstyle và textstyle

Thanks các bác  :)

Thử xem có phải thế này không...

>>

Chào cách bác ! Năm mới e khai xuân câu hỏi mới nhờ các bác chỉ giúp

Bản vẽ của em có nhiều dimstyle và textstyle, em muốn nhờ các bác viết hộ lisp khi chọn đối tượng là : Dim hoặc text thì có thể gán dimstyle và textstyle

Thanks các bác  :)

Thử xem có phải thế này không :)

(defun c:chtd (/ sset tst dst len i entg et ed)
(princ "\nChon Text hoặc Dim can thay doi Style :")
(setq sset (ssget '((0 . "*TEXT,DIMENSION")))) 
(setq tst (getstring t "\nNhap loai Textstyle :") 
dst (getstring t "\nNhap loai Dimstyle :"))
(if sset (progn (setq len (sslength sset) i 0)
(repeat len (setq entg (entget (ssname sset i)) i (1+ i)) 
(IF (wcmatch (cdr (assoc 0 entg)) "*TEXT") (progn
(setq et (subst (cons 7 tst) (assoc 7 entg) entg)) (entmod et)	)) 
(IF (wcmatch (cdr (assoc 0 entg)) "DIMENSION") (progn
(setq ed (subst (cons 3 dst) (assoc 3 entg) entg)) (entmod ed)	))))) 
(princ))


<<

Filename: 334456_chtd.lsp
Tác giả: nguyendbk48
Bài viết gốc: 279453
Tên lệnh: gin
Lisp copy nhiều text theo nhiều phương khác nhau
Copy các text cao độ màu hồng (nằm trên các đường thẳng b ) từ vị trí 1 sang vị thí 2 theo:
1. Khoảng cách a người dùng tự nhập
2. Hướng là từ điểm đầu đến điểm cuối đường thẳng b
Và chuyển các text cao độ mới về cùng 1 layer (để tiện lọc đối tượng)

Filename: 279453_gin.lsp
Tác giả: lontraubabanh
Bài viết gốc: 280000
Tên lệnh: gcddm
Đưa bình đồ dạng đường đồng mức về bình đồ dạng cao độ

Hề hề hề,

1/- Lỗi codebox của diễn đàn, mình không biết cách sửa.

2/- Bạn đã làm đúng. Tuy nhiên đây là code cũ chưa chỉnh sửa. Bởi vậy bạn nên làm tương tự với code mới và test với bản vẽ phù hợp.

3/- Lisp đã chạy hoàn tất chứ không hề mắc mứu chi. Tuy nhiên nó chả ra cái gì...

>>

Hề hề hề,

1/- Lỗi codebox của diễn đàn, mình không biết cách sửa.

2/- Bạn đã làm đúng. Tuy nhiên đây là code cũ chưa chỉnh sửa. Bởi vậy bạn nên làm tương tự với code mới và test với bản vẽ phù hợp.

3/- Lisp đã chạy hoàn tất chứ không hề mắc mứu chi. Tuy nhiên nó chả ra cái gì vì có thể bạn đã sử dụng bản vẽ để test chưa phù hợp với lisp.

hãy lưu ý các điểm sau đây khi sử dụng lisp này:

1/- Đường dẫn phải là một LWpolyline (vẽ bằng lệnh pline) và phải cắt lần lượt các đường đồng mức theo một chiều lên hay xuống và chỉ cắt mỗi đường đồng mức tại một điểm duy nhất. Do vậy người dùng phải vẽ đường dẫn này cho phù hợp chứ không thể vẽ tùy tiện.

2/- Các đường đồng mức trên bản vẽ phải cùng một màu số 30. (màu này là do mình viết dựa trên bản vẽ của chủ thớt gửi, người dùng khác có thể thay đổi lại trong code cho phù hợp với bản vẽ sử dụng)

3/- Do sử dụng lệnh measure nên độ dài của đường đồng mức phải lớn hơn 200 là khoảng cách giữa các điểm chia trên đường đồng mức. Nếu không sẽ có lỗi. Điều này đã được khắc phục trong code mới chỉnh sửa trong bài post #14 của topic này.

4/- Khi sử dụng lsp phải chắc chắn trên bản vẽ đã có block thuộc tính mang tên CD1 có cấu trúc giống như block mẫu mình đã post trong bài #14 nói trên.

5/- Nếu lười tạo block thuộc tính cd1 có thể sử dụng code bên dưới đây với lưu ý bổ sung là các đường đồng mức phải nằm trên một trong 3 layer sau: 1, 2, 5.

 

(defun c:gcddm ( / pl plst ssdml cdmax chcd i els ssp cdt p0 ssp0)
(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 ) )
(if (not (tblsearch "block" "cd1"))
    (atbmk "cd1")
)
 
(setq ssdml (acet-ss-to-list (ssget "f" plst (list (cons 0 "lwpolyline") (cons 62 30) (cons 8 "1,2,5")))))
 
(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)
         (setq p0 (vlax-curve-getpointatdist dm 200))
         (if p0
             (progn
                   (command "measure" dm   200)
                   (setq ssp0 (ssget "p"))
                   (setq ssp (acet-ss-to-list ssp0))         
                   (foreach pt ssp
                        (command "insert" "cd1" (cdr (assoc 10 (entget pt))) 1 1 0 (rtos cdt 2 0) )
                   )
              )
              (command "insert" "cd1" (vlax-curve-getstartpoint dm) 1 1 0 (rtos cdt 2 0) )
         )
         (setq i (1+ i)  )
)
(command "erase" pl "")
(command "undo" "e")
(setvar "osmode" oldos)
(princ)
)
 
;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun atbmk ( bln / )
;;;(setq bln (getstring "\n Nhap ten block: "))
(if (not (tblsearch "block" bln))
(progn
       (command "attdef" "" (getstring "\n Nhap att tag: ") (getstring T "\n Nhap dong nhac: ") 
                                     (getstring "\n Nhap gia tri mac dinh: ")  "J" "mc" (setq p0 (getpoint "\n Nhap diem chuan")) 0 )
       (command "scale" (entlast) "" p0 50)
       (command "block" bln p0 (entlast) "")
)
)
)
       

 

 

Hề hề hề,

1/- Lỗi codebox của diễn đàn, mình không biết cách sửa.

2/- Bạn đã làm đúng. Tuy nhiên đây là code cũ chưa chỉnh sửa. Bởi vậy bạn nên làm tương tự với code mới và test với bản vẽ phù hợp.

3/- Lisp đã chạy hoàn tất chứ không hề mắc mứu chi. Tuy nhiên nó chả ra cái gì vì có thể bạn đã sử dụng bản vẽ để test chưa phù hợp với lisp.

hãy lưu ý các điểm sau đây khi sử dụng lisp này:

1/- Đường dẫn phải là một LWpolyline (vẽ bằng lệnh pline) và phải cắt lần lượt các đường đồng mức theo một chiều lên hay xuống và chỉ cắt mỗi đường đồng mức tại một điểm duy nhất. Do vậy người dùng phải vẽ đường dẫn này cho phù hợp chứ không thể vẽ tùy tiện.

2/- Các đường đồng mức trên bản vẽ phải cùng một màu số 30. (màu này là do mình viết dựa trên bản vẽ của chủ thớt gửi, người dùng khác có thể thay đổi lại trong code cho phù hợp với bản vẽ sử dụng)

3/- Do sử dụng lệnh measure nên độ dài của đường đồng mức phải lớn hơn 200 là khoảng cách giữa các điểm chia trên đường đồng mức. Nếu không sẽ có lỗi. Điều này đã được khắc phục trong code mới chỉnh sửa trong bài post #14 của topic này.

4/- Khi sử dụng lsp phải chắc chắn trên bản vẽ đã có block thuộc tính mang tên CD1 có cấu trúc giống như block mẫu mình đã post trong bài #14 nói trên.

5/- Nếu lười tạo block thuộc tính cd1 có thể sử dụng code bên dưới đây với lưu ý bổ sung là các đường đồng mức phải nằm trên một trong 3 layer sau: 1, 2, 5.

 

(defun c:gcddm ( / pl plst ssdml cdmax chcd i els ssp cdt p0 ssp0)
(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 ) )
(if (not (tblsearch "block" "cd1"))
    (atbmk "cd1")
)
 
(setq ssdml (acet-ss-to-list (ssget "f" plst (list (cons 0 "lwpolyline") (cons 62 30) (cons 8 "1,2,5")))))
 
(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)
         (setq p0 (vlax-curve-getpointatdist dm 200))
         (if p0
             (progn
                   (command "measure" dm   200)
                   (setq ssp0 (ssget "p"))
                   (setq ssp (acet-ss-to-list ssp0))         
                   (foreach pt ssp
                        (command "insert" "cd1" (cdr (assoc 10 (entget pt))) 1 1 0 (rtos cdt 2 0) )
                   )
              )
              (command "insert" "cd1" (vlax-curve-getstartpoint dm) 1 1 0 (rtos cdt 2 0) )
         )
         (setq i (1+ i)  )
)
(command "erase" pl "")
(command "undo" "e")
(setvar "osmode" oldos)
(princ)
)
 
;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun atbmk ( bln / )
;;;(setq bln (getstring "\n Nhap ten block: "))
(if (not (tblsearch "block" bln))
(progn
       (command "attdef" "" (getstring "\n Nhap att tag: ") (getstring T "\n Nhap dong nhac: ") 
                                     (getstring "\n Nhap gia tri mac dinh: ")  "J" "mc" (setq p0 (getpoint "\n Nhap diem chuan")) 0 )
       (command "scale" (entlast) "" p0 50)
       (command "block" bln p0 (entlast) "")
)
)
)
       

Chào bạn.

Mình đã làm y chang như bạn nói chỉ có một điều: đến phút trót đường polyline biến mất và các đường đồng mức vẫn ko có cao độ.

bạn có thể xád định lỗi đó dùm mình ko?

Tks


<<

Filename: 280000_gcddm.lsp
Tác giả: Tot77
Bài viết gốc: 335549
Tên lệnh: kn
Xin lips cắt chân dim cách 1 đường thẳng giá trị cố định.

 Bạn thử cái này. Chỉ dùng với dimlinear và đuong giới hạn là line.

(defun c:kn(/ CAOC G1 G2 LI SS TT10 TT13 TT14 TT9)
(defun dxf(id v) (cdr (assoc id (entget v))))
(defun doi (id tri v) (entmod (subst (cons id tri) (assoc id (entget v)) (entget v)))) 
(defun dxf9(v / tt10 tt13 tt14 tt50 tt9)
 (setq tt10 (dxf 10 v)
tt13 (dxf 13 v)
tt14 (dxf 14 v)
tt50 (dxf 50 v) 
  tt9 (inters tt10 (polar tt10 tt50 1) tt13 (polar tt13...
>>

 Bạn thử cái này. Chỉ dùng với dimlinear và đuong giới hạn là line.

(defun c:kn(/ CAOC G1 G2 LI SS TT10 TT13 TT14 TT9)
(defun dxf(id v) (cdr (assoc id (entget v))))
(defun doi (id tri v) (entmod (subst (cons id tri) (assoc id (entget v)) (entget v)))) 
(defun dxf9(v / tt10 tt13 tt14 tt50 tt9)
 (setq tt10 (dxf 10 v)
tt13 (dxf 13 v)
tt14 (dxf 14 v)
tt50 (dxf 50 v) 
  tt9 (inters tt10 (polar tt10 tt50 1) tt13 (polar tt13 (angle tt14 tt10) 1) nil)     
 )
)
;;;
(princ "\n Chon Kich thuoc:")  (setq ss (ssget '((0 . "DIMENSION"))))
(princ "\n Chon Line:") (setq li (ssname (ssget ":S:E" '((0 . "LINE") )) 0))
(setq caoc (getreal (strcat "\n Cach khoang <" (if gl_caoc (rtos gl_caoc) (rtos (setq gl_caoc 0.02))) ">: ")))
(if caoc (setq gl_caoc caoc))
 
  (foreach obj (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
      (setq  tt13 (dxf 13 obj)
    tt14 (dxf 14 obj)
    tt10 (dxf 10 obj)
    tt9 (dxf9 obj)
g1 (inters (dxf 10 li) (dxf 11 li) tt10 tt14 nil)
g2 (inters (dxf 10 li) (dxf 11 li) tt9 tt13 nil)
)
   (if g1 (doi 14 (polar g1 (angle g1 tt10) gl_caoc) obj))
   (if g2 (doi 13 (polar g2 (angle g2 tt9) gl_caoc) obj))
  )
)

<<

Filename: 335549_kn.lsp
Tác giả: Tot77
Bài viết gốc: 335622
Tên lệnh: tes
[Yêu cầu] Vẽ đường thẳng nối 2 polyline

Có phải như vầy không?

(defun c:tes(/ D2 EL GD LEN SS V1 V2)
(defun ints (o1 o2 mo)
(defun get3(l) (if (cdddr l) (cons (list (car l) (cadr l) (caddr l)) (get3 (cdddr l))) (list l)))
 (get3 (vlax-Invoke (vlax-EName->vla-Object o1) "IntersectWith" (vlax-EName->vla-Object o2) mo))
)
;;;
(princ "\nChon 2 polyline:")
(setq ss (ssget '((0 . "LWPOLYLINE")))
len (getreal (strcat "\nChieu dai duong thang noi 2 pline <" (if gl_len...
>>

Có phải như vầy không?

(defun c:tes(/ D2 EL GD LEN SS V1 V2)
(defun ints (o1 o2 mo)
(defun get3(l) (if (cdddr l) (cons (list (car l) (cadr l) (caddr l)) (get3 (cdddr l))) (list l)))
 (get3 (vlax-Invoke (vlax-EName->vla-Object o1) "IntersectWith" (vlax-EName->vla-Object o2) mo))
)
;;;
(princ "\nChon 2 polyline:")
(setq ss (ssget '((0 . "LWPOLYLINE")))
len (getreal (strcat "\nChieu dai duong thang noi 2 pline <" (if gl_len (rtos gl_len) (rtos (setq gl_len 1))) ">:"))) 
(if len (setq gl_len len))
 
(if (= 2 (sslength ss))
(setq v1 (ssname ss 0)
v2 (ssname ss 1)
d2 (cdr (assoc 10 (entget v2)))
))
(command ".offset" gl_len v1 d2 "" )
(setq el (entlast)
gd (ints el v2 acextendnone))
(if (car gd)
(foreach d gd
(entmake (list '(0 . "LINE") (cons 10 d) (cons 11 (vlax-curve-getclosestpointto v1 d))))))
(entdel el)
(princ)
)

<<

Filename: 335622_tes.lsp
Tác giả: namntq_wru70
Bài viết gốc: 335858
Tên lệnh: sth
Lisp thống kê cốt thép

Mình có 1 lisp thống kê cốt thép, lisp sử dụng để chỉnh sữa block thuộc tính trong file cad đính kèm.

Lisp sửa thép:

;----------------------------------------
; TT - Sua thep trong Bang thong ke thep
; Su dung file : tl.dcl
;----------------------------------------

(defun GetTLDV(Phi)
(cond ((= Phi 6) 0.222)
((= Phi 8) 0.395)
((= Phi 10) 0.617)
((= Phi 12) 0.888)
((= Phi 14) 1.21)
((= Phi 16) 1.58)
((=...

>>

Mình có 1 lisp thống kê cốt thép, lisp sử dụng để chỉnh sữa block thuộc tính trong file cad đính kèm.

Lisp sửa thép:

;----------------------------------------
; TT - Sua thep trong Bang thong ke thep
; Su dung file : tl.dcl
;----------------------------------------

(defun GetTLDV(Phi)
(cond ((= Phi 6) 0.222)
((= Phi 8) 0.395)
((= Phi 10) 0.617)
((= Phi 12) 0.888)
((= Phi 14) 1.21)
((= Phi 16) 1.58)
((= Phi 18) 2.0)
((= Phi 20) 2.47)
((= Phi 22) 2.98)
((= Phi 24) 3.551)
((= Phi 25) 3.85)
((= Phi 26) 4.17)
((= Phi 28) 4.83)
((= Phi 30) 5.55)
((= Phi 32) 6.31)
((= Phi 34) 7.13)
((= Phi 36) 7.99)
((= Phi 40) 9.89)
)
)

;------------------------------------------------------------------------
; ATTUPD - Update the attribute values of a selected block in steel table
;------------------------------------------------------------------------
(defun AttUpd(ENTITY_NAME / ENTITY_LIST ENTITY_TYPE CONTINUE VALUE TAG TLDV
Dai TongSL TongDai)

(setq ENTITY_LIST (entget ENTITY_NAME))
(setq ENTITY_TYPE (cdr (assoc 0 ENTITY_LIST)))

(setq CONTINUE "YES")

(if (equal ENTITY_TYPE "INSERT")
(while (and
(setq ENTITY_NAME (entnext ENTITY_NAME))
(equal CONTINUE "YES")
)
(setq ENTITY_LIST (entget ENTITY_NAME))
(setq ENTITY_TYPE (cdr (assoc 0 ENTITY_LIST)))

(cond ((equal ENTITY_TYPE "ATTRIB")
(setq VALUE (cdr (assoc 1 ENTITY_LIST)))
(setq TAG (cdr (assoc 2 ENTITY_LIST)))
(cond ((equal TAG "D_K") (setq TLDV (GetTLDV (atof VALUE))))
((equal TAG "D_T") (setq Dai (atof VALUE)))
((equal TAG "T_S") (setq TongSL (atof VALUE)))
((equal TAG "T_D")
(setq TongDai (/ (* Dai TongSL) 1000))
(setq ENTITY_LIST (subst (cons 1 (rtos TongDai 2 2)) (assoc 1 ENTITY_LIST) ENTITY_LIST))
(entmod ENTITY_LIST)
(entupd ENTITY_NAME)
)
((equal TAG "T_L")
(setq TongLuong (* TLDV TongDai))
(setq ENTITY_LIST (subst (cons 1 (rtos TongLuong 2 2)) (assoc 1 ENTITY_LIST) ENTITY_LIST))
(entmod ENTITY_LIST)
(entupd ENTITY_NAME)
)
)
)
((equal ENTITY_TYPE "SEQEND")
(setq CONTINUE "NO")
)
)
)
)
)

(defun c:STH(/ Pick TextEntity Point Entity First_Entity Entity_Type
EList CText)
(defun _DCL ()
(setq _CText (get_tile "text_kt"))
(done_dialog)
); End of _DCL

(setq oldblp (getvar "BLIPMODE")
oldech (getvar "CMDECHO")
)
(setvar "BLIPMODE" 0)
(setvar "CMDECHO" 0)

(while (setq Pick (nentsel "\nChon Text trong Bang ke thep : "))
(setq TextEntity (car Pick)) ;Get the entity name
(setq Point (car (cdr Pick))) ;Get the selected point
(setq Entity (ssget Point)) ;Get the entity at selected point
(setq First_Entity (ssname Entity 0)) ;Get the first entity

(setq ELIST (entget TextEntity)) ;Get the database information
(setq ENTITY_TYPE (cdr (assoc 0 ELIST)))

(if (equal ENTITY_TYPE "ATTRIB")
(setq CText (cdr (assoc 1 EList)))
(setq CText "")
); End of if

(if (/= CText "")
(progn
(setq dcl_id (load_dialog "tl.DCL"))
(if (not (new_dialog "sua_text" dcl_id)) (exit))
(setq accept nil)
(set_tile "text_kt" CText)
(action_tile "accept" "(_DCL)")
(start_dialog)
(setq ELIST (subst (cons 1 _CText) (assoc 1 ELIST) ELIST))
(entmod ELIST)
(if (equal ENTITY_TYPE "ATTRIB")
(progn
(entupd TextEntity)
(AttUpd First_Entity)
)
)
(unload_dialog dcl_id)
)
)
); End of while

(setvar "BLIPMODE" oldblp)
(setvar "CMDECHO" oldech)

(redraw)
(prompt "\nProgram complete.")
(princ)

) ;End of C:STH

 

2015-03-13_110831.png

 

 

 

Mình muốn thêm công thức như sau: Tổng chiều dài các đoạn thép thành phần = chiều dài.

Ví dụ như ảnh trên thì: 50+350+14400+350+50=15200 (2 ô màu vàng)

Tức là khi mình chỉnh sữa các số 50, 350, 14400, 350, 50 thì số 15200 cũng nhảy theo.

Hy vọng được mọi người giúp đỡ. Cám ơn!!!

 

File lisp: http://www.cadviet.com/upfiles/4/96055_suathep.lsp

File cad: http://www.cadviet.com/upfiles/4/96055_bangtkt.dwg

File tl (giải nén file rar): http://www.cadviet.com/upfiles/4/96055_tl_1.rar


<<

Filename: 335858_sth.lsp

Trang 190/330

190