Jump to content
InfoFile
Tác giả: KangKung
Bài viết gốc: 230963
Tên lệnh: kk
cộng số khi dùng lệnh vd line, rectang

cho mình hỏi là mình có thể cộng các dữ liệu khi dùng lệnh line được ko

vd như 1 muốn vẽ 1 line gồm nhiều đoạn nhỏ a b c, mình có thể bấm LINE rồi tính tổng a+b+c ngay trên cad được ko hay phải tự tính nhẩm

Similar topics from web:
>>

cho mình hỏi là mình có thể cộng các dữ liệu khi dùng lệnh line được ko

vd như 1 muốn vẽ 1 line gồm nhiều đoạn nhỏ a b c, mình có thể bấm LINE rồi tính tổng a+b+c ngay trên cad được ko hay phải tự tính nhẩm

Bạn dùng Lisp này thử xem đã đúng với yêu cầu chưa. Lệnh KK nhé. Bạn vẽ đến đâu thì Lisp sẽ thông báo khoảng cách cộng dồn ở ngay dòng nhắc lệnh. Vẽ liên tục đến khi nào hết đường thì thôi, không hạn chế bao nhiêu đoạn.

(defun C:kk()
  (setq D 0 i 0)
  (setq pt1(list) pt2(list))
  (command "LINE")
  (while (> (getvar "CMDACTIVE") 0)
    (setq i(1+ i))
    (if (= i 1) (setq pt1(getvar "lastpoint")))
    (if (= i 2) (setq pt2(getvar "lastpoint")))
    (if (and (/= pt1 nil) (/= pt2 nil))
      (progn
	(setq D(+ D (distance pt1 pt2)))
	(princ (strcat "\n Tong khoang cach hien tai la: " (rtos D 2 3) "\n" "Specify next point or :"))
	)
      )
    (command pause)
    (setq pt1 pt2)
    (setq pt2(getvar "lastpoint"))
    )
  (princ)
  )
(princ "\n                Written By KangKung - 07/04/2013\n")
(princ "\n                  Nhap KK de chay chuong trinh\n")

<<

Filename: 230963_kk.lsp
Tác giả: various
Bài viết gốc: 217957
Tên lệnh: tt
[ Hỏi ] Lỗi trong lisp matchprop nội dung text
Chào mọi người. Chả là lúc trước mình có dùng tool speedcad. Có lisp ma text rất hay. Search thì được biết là do bác kietxu viết. Mình có down về nhưng ko hiểu sao dùng thì chỉ ma được text riêng lẻ, hoặc text trong block đã bị explode. Còn lại không thể ma text trong dim, trong block

Command tt , Chọn text bị thay thế :; error: bad DXF group: (1). Hoặc chọn text thay thế thì không có hiện tượng gì....
>>
Chào mọi người. Chả là lúc trước mình có dùng tool speedcad. Có lisp ma text rất hay. Search thì được biết là do bác kietxu viết. Mình có down về nhưng ko hiểu sao dùng thì chỉ ma được text riêng lẻ, hoặc text trong block đã bị explode. Còn lại không thể ma text trong dim, trong block

Command tt , Chọn text bị thay thế :; error: bad DXF group: (1). Hoặc chọn text thay thế thì không có hiện tượng gì. Các đối tượng chọn ko đổi thành nét đứt như khi select bình thường.


(defun c:tt (/ A B)
(if (setq A (nentsel "\nCh\U+1ECDn text ngu\U+1ED3n :"))
(progn
(setq A (cdr (assoc 1 (entget (car A)))))
(while (setq B (car (nentsel "\nCh\U+1ECDn text b\U+1ECB thay th\U+1EBF :")))
(entmod
(subst
(cons 1 A)
(assoc 1 (entget B))
(entget B)
) ;_ end of subst
) ;_ end of entmod
) ;_ end of while
) ;_ end of progn
) ;_ end of if
(princ)
) ;_ end of defun


Mong mọi người giải đáp. Mình vừa test trên 1 máy khác cũng bị hiện tượng như vậy. Tức là lisp chỉ hoạt động trên text đơn thuần.






<<

Filename: 217957_tt.lsp
Tác giả: vndesperados
Bài viết gốc: 30237
Tên lệnh: cal1
Chỉnh sửa lisp đã có ???

Máy mình không có CAD, mình sẽ hướng dẫn bạn cách chỉnh sữa lại như sau:
1. Tạo ra file CREALA như sau:
CREALA.LSP

Cũng không khó lắm nhỉ, chúc bạn thành công

Vì không có CAD nên mình chỉ có thể giúp được như vậy thôi

Filename: 30237_cal1.lsp
Tác giả: KangKung
Bài viết gốc: 231065
Tên lệnh: kk
[yêu cầu] LISP tìm & hiệu chỉnh nhóm TEXT

Lisp của bạn đây. Lisp này áp dụng cho trường hợp chiều cao chữ Input1 là 100 nhé. Nếu chữ thay đổi thì phải đổi lại code. Khi nhập số liệu thì nhập từng kí tự 1. Ví dụ SA9+2 thì nhập như sau: 

Input1: s

Input2: a

Input3: 9

Giá trị thay doi: 2

Lisp áp dụng cho nhiều trường hợp có trên bản vẽ của bạn mà không phải chia nhỏ ra trường hợp Input2 nil hoặc khác nil....

>>

Lisp của bạn đây. Lisp này áp dụng cho trường hợp chiều cao chữ Input1 là 100 nhé. Nếu chữ thay đổi thì phải đổi lại code. Khi nhập số liệu thì nhập từng kí tự 1. Ví dụ SA9+2 thì nhập như sau: 

Input1: s

Input2: a

Input3: 9

Giá trị thay doi: 2

Lisp áp dụng cho nhiều trường hợp có trên bản vẽ của bạn mà không phải chia nhỏ ra trường hợp Input2 nil hoặc khác nil. Nếu Input2 = nil thì chỉ việc Enter hoặc Space là được.

;=============KANGKUNG 08/04/2013==================
(DEFUN C:KK()
  (command "UNDO" "BE")
  (setq Input(strcase(getstring T "\n Input ")))
  (setq Input1(substr Input 1 1))
  (setq Input2(substr Input 2 1))
  (setq Input3(atoi(substr Input 3 1)))
  (setq gttd(atoi(substr Input 4 2)))
  (setq taphop(ssget "_X" (list (cons 0 "TEXT") (cons 40 100))) i 0)
  (while (< i (sslength taphop))
    (setq TEXT (entget (ssname taphop i)))
    (setq String(cdr(assoc 1 TEXT)))
    (if (= (strcase(cdr(assoc 1 TEXT))) Input1)
      (progn
	(setq pt(cdr (assoc 11 TEXT)))
	(command "ZOOM" "W" (list (- (car pt) 100) (+ (cadr pt) 150)) (list (+ (car pt) 200) (- (cadr pt) 150)))
	(if (ssget "W" (list (+ (car pt) 50) (+ (cadr pt) 90)) (list (+ (car pt) 130) (cadr pt)) '((0 . "TEXT")))
	  (setq text2(strcase(cdr(assoc 1 (entget (ssname (ssget "W" (list (+ (car pt) 50) (+ (cadr pt) 90)) (list (+ (car pt) 130) (cadr pt)) '((0 . "TEXT"))) 0))))))
	  (setq text2 " ")
	  )
	(if (ssget "W" (list (- (car pt) 100) (cadr pt)) (list (+ (car pt) 200) (- (cadr pt) 90)) '((0 . "TEXT")))
	  (setq text3(entget (ssname (ssget "W" (list (- (car pt) 100) (cadr pt)) (list (+ (car pt) 200) (- (cadr pt) 90)) '((0 . "TEXT"))) 0)))
	  (setq text3 "")
	  )
	(if (and (= text2 Input2) (>= (atoi (cdr (assoc 1 text3))) Input3))
	  (progn
	    (if (= (assoc 62 text3) nil)
	      (entmod (setq text3 (append text3 (list (cons 62 3)))))
	      (entmod (subst (cons 62 3) (assoc 62 text3) text3))
	      )
	    (entmod (subst (cons 1 (rtos (+ (atoi (cdr (assoc 1 text3))) gttd) 2 0)) (assoc 1 text3) text3))
	    )
	  )
	)
      )
    (setq i (+ i 1))
    )
  (command "REGEN")
  (command "UNDO" "END")
  (princ)
  (alert "Well Done")
  )
(princ "\n         Written By KangKung - 08/04/2013\n")
(princ "\n           Nhap KK de chay chuong trinh\n")

<<

Filename: 231065_kk.lsp
Tác giả: KangKung
Bài viết gốc: 231100
Tên lệnh: kk
[yêu cầu] Lisp chỉnh sửa độ dày nét hàng loạt
svarta timberland kängor http://www.joerglbauer.com/feld.asp?glb=svarta-timberland-kangor

Filename: 231100_kk.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 231120
Tên lệnh: updtxt
[yêu cầu] LISP tìm & hiệu chỉnh nhóm TEXT

Cám ơn anh rất nhiều! Có lẽ tôi đã đòi hỏi quá đáng - Với những gì anh đã giúp cho, phần còn lại tôi sẽ cố gắng để tự mình làm được! Chân thành cám ơn anh!

Hề hề hề,
Vậy là đã có khá nhiều đáp án cho bạn rồi. Mình chậm chân một chút và thấy rằng cái mình...
>>

Cám ơn anh rất nhiều! Có lẽ tôi đã đòi hỏi quá đáng - Với những gì anh đã giúp cho, phần còn lại tôi sẽ cố gắng để tự mình làm được! Chân thành cám ơn anh!

Hề hề hề,
Vậy là đã có khá nhiều đáp án cho bạn rồi. Mình chậm chân một chút và thấy rằng cái mình làm ra chưa đáp ứng đúng các yêu cầu bổ sung của bạn. Tuy nhiên vẫn có thể sử dụng nó với việc nhập dữ liệu chỉ bằng một chuỗi, sau đó dùng hàm substr kết hợp với hàm tách chuỗi để tách chuỗi này thành các biến t1 t2 t3 và k thậm chí có thể thêm biến giới hạn như bạn yêu cầu. Vì bạn là người cũng khá am tường về lisp nên mình không sửa nữa và post cái mình đã làm để bạn tham khảo thêm.

 
(defun c:updtxt ( / oldos t1 t2 t3 k sst p1 t4 t5 ss1 ss2 etxt )
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(command "undo" "be")
(while (= (setq t1 (strcase (getstring "\n Nhap gia tri text mau thu nhat: "))) ""))
(setq t2 (strcase (getstring "\n Nhap gia tri text mau thu hai: ")))
(while (or (= (setq t3 (getstring "\n Nhap gia tri text so mau thu ba: ")) "") (= (atoi t3) 0)) )
(setq k (getint "\n Nhap gia tri gia so: ") 
          sst (acet-ss-to-list (ssget (list (cons 0 "text") (cons 8 "ki_hieu") (cons 40 100.0) (cons 1 t1) (cons 72 1) (cons 73 2)))) )
(foreach txt sst
        (setq p1 (cdr (assoc 11 (entget txt))))
        (if (and  (/= t2 "") (setq ss1 (ssget "w" (list (- (car p1) 65) (- (cadr p1) 100)) (list (+ (car p1) 150) (+ (cadr p1) 100)) 
                                                 (list (cons 0 "text") (cons 8 "ki_hieu") (cons 40 50.0) (cons 72 1) (cons 73 2))))  )
            (setq t4 (cdr (assoc 1 (entget (ssname ss1 0)))))
        )
        (if (and (/= k nil) (= t2 t4) )
            (progn
                   (if (setq ss2 (ssget "w" (list (- (car p1) 65) (- (cadr p1) 100)) (list (+ (car p1) 150) (+ (cadr p1) 100)) 
                                                (list (cons 0 "text") (cons 8 "ki_hieu") (cons 40 50.0) (cons 72 2) (cons 73 2)))) 
                       (progn
                              (setq t5 (cdr (assoc 1 (setq etxt (entget (ssname ss2 0))))))
                              (if (>= (atoi t5) (atoi t3))
                                 (progn 
                                        (setq etxt (subst (cons 1 (itoa (+ (atoi t5) k))) (assoc 1 etxt) etxt))
                                        (if (assoc 62 etxt)
                                              (setq etxt (subst (cons 62 3) (assoc 62 etxt) etxt))
                                              (setq etxt (append (list (cons 62 3)) etxt))
                                        )
                                        (entmod etxt)
                                 )
                              )
                       )
                    )
             )
         )
         
         (if (and (= t2 "") (/= k nil) (not (setq ss1 (ssget "w" (list (- (car p1) 65) (- (cadr p1) 100))
                                                                    (list (+ (car p1) 150) (+ (cadr p1) 100)) 
                                                           (list (cons 0 "text") (cons 8 "ki_hieu") (cons 40 50.0) (cons 72 1) (cons 73 2)))))  )
              (progn 
                    (if (setq ss2 (ssget "w" (list (- (car p1) 65) (- (cadr p1) 100)) (list (+ (car p1) 150) (+ (cadr p1) 100)) 
                                                (list (cons 0 "text") (cons 8 "ki_hieu") (cons 40 50.0) (cons 72 2) (cons 73 2)))) 
                       (progn
                              (setq t5 (cdr (assoc 1 (setq etxt (entget (ssname ss2 0))))))
                              (if (>= (atoi t5) (atoi t3))
                                 (progn 
                                        (setq etxt (subst (cons 1 (itoa (+ (atoi t5) k))) (assoc 1 etxt) etxt))
                                        (if (assoc 62 etxt)
                                              (setq etxt (subst (cons 62 3) (assoc 62 etxt) etxt))
                                              (setq etxt (append (list (cons 62 3)) etxt))
                                        )
                                        (entmod etxt)
                                 )
                              )
                       )
                    )
             )
         )
 
         (setq t4 nil ss1 nil t5 nil ss2 nil)
)
(command "undo" "e")
(setvar "osmode" oldos)
(princ)
)

Chúc bạn vui.  

Và đây là lisp cải tiến lại lisp trên để có thể nhập dữ liệu đầu vào một lần theo ý bạn. Cấu trúc của chuỗi dữ liệu đầu vào như sau: @@##+#* #*
tức là chữ cái thứ nhất, chữ cái thứ hai,chữ số thứ nhất, chữ số thứ hai, dấu + hoặc trừ, các chử số chỉ giá trị gia số, khoảng trắng, các chữ số chỉ giá trị hạn chế trên.
Như vậy khi chữ cái thứ hai không cần dùng sẽ thay bằng ký tự "/". Nếu chữ số cần điều chỉnh chỉ có 1 chữ số thì phải thêm một chữ số 0 vào phía trước. Nếu không cần giá trị giới hạn trên thì chỉ cần nhập một khoảng trắng và không cần nhập thêm các chữ số nữa.
Bạn hãy dùng thử coi sao nhé.

(defun c:updtxt ( / oldos t1 t2 t3 k sst p1 t4 t5 ss1 ss2 etxt t0 t01 k1)
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(command "undo" "be")
(alert "\n Nhap chuoi text mau theo cu phap @@##+#* #*")
(setq t0 (getstring T "\n Nhap chuoi text mau: "))
(setq k1 (atoi (cadr (separate t0 " ")))
t01 (car (separate t0 " "))
k (atoi (substr t01 5))
t1 (strcase (substr t01 1 1))
t2 (strcase (substr t01 2 1))
t3 (substr t01 3 2)
;;;(while (= (setq t1 (strcase (getstring "\n Nhap gia tri text mau thu nhat: "))) ""))
;;;(setq t2 (strcase (getstring "\n Nhap gia tri text mau thu hai: ")))
;;;(while (or (= (setq t3 (getstring "\n Nhap gia tri text so mau thu ba: ")) "") (= (atoi t3) 0)) )
;;;(setq k (getint "\n Nhap gia tri gia so: ")
sst (acet-ss-to-list (ssget (list (cons 0 "text") (cons 8 "ki_hieu") (cons 40 100.0) (cons 1 t1) (cons 72 1) (cons 73 2)))) )
(if (= k1 0) (setq k1 10000))
(foreach txt sst
(setq p1 (cdr (assoc 11 (entget txt))))
(if (and (/= t2 "/") (setq ss1 (ssget "w" (list (- (car p1) 65) (- (cadr p1) 100)) (list (+ (car p1) 150) (+ (cadr p1) 100))
(list (cons 0 "text") (cons 8 "ki_hieu") (cons 40 50.0) (cons 72 1) (cons 73 2)))) )
(setq t4 (cdr (assoc 1 (entget (ssname ss1 0)))))
)
(if (and (/= k 0) (= t2 t4) )
(progn
(if (setq ss2 (ssget "w" (list (- (car p1) 65) (- (cadr p1) 100)) (list (+ (car p1) 150) (+ (cadr p1) 100))
(list (cons 0 "text") (cons 8 "ki_hieu") (cons 40 50.0) (cons 72 2) (cons 73 2))))
(progn
(setq t5 (cdr (assoc 1 (setq etxt (entget (ssname ss2 0))))))
(if (and (>= (atoi t5) (atoi t3)) (<= (atoi t5) k1))
(progn
(setq etxt (subst (cons 1 (itoa (+ (atoi t5) k))) (assoc 1 etxt) etxt))
(if (assoc 62 etxt)
(setq etxt (subst (cons 62 3) (assoc 62 etxt) etxt))
(setq etxt (append (list (cons 62 3)) etxt))
)
(entmod etxt)
)
)
)
)
)
)

(if (and (= t2 "/") (/= k 0) (not (setq ss1 (ssget "w" (list (- (car p1) 65) (- (cadr p1) 100))
(list (+ (car p1) 150) (+ (cadr p1) 100))
(list (cons 0 "text") (cons 8 "ki_hieu") (cons 40 50.0) (cons 72 1) (cons 73 2))))) )
(progn
(if (setq ss2 (ssget "w" (list (- (car p1) 65) (- (cadr p1) 100)) (list (+ (car p1) 150) (+ (cadr p1) 100))
(list (cons 0 "text") (cons 8 "ki_hieu") (cons 40 50.0) (cons 72 2) (cons 73 2))))
(progn
(setq t5 (cdr (assoc 1 (setq etxt (entget (ssname ss2 0))))))
(if (and (>= (atoi t5) (atoi t3)) (<= (atoi t5) k1))
(progn
(setq etxt (subst (cons 1 (itoa (+ (atoi t5) k))) (assoc 1 etxt) etxt))
(if (assoc 62 etxt)
(setq etxt (subst (cons 62 3) (assoc 62 etxt) etxt))
(setq etxt (append (list (cons 62 3)) etxt))
)
(entmod etxt)
)
)
)
)
)
)

(setq t4 nil ss1 nil t5 nil ss2 nil)
)
(command "undo" "e")
(setvar "osmode" oldos)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun Separate (S sym / i L ch)
(setq i 0 L nil)
(while (< i (strlen S))
(setq i (1+ i) ch (substr S i 1))
(if (= ch sym) (progn
(setq
L (append L (list (substr S 1 (- i 1))))
S (substr S (1+ i) (- (strlen S) i))
i 0
)
))
)
(append L (list S))
)
                
<<

Filename: 231120_updtxt.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 231124
Tên lệnh: ha
[yêu cầu] Lisp chỉnh sửa độ dày nét hàng loạt

 

(defun C:HA( / hs lay lst lw )
 (vl-load-com)
 (initget 7) (setq hs (getreal "\nHe so nhan: "))
 (vlax-for lay (vla-get-layers (vla-get-ActiveDocument (vlax-get-acad-object)))
  (setq lst '(0 5 9 13 15 18 20 25 30 35 40 50 53 60 70 80 90 100 106 120 140 158 200 211))
  (setq lw (vla-get-lineweight lay))
  (if (<= (setq lw (* hs (if (= lw -3) (getvar "lwdefault") lw))) 211)
 ...
>>

 

(defun C:HA( / hs lay lst lw )
 (vl-load-com)
 (initget 7) (setq hs (getreal "\nHe so nhan: "))
 (vlax-for lay (vla-get-layers (vla-get-ActiveDocument (vlax-get-acad-object)))
  (setq lst '(0 5 9 13 15 18 20 25 30 35 40 50 53 60 70 80 90 100 106 120 140 158 200 211))
  (setq lw (vla-get-lineweight lay))
  (if (<= (setq lw (* hs (if (= lw -3) (getvar "lwdefault") lw))) 211)
   (vla-put-lineweight lay (car (vl-remove-if-not '(lambda(x) (<= lw x)) lst)))))
 (princ))


<<

Filename: 231124_ha.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 230832
Tên lệnh: edtxt
nhờ sửa thêm phần gọi Block text và cho nó song song đoạn thẳng

đây là bản vẽ của em, em muốn thực hiện như trên sau khi chọn 2 điểm cần hiện tên đường thí nó sẽ xuất hiện 1 mtext song song với đoạn mình trọn (em muốn mtext vì nó gõ unicode dễ hơn)

http://www.cadviet.com/upfiles/3/62465_text_duong.dwg

Hề hề...

>>

đây là bản vẽ của em, em muốn thực hiện như trên sau khi chọn 2 điểm cần hiện tên đường thí nó sẽ xuất hiện 1 mtext song song với đoạn mình trọn (em muốn mtext vì nó gõ unicode dễ hơn)

http://www.cadviet.com/upfiles/3/62465_text_duong.dwg

Hề hề hề,

Chưa hiểu rõ ý bạn lắm. Cứ đoán mò rồi làm bừa, không biết đã đúng ý bạn chưa??? Hãy check nhé.

 

(defun c:edtxt (/ edt e1 e2 p1 p2 p3 etxt goc )
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 512)
(setq edt (entsel "\n Pick < diem dat text > tren tim duong") 
          e1 (car edt)
          p1 (cadr edt)
          p2 (getpoint p1 "\n Chon diem xac dinh huong dat text")
          p3 (acet-geom-midpoint p1 p2)
          etxt (entget (car (acet-ss-to-list (ssget "f" (acet-geom-vertex-list e1) (list (cons 0 "mtext"))))))
          goc (angle p1 p2)
)
(entmake (list (cons 0 "mtext") (cons 100  "AcDbEntity") (assoc 8 etxt) (cons 100  "AcDbMText")  
                        (cons 10 p3)  (assoc 40 etxt) (cons 71 5) (assoc 72 etxt) (assoc 1 etxt)
                        (assoc 7 etxt) (cons 50 goc) (assoc 73 etxt)   ) )
(setq e2 (entlast))
(entupd e2)
(command "ddedit" e2 pause)
(setvar "osmode" oldos)
(princ)
)
Chúc bạn vui.

<<

Filename: 230832_edtxt.lsp
Tác giả: nhoclangbat
Bài viết gốc: 218295
Tên lệnh: kkk
Lsp chuyển tên layer các đối tượng
oh em sorry Anh Duy ý cụ thể của em là layer 10 thì chỉ cần đổi tên là xong,còn layer 22 và 57 thì đổi cả tên , màu , linetype, ltscale lun. Em đang học bên lớp anh ketxu nhưng cũng mới bắt đầu ko rành mún viết nhưng viết ko nỗi hihi. Nãy giờ em cũng mày mò rùi lụm mót viết cái lsp này mà thấy nó còn nhiều bất cập, cái layer 57 em đổi tên nó đc rùi mà mún đổi lun ltype và ltscale em kết hợp lệnh...
>>
oh em sorry Anh Duy ý cụ thể của em là layer 10 thì chỉ cần đổi tên là xong,còn layer 22 và 57 thì đổi cả tên , màu , linetype, ltscale lun. Em đang học bên lớp anh ketxu nhưng cũng mới bắt đầu ko rành mún viết nhưng viết ko nỗi hihi. Nãy giờ em cũng mày mò rùi lụm mót viết cái lsp này mà thấy nó còn nhiều bất cập, cái layer 57 em đổi tên nó đc rùi mà mún đổi lun ltype và ltscale em kết hợp lệnh change nhưng em lại phải lọc nó ra trước kéo nó ra ngoài rùi mới chạy lsp nếu ko khi chạy đến lúc nó kêu chọn đối tượng thì phải chọn lẻ tẻ từng cái tại cái layer 57 nó nằm tứ tung , em post lên thử mấy anh đừng chê em gà hihi

(defun c:kkk ()
(command "-layer" "rename" "10" "a1-10" "")
(command "layer" "rename" "57" "a1-57" "color" "172" "a1-57" "")
(prompt "_.change ")
(princ "\n Change ltype - dashed")
(setq sset (ssget))
(if (null sset)
(progn
(princ "\nERROR: Nothing selected.")
(exit)
)
)
(command "_.change" sset "" "P" "ltype" "dashed" "ltscale" "3.0" "")
(princ)
(command "-layer" "rename" "22" "a1-22" "color" "22" "a1-22" "")
); het

<<

Filename: 218295_kkk.lsp
Tác giả: KangKung
Bài viết gốc: 230983
Tên lệnh: kk
chỉnh thuộc tính cho nhiều block

Bạn đã cài Express Tool chưa? Nếu chưa cài thì dùng thử cái này xem có được không. Trên máy mình chạy ngon.

;====CHUYEN TEXT TU LAYER DEFPOINTS TRONG BLOCK ATTRIBUTE VE LAYER "0"====
;=======================KANGKUNG 05/04/2013===============================
;========================UPDATED 07/04/2013===============================
(defun c:KK()
  (vl-load-com)
  (setq taphop(ssget "_X" '((0 . "INSERT"))) i 0)
  (while (<...
>>

Bạn đã cài Express Tool chưa? Nếu chưa cài thì dùng thử cái này xem có được không. Trên máy mình chạy ngon.

;====CHUYEN TEXT TU LAYER DEFPOINTS TRONG BLOCK ATTRIBUTE VE LAYER "0"====
;=======================KANGKUNG 05/04/2013===============================
;========================UPDATED 07/04/2013===============================
(defun c:KK()
  (vl-load-com)
  (setq taphop(ssget "_X" '((0 . "INSERT"))) i 0)
  (while (< i (sslength taphop))
    (SETQ EN2(ENTNEXT(ssname taphop i)))
    (SETQ ENLIST2(ENTGET EN2))
    (while (/= (cdr(assoc 0 enlist2)) "SEQEND")
      (setq en2(entnext en2))
      (setq enlist2(entget en2))
      (if (= "DEFPOINTS" (cdr(assoc 8 enlist2)))
	(entmod (subst (cons 8 "0") (assoc 8 enlist2) enlist2))
	)
      )
    (setq i(1+ i))
    )
  (command "REGEN")
  (alert "Well Done")
  )
(princ "\n                Written By KangKung - 05/04/2013\n")
(princ "\n                  Nhap KK de chay chuong trinh\n")


<<

Filename: 230983_kk.lsp
Tác giả: duy782006
Bài viết gốc: 3394
Tên lệnh: tkth h%3F
Viết Lisp theo yêu cầu
Nhờ các bác viết giúp cái hộp thoại cho cái lệnh này của em, có một số ý muốn như thế này:
-Cố gắng giữ nguyên các câu lệnh của em chỉ sửa những chổ cần thiết
-Dùng thuần lisp giúp em vì em không biết VBA.
-Hình dáng hộp thoại gồm:
+03 imagebutton thể hiện 03 loại thép hình.
+03 nút : Chèn tiêu đề; kẻ bảng; chọn và hủy bỏ.
-Hộp thoại dùng các...
>>
Nhờ các bác viết giúp cái hộp thoại cho cái lệnh này của em, có một số ý muốn như thế này:
-Cố gắng giữ nguyên các câu lệnh của em chỉ sửa những chổ cần thiết
-Dùng thuần lisp giúp em vì em không biết VBA.
-Hình dáng hộp thoại gồm:
+03 imagebutton thể hiện 03 loại thép hình.
+03 nút : Chèn tiêu đề; kẻ bảng; chọn và hủy bỏ.
-Hộp thoại dùng các file: SLD rời đừng gộp chung lại (để em còn phát triển).
-Khi chọn 1 ảnh song bấm enter thì thực thi giống như chọn nút ok.
-Nhớ vị trí ảnh chọn ở lần gọi lệnh sau.
-Mổi ảnh và nút có thể chọn bằng chử ở bàn phím.
-Tạo giúp em cái vòng lặp khi thực hiện xong lệnh sẽ tiếp tục quay lại.
Cảm ơn các bác nhiều.


<<

Filename: 3394_tkth_h%3F.lsp
Tác giả: nguyenngoc971
Bài viết gốc: 231078
Tên lệnh: cvav 1 04
Xin giúp về virus Cad
;; free lisp from cadviet.com

;; --------- Fix acad.lsp virus ---------
(setq removedcodelist  (list
			 ";; Silent load."
			 "(princ)"
			 "(load \"acadapp\")"			 
			 "(load \"ddcopy.lsp\")"
			 "(load\"acadiso\")";; v103
			 "(setq flagx t)" ;; v102
			 ""
			)
      infectedcodematch (strcat
			 "(load \"acadapp\"),"
			 "(load \"ddcopy.lsp\"),"
			 "(load\"acadiso\"),";; v103 
			 "(setq path (findfile \"base.dcl\")),"
			 "(strcat c-acaddocpath...
>>
;; free lisp from cadviet.com

;; --------- Fix acad.lsp virus ---------
(setq removedcodelist  (list
			 ";; Silent load."
			 "(princ)"
			 "(load \"acadapp\")"			 
			 "(load \"ddcopy.lsp\")"
			 "(load\"acadiso\")";; v103
			 "(setq flagx t)" ;; v102
			 ""
			)
      infectedcodematch (strcat
			 "(load \"acadapp\"),"
			 "(load \"ddcopy.lsp\"),"
			 "(load\"acadiso\"),";; v103 
			 "(setq path (findfile \"base.dcl\")),"
			 "(strcat c-acaddocpath \"acaddoc.lsp\")";; v103
		       )
      restoresv	       (list (cons "cmdecho" 1)
			     (cons "zoomfactor" 60)
			     (cons "mbuttonpan" 1)
			     (cons "HIGHLIGHT" 1)
			     (cons "fillmode" 1)

		       )
      restorecmd       (list "plot"	"u"	   "qsave"
			     "line"	"quit"	   "trim"
			     "extend"	"move"	   "xplode"
			     "xref"	"xbind"
			    )

)

(princ "\n")
(princ "\n")
(princ "\n****************************************")
(princ "\nCADViet AntiVirus v1.04 is starting ...")
(setq ifile 0)
(vl-load-com)

(setq support_path (findfile "base.dcl")
      support_path (substr support_path 1 (- (strlen support_path) 8))
      nowdwg	   (getvar "dwgname")
      wjqm	   (findfile nowdwg)
      wjqm	   (if wjqm
		     wjqm
		     nowdwg
		   )
      dwg_path	   (substr wjqm 1 (- (strlen wjqm) (strlen nowdwg)))
      
      acad_path (vl-filename-directory (findfile "acad.exe"))
      removedlist  (list
                     (strcat acad_path "\\acaddoc.lsp");; v104
		     
		     (strcat support_path "acadapp.lsp")
		     (strcat support_path "acadappp.lsp")
		     (strcat support_path "ddcopy.lsp")
		     (strcat support_path "acadapq.lsp");; v103
		     (strcat support_path "acaddoc.lsp");; v103
		     
		     (strcat dwg_path "acad.lsp")
		     (strcat dwg_path "acaddoc.lsp");; v102
		     (strcat dwg_path "acaddoc.fas");; v102
		     (strcat dwg_path "acad.fas");; v102
		     (strcat dwg_path "acad.vlx");; v102
		     (strcat dwg_path "acadapq.lsp");; v103
		   )
      fixedlist	   (list
		     (strcat support_path "acad.mnl")
		     (strcat support_path "acad.lsp")
		   )
)

(defun fixvr (fn / content infected)
  (if (setq ff (open fn "r"))
    (progn
      (while (setq str (read-line ff))
	(if (not (member str removedcodelist))
	  (setq content (append content (list str)))
	  (if (wcmatch str infectedcodematch)
	    (setq infected t)
	  )
	)
      )
      (close ff)
      (if infected
	(progn
	  (setq ff (open fn "w"))
	  (foreach str content
	    (write-line str ff)
	  )
	  (close ff)
	  (princ (strcat "\nfile " fn " was fixed!"))
	  (setq ifile (1+ ifile))
	)
      )
    )
  )
)

(foreach fn removedlist
  (if (vl-file-delete fn)
    (progn
      (princ (strcat "\nfile " fn " was deleted!"))
      (setq ifile (1+ ifile))
    )
  )
)

(foreach fn fixedlist
  (fixvr fn)
)

(princ "\nCADViet AntiVirus finishes scanning ...")
(if (= ifile 0)
  (princ "\nNo infected files were found!")
  (progn
    (setvar "cmdecho" 0)
    (mapcar '(lambda (cn) (setvar (car cn) (cdr cn))) restoresv)
    (mapcar '(lambda (cn) (command ".redefine" cn)) restorecmd)
    (princ (strcat "\nTotal "
		   (itoa ifile)
		   " infected files were found and removed!"
	   )
    )
    (setvar "cmdecho" 1)
  )
)
(princ "\n****************************************")
(princ "\n")
(princ "\n")
;;(defun c:cvav_1_04()(princ))
(princ)
 

 

Bạn dùng thử cái này xem sao nhé.vào mục content

 

 

;; free lisp from cadviet.com
 
;; --------- Fix acad.lsp virus ---------
(setq removedcodelist  (list
";; Silent load."
"(princ)"
"(load \"acadapp\")"
"(load \"ddcopy.lsp\")"
"(load\"acadiso\")";; v103
"(setq flagx t)" ;; v102
""
)
      infectedcodematch (strcat
"(load \"acadapp\"),"
"(load \"ddcopy.lsp\"),"
"(load\"acadiso\"),";; v103 
"(setq path (findfile \"base.dcl\")),"
"(strcat c-acaddocpath \"acaddoc.lsp\")";; v103
      )
      restoresv       (list (cons "cmdecho" 1)
    (cons "zoomfactor" 60)
    (cons "mbuttonpan" 1)
    (cons "HIGHLIGHT" 1)
    (cons "fillmode" 1)
 
      )
      restorecmd       (list "plot" "u"   "qsave"
    "line" "quit"   "trim"
    "extend" "move"   "xplode"
    "xref" "xbind"
   )
 
)
 
(princ "\n")
(princ "\n")
(princ "\n****************************************")
(princ "\nCADViet AntiVirus v1.04 is starting ...")
(setq ifile 0)
(vl-load-com)
 
(setq support_path (findfile "base.dcl")
      support_path (substr support_path 1 (- (strlen support_path) 8))
      nowdwg   (getvar "dwgname")
      wjqm   (findfile nowdwg)
      wjqm   (if wjqm
    wjqm
    nowdwg
  )
      dwg_path   (substr wjqm 1 (- (strlen wjqm) (strlen nowdwg)))
      
      acad_path (vl-filename-directory (findfile "acad.exe"))
      removedlist  (list
                     (strcat acad_path "\\acaddoc.lsp");; v104
    
    (strcat support_path "acadapp.lsp")
    (strcat support_path "acadappp.lsp")
    (strcat support_path "ddcopy.lsp")
    (strcat support_path "acadapq.lsp");; v103
    (strcat support_path "acaddoc.lsp");; v103
    
    (strcat dwg_path "acad.lsp")
    (strcat dwg_path "acaddoc.lsp");; v102
    (strcat dwg_path "acaddoc.fas");; v102
    (strcat dwg_path "acad.fas");; v102
    (strcat dwg_path "acad.vlx");; v102
    (strcat dwg_path "acadapq.lsp");; v103
  )
      fixedlist   (list
    (strcat support_path "acad.mnl")
    (strcat support_path "acad.lsp")
  )
)
 
(defun fixvr (fn / content infected)
  (if (setq ff (open fn "r"))
    (progn
      (while (setq str (read-line ff))
(if (not (member str removedcodelist))
 (setq content (append content (list str)))
 (if (wcmatch str infectedcodematch)
   (setq infected t)
 )
)
      )
      (close ff)
      (if infected
(progn
 (setq ff (open fn "w"))
 (foreach str content
   (write-line str ff)
 )
 (close ff)
 (princ (strcat "\nfile " fn " was fixed!"))
 (setq ifile (1+ ifile))
)
      )
    )
  )
)
 
(foreach fn removedlist
  (if (vl-file-delete fn)
    (progn
      (princ (strcat "\nfile " fn " was deleted!"))
      (setq ifile (1+ ifile))
    )
  )
)
 
(foreach fn fixedlist
  (fixvr fn)
)
 
(princ "\nCADViet AntiVirus finishes scanning ...")
(if (= ifile 0)
  (princ "\nNo infected files were found!")
  (progn
    (setvar "cmdecho" 0)
    (mapcar '(lambda (cn) (setvar (car cn) (cdr cn))) restoresv)
    (mapcar '(lambda (cn) (command ".redefine" cn)) restorecmd)
    (princ (strcat "\nTotal "
  (itoa ifile)
  " infected files were found and removed!"
  )
    )
    (setvar "cmdecho" 1)
  )
)
(princ "\n****************************************")
(princ "\n")
(princ "\n")
;;(defun c:cvav_1_04()(princ))
(princ)

<<

Filename: 231078_cvav_1_04.lsp
Tác giả: hantinh
Bài viết gốc: 184018
Tên lệnh: ob
nhờ các cao thủ viết hộ cái lsp mir-tag ghi chú thép trong ASD
còn đây là cai lsp mà minh viết nhưng khi load vào thì nó báo là ít đối số quá hem có hiểu tại sao luôn. Hik


(defun c:ob (/ ename ename1 ename2 ename3 ename4 ename5
x1 x2 x3 x4 y1 y2 y3 y4 p1 p2 p3 p4)
(setq ename (entsel "\nchon doi tuong:")
ename1 (car ename)
ename2 (entget ename1)
ename3 (cdr (assoc 340 ename2))
ename4 (entget ename3)
);end setq
(ssget
(
(-4....
>>
còn đây là cai lsp mà minh viết nhưng khi load vào thì nó báo là ít đối số quá hem có hiểu tại sao luôn. Hik


(defun c:ob (/ ename ename1 ename2 ename3 ename4 ename5
x1 x2 x3 x4 y1 y2 y3 y4 p1 p2 p3 p4)
(setq ename (entsel "\nchon doi tuong:")
ename1 (car ename)
ename2 (entget ename1)
ename3 (cdr (assoc 340 ename2))
ename4 (entget ename3)
);end setq
(ssget
(
(-4. "or")
(0 . "RBCRENBARSHAPEDESC")
(0 . "RBCR_ENDE_BARDDESC")
(-4 . "or>")
)
p3(nth 50 ename3)
p2(nth 47 ename3)
p1(nth 44 ename3)
x1(car
(nth 44 ename3)
)
x2(cadr
(nth 47 ename3)
)
x3(cadr
(nth 50 ename3)
)
(if (>x3 x2)
(setq x4(- x2 kcach))
(setq x4(+ x2 kcach))
)
(setq
ename5(subst p4 p3 ename4)
ename1(append ename1 ename5)
(entmod ename1)
)
(command:_.mirror
(ssget
(
(-4. "or")
(0 . "RBCRENBARSHAPEDESC")
(0 . "RBCR_ENDE_BARDDESC")
(-4 . "or>")
)
)
)
(princ)
)

<<

Filename: 184018_ob.lsp
Tác giả: avi612
Bài viết gốc: 218771
Tên lệnh: atm
[Hỏi] Tiếng Việt trong Visual Lisp của Win7
Ý mọi người là muốn thể hiện được Tiếng Việt trong những câu lệnh điều khiển như thế này đó hả?
Lisp ví dụ:.

(defun c:ATM(/ os #sset #chuoidau #chuoisau i #ssname #str #new)
(setvar "CMDECHO" 0)
(command ".undo" "BE")
(command ".UCS" "W" ^C^C)
(Prompt "\n- Ch\U+1ECDn Text c\U+1EA7n thay \U+0111\U+1ED5i:")
(setq #sset (ssget...
>>
Ý mọi người là muốn thể hiện được Tiếng Việt trong những câu lệnh điều khiển như thế này đó hả?
Lisp ví dụ:.

(defun c:ATM(/ os #sset #chuoidau #chuoisau i #ssname #str #new)
(setvar "CMDECHO" 0)
(command ".undo" "BE")
(command ".UCS" "W" ^C^C)
(Prompt "\n- Ch\U+1ECDn Text c\U+1EA7n thay \U+0111\U+1ED5i:")
(setq #sset (ssget ":N" '((0 . "*TEXT,DIMENSION"))))
(setq #chuoidau (getstring "\n- Th&#234;m ti\U+1EC1n t\U+1ED1: "))
(setq #chuoisau (getstring "\n- Th&#234;m h\U+1EADu t\U+1ED1: "))
(setq i 0)
(while
(setq #ssname (ssname #sset i))
(setq #str (cdr (assoc 1 (entget #ssname))))
(setq #new (strcat #chuoidau #str #chuoisau))
(entmod (subst (cons 1 #new) (assoc 1 (entget #ssname)) (entget #ssname)))
(setq i (1+ i))
)
(command ".undo" "E")
(princ)
(princ)
)

<<

Filename: 218771_atm.lsp
Tác giả: KangKung
Bài viết gốc: 231603
Tên lệnh: kk
nhờ viết lisp gán cao độ cho đường đồng mức và ghi ra text

Thấy chưa có ai giúp nên post cái Lisp này lên cho bạn dùng thử:

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

Hướng dẫn: Ví dụ muốn đặt 2 đường đồng mức cùng có cao độ là 10 thì quét chọn cả 2 đường đồng mức đó luôn. Sau đó nhập độ cao đường đồng mức và chiều...

>>

Thấy chưa có ai giúp nên post cái Lisp này lên cho bạn dùng thử:

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

Hướng dẫn: Ví dụ muốn đặt 2 đường đồng mức cùng có cao độ là 10 thì quét chọn cả 2 đường đồng mức đó luôn. Sau đó nhập độ cao đường đồng mức và chiều cao chữ. Cuối cùng chọn vị trí ghi Text. Khi nào không muốn ghi Text nữa thì chuột phải hoặc Enter hoặc Space.

;GAN CAO DO CHO DUONG DONG MUC VA GHI RA TEXT
;============KANGKUNG 13/04/2013=============
(defun C:kk( / index Height pt taphop)
  (setq taphop (ssget '((0 . "POLYLINE,LWPOLYLINE"))))
  (if (/= docao nil)
    (setq docao(read(lisped (rtos docao 2 2))))
    (setq docao(read(lisped "Nhap do cao duong dong muc vao day")))
    )
  (setq Height(getreal "\n Nhap chieu cao chu: "))
  (setq index 0)
  (while (< index (sslength taphop))
    (vla-put-elevation (vlax-ename->vla-object (ssname taphop index)) docao)
    (setq index (1+ index))
    )
  (while (setq pt(getpoint "\n Pick diem chen TEXT: " ))
      (entmake (list '(0 . "TEXT") (cons 10 pt) (cons 40 Height) (cons 1 (rtos docao 2 2))))
      )
  (princ)
  )
(princ "\n              KangKung - 13/04/2013\n")
(princ "\n           Nhap KK de chay chuong trinh\n")

<<

Filename: 231603_kk.lsp
Tác giả: q288
Bài viết gốc: 67225
Tên lệnh: dg
Bắt Điểm Đặc Biệt


Sao không dùng lisp cho nhanh? ko phải lúc nào cũng phụ thuộc lisp nhưng trường hợp này nên dùng.
khi ct hỏi tỷ lệ thì đánh vào 1/3 hoặc bao nhiêu tùy ý, có thể lớn hơn 1 cũng đc.

Filename: 67225_dg.lsp
Tác giả: KangKung
Bài viết gốc: 231671
Tên lệnh: kk
nhờ viết lisp gán cao độ cho đường đồng mức và ghi ra text

Lisp sửa theo yêu cầu của bạn đây: http://www.cadviet.com/upfiles/3/71162_21lisp_gan_cao_do_cho_pline_va_ghi_ra_text_rev1.lsp

Ghóp ý thêm một chút nhé:

1. Trong bản vẽ thường cỡ chữ dùng để ghi chú đồng mức được cố định nên bạn chỉ nhập lần đầu thôi, còn từ lần thứ 2 trở đi thì không cần phải nhập nữa. Nếu cỡ chữ thay đổi liên tục (cái này hơi hiếm) thì bạn cho mình biết...

>>

Lisp sửa theo yêu cầu của bạn đây: http://www.cadviet.com/upfiles/3/71162_21lisp_gan_cao_do_cho_pline_va_ghi_ra_text_rev1.lsp

Ghóp ý thêm một chút nhé:

1. Trong bản vẽ thường cỡ chữ dùng để ghi chú đồng mức được cố định nên bạn chỉ nhập lần đầu thôi, còn từ lần thứ 2 trở đi thì không cần phải nhập nữa. Nếu cỡ chữ thay đổi liên tục (cái này hơi hiếm) thì bạn cho mình biết để sửa lại code.

2. Khi bạn chọn điểm chèn thì không nhất thiết phải chọn chính xác vị trí trên đường đồng mức cần ghi. Cứ chọn gần đó thôi và Lisp sẽ ghi Text vào đường đồng mức gần nhất với khoảng cách bằng 1/2 cao chữ. Và để tránh trường hợp chữ ngược chữ xuôi theo hướng đi của đường đồng mức thì mình đặt Text luôn luôn ở bên phải của đường đồng mức và xoay chữ sao cho không bị ngược trên bản vẽ chuẩn North Up.

3. Thêm 1 tính năng nữa đó là tự động tính bước nhảy của đường đồng mức giữa 2 lần nhập liên tiếp. Ví dụ lần đầu tiên bạn nhập cao độ đường đồng mức là 2, lần thứ hai là 4 thì từ lần thứ 3 trở đi Lisp sẽ tự động điền giá trị độ cao là 6, 8, 10 .... vào ô nhập. Đồng ý thì chỉ việc nhấn OK, không thì nhập giá trị khác. Tuy nhiên nếu bạn thao tác một cách có quy luật thì không phải mất công nhập số từ bàn phím nhiều lần.

;GAN CAO DO CHO DUONG DONG MUC VA GHI RA TEXT
;=======KANGKUNG 14/04/2013 - REV1===========
(defun C:kk( / i index pt pt1 pt2 taphop lst huong)
  (command "UNDO" "BE")
  (setq os(getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setq taphop (ssget '((0 . "POLYLINE,LWPOLYLINE"))))
  (if (and (/= docao nil) (= (length list_caodo) 2))
    (setq docao(read(lisped (rtos (+ (- (nth 1 list_caodo) (nth 0 list_caodo)) docao) 2 2))))
    (if (/= docao nil)
      (setq docao(read(lisped (rtos docao 2 2))))
      (setq docao(read(lisped "Nhap do cao duong dong muc vao day")))
      )
    )
  (if (< (length list_caodo) 2)
    (setq list_caodo(append list_caodo (list docao)))
    (setq list_caodo(append (list (nth 1 list_caodo)) (list docao)))
    )
  (if (= Height nil)
    (setq Height(read(lisped "Nhap cao chu vao day")))
    )
  (setq index 0)
  (while (< index (sslength taphop))
    (vla-put-elevation (vlax-ename->vla-object (ssname taphop index)) docao)
    (vla-put-color (vlax-ename->vla-object (ssname taphop index)) 2)
    (setq index (1+ index))
    )
  (while (setq pt(getpoint "\n Pick diem chen TEXT: " ))
    (huongtext)
    (entmake (list '(0 . "TEXT") (cons 10 pt2) (cons 40 Height) (cons 1 (rtos docao 2 2)) (cons 50 huong)))
    )
  (setvar "OSMODE" os)
  (command "UNDO" "END")
  (princ)
  )
(defun huongtext()
  (setq i 0)
  (setq lst(list))
  (while (< i (sslength taphop))
    (setq dt(ssname taphop i))
    (setq pt1(vlax-curve-getClosestPointTo dt pt))
    (if (and (<= pi (angle pt1 pt)) (<= (angle pt1 pt) (* 2 pi)))
      (setq pt2(polar pt1 (angle pt pt1) (/ Height 2)))
      (setq pt2(polar pt1 (angle pt1 pt) (/ Height 2)))
      )
    (if (= (vlax-curve-getDistAtPoint dt (vlax-curve-getClosestPointTo dt pt)) (vla-get-length (vlax-ename->vla-object dt)))
      (setq huong(angle ( vlax-curve-getPointAtDist dt (+ (vlax-curve-getDistAtPoint dt (vlax-curve-getClosestPointTo dt pt)) -0.001)) (vlax-curve-getClosestPointTo dt pt) ))
      (setq huong(angle (vlax-curve-getClosestPointTo dt pt) ( vlax-curve-getPointAtDist dt (+ (vlax-curve-getDistAtPoint dt (vlax-curve-getClosestPointTo dt pt)) 0.001))))
      )
    (if (and (> huong (/ pi 2)) (< huong (/ (* 3 pi) 2))) (setq huong(- huong pi)))
    (setq lst(append lst (list (list (distance pt pt1) huong pt2))))
    (setq i(1+ i))
    )
  (setq lst(vl-sort lst '(lambda (e1 e2) (< (car e1) (car e2)))))
  (setq huong(cadr(nth 0 lst)))
  (setq pt2(caddr(nth 0 lst)))
  )
(princ "\n              KangKung - 14/04/2013\n")
(princ "\n           Nhap KK de chay chuong trinh\n")

<<

Filename: 231671_kk.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 231757
Tên lệnh: ln
Lisp nhập đoạn thẳng và kiểm tra điều kiện nhập

De bai:nhap vao chieu dai 1 doan thang neu du lieu dau vao >0,thi thuc hien lenh ve doan thang.Neu du lieu khong dung thi nhap lai va ve lai.

De bai:nhap vao chieu dai 1 doan thang neu du lieu dau vao >0,thi thuc hien lenh ve doan thang.Neu du lieu khong dung thi nhap lai va ve lai.

Hề hề hề,

Phải chăng bạn cần cái này:

(defun c:ln ()

(while (or (<= (setq len (getreal "\n Nhap gia tri do dai doan thang: ")) 0) (= len nil) )

 (alert "\n Do dai doan thang nhap khong dung, hay nhap lai") )

(if (> len 0)

   (command "line" (setq p1 (getpoint "\n Nhap diem bat dau ve")) (polar p1 (getreal "\n Nhap goc ve doan thang tinh theo radian: ") len) "")

)

)

Hề hề hề


<<

Filename: 231757_ln.lsp
Tác giả: ketxu
Bài viết gốc: 201711
Tên lệnh: lc
vấn đề về lệnh tắt trong cad
Bác Hà chưa release nó sau khi dùng lisp ^^

@toiyeuvietnam :
- Nếu không nhớ lệnh (hay như trong ví dụ của bạn là các hàm viết bằng lisp), tại sao bạn không tạo menu, hoặc tạo Toolbar bằng lệnh CUI của CAD ?
- Nếu không rành tạo menu thì tạo Tool Palette
- Nếu đã dùng lisp gọi bảng lệnh thì nên làm theo gợi ý của bác Duy, không nên tốn chỗ cho 1 file lisp + 1 file txt list lệnh,...
>>
Bác Hà chưa release nó sau khi dùng lisp ^^

@toiyeuvietnam :
- Nếu không nhớ lệnh (hay như trong ví dụ của bạn là các hàm viết bằng lisp), tại sao bạn không tạo menu, hoặc tạo Toolbar bằng lệnh CUI của CAD ?
- Nếu không rành tạo menu thì tạo Tool Palette
- Nếu đã dùng lisp gọi bảng lệnh thì nên làm theo gợi ý của bác Duy, không nên tốn chỗ cho 1 file lisp + 1 file txt list lệnh, ngoài ra khi gọi sang chương trình khác sẽ làm gián đoạn quá trình làm việc của bạn, bất kể là word hay txt thì sau đó cũng phải back ngược lại về CAD và đánh lệnh
Mình viết cho bạn 1 cái hiển thị bảng lệnh - hoặc lisp. Sau khi chọn lệnh bạn có thể ấn nút OK để CAD thực hiện lệnh đó luôn.
Cách thêm lệnh bạn xem trong code mình ghi chú rồi đó. Sau khi thêm các lệnh sẽ được sắp xếp theo thứ tự abc.
Bạn có thể đánh dòng ghi chú bằng tiếng việt không dấu, hoặc tiếng việt có dấu dạng TCVN3, hoặc Unicode Hexa (tìm tool convert trong các bài tiếng việt trong Lisp), tuyệt đối không đánh trực tiếp font Unicode

http://i1226.photobucket.com/albums/ee410/ketxu/Ghichulenh.jpg

(defun c:lc(/ LM:ListBox str lstData ST:SendKeys)
(setq lstData
(acad_strlsort (list
;Viet tiep cac lenh vao duoi dong nay theo mau "Ten lenh Noi dung"
"Erase Xoa doi tuong"
"Copy Sao chep doi tuong"
"Mirror Lay doi xung"
"CO Copy th\U+00F4ng minh"
))
)
(defun ST:SendKeys (keys / ws)
(vlax-invoke-method (setq ws (vlax-create-object "WScript.Shell")) 'sendkeys keys)
(vlax-release-object ws)
(princ)
)
(defun LM:ListBox ( title data multiple / file tmp dch return )
(cond
(
(not
(and (setq file (open (setq tmp (vl-filename-mktemp nil nil ".dcl")) "w"))
(write-line
(strcat "listbox : dialog { label = \"" title
"\"; spacer; : list_box { key = \"list\"; multiple_select = "
(if multiple "true" "false") "; } spacer; ok_cancel;}"
)
file
)
(not (close file)) (< 0 (setq dch (load_dialog tmp))) (new_dialog "listbox" dch)
)
)
)
(
t
(start_list "list")
(mapcar 'add_list data) (end_list)

(setq return (set_tile "list" "0"))
(action_tile "list" "(setq return $value)")

(setq return
(if (= 1 (start_dialog))
(mapcar '(lambda ( x ) (nth x data)) (read (strcat "(" return ")")))
)
)
)
)
(if (< 0 dch) (unload_dialog dch))
(if (setq tmp (findfile tmp)) (vl-file-delete tmp))
return
)
(cond (
(setq str (LM:ListBox "Ghi ch\U+00FA l\U+1EC7nh - lisp CAD - @ketxu - 2/6/2012 :" lstData nil))
(setq str (car str))
(ST:SendKeys (strcat (substr str 1 (vl-string-position 32 str)) "\n"))
)
)
(princ)
)


<<

Filename: 201711_lc.lsp
Tác giả: Tue_NV
Bài viết gốc: 231882
Tên lệnh: nhap
[Nhờ giúp đỡ] Nhập bổ sung liên tục các số thực

Vậy chỉ đơn giản như này là xong bài hả a

À, do mình không đọc kỹ đề bài. Ý của đề bài như thế này :

 
(defun c:nhap (/ a b)
  (while (setq a (getreal "\nNhap so thuc :"))
    (setq b (append b (list a)))
  )
)

Filename: 231882_nhap.lsp

Trang 125/303

125