Jump to content
InfoFile
Tác giả: Tot77
Bài viết gốc: 299774
Tên lệnh: slm
Lisp chuyển text chữ số la mã sang chữ thường

  Thấy đề tài cũng hay hay nên làm thử cái lisp. Nếu số lượng ít thì có thể dùng lệnh (ít tức là thí dụ chỉ có từ 1->10 chẳng hạn), nhưng nếu nhiều thì find & replace 2,3 chục chữ khác nhau cũng hơi oải.

  Tôi chỉ mới test từ 1 tới 20 thôi, bạn có file nào ghi số la mã đủ loại thì post lên tôi sửa lisp tiếp, chứ viết sô la mã nhiều quá cũng lười.  ^_^  ^_^ ...

>>

  Thấy đề tài cũng hay hay nên làm thử cái lisp. Nếu số lượng ít thì có thể dùng lệnh (ít tức là thí dụ chỉ có từ 1->10 chẳng hạn), nhưng nếu nhiều thì find & replace 2,3 chục chữ khác nhau cũng hơi oải.

  Tôi chỉ mới test từ 1 tới 20 thôi, bạn có file nào ghi số la mã đủ loại thì post lên tôi sửa lisp tiếp, chứ viết sô la mã nhiều quá cũng lười.  ^_^  ^_^  ^_^

 

(defun c:slm()
  (defun demsolama(dt)
    (setq tong 0 n -1
 txt (vl-string->list (cdr (assoc 1 (entget dt))))
 as '((73 . 1) (86 . 5) (88 . 10)))
    (foreach v txt
      (setq n (1+ n)) 
      (cond ((and (> n 0) (/= (nth (1- n) txt) 73) (= v 86)) (setq tong (+ tong 5)))
   ((and (> n 0) (= (nth (1- n) txt) 73) (= v 86)) (setq tong (+ tong 3)))
   ((and (> n 0) (/= (nth (1- n) txt) 73) (= v 88)) (setq tong (+ tong 10)))
   ((and (> n 0) (= (nth (1- n) txt) 73) (= v 88)) (setq tong (+ tong 8)))
   (t (setq tong (+ tong (cdr (assoc v as))))) )      
      )
    (entmod (subst (cons 1 (itoa tong)) (assoc 1 (entget dt)) (entget dt))) 
  )
  
  (setq ssl (vl-remove-if-not  '(lambda(x)
       (vl-remove nil (mapcar '(lambda(y) (vl-string-search y (cdr (assoc 1 (entget x))))) '("I" "V" "X"))))
     (acet-ss-to-list (ssget '((0 . "TEXT"))))))
  (mapcar 'demsolama ssl)
  (princ)
)

<<

Filename: 299774_slm.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 300106
Tên lệnh: vpl
[Yêu cầu]1 Lisp vẽ đường polyline nối baseponit của các block và

một khó khăn hơn nhờ các bác giúp

Lisp Vẽ đường PLINE nối tọa độ đầu các đường dóng LINE tăng dần theo trục X file dinh kem

http://www.cadviet.com/upfiles/3/132623_pline_3.dwg

Hề hề hề,

Code nháp để bạn test thử,...

>>

một khó khăn hơn nhờ các bác giúp

Lisp Vẽ đường PLINE nối tọa độ đầu các đường dóng LINE tăng dần theo trục X file dinh kem

http://www.cadviet.com/upfiles/3/132623_pline_3.dwg

Hề hề hề,

Code nháp để bạn test thử, nếu Ok sẽ hoàn thiện sau.

(defun c:vpl ()
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(alert "\n Chon cac line can moi")
(setq ssl (acet-ss-to-list (ssget (list (cons 0 "line")))))
(setq plst (list))
(foreach e ssl
(setq elst (entget e)
          p1 (cdr (assoc 10 elst))
          p2 (cdr (assoc 11 elst)) )
(if (< (cadr p1) (cadr p2)) 
    (setq plst (append plst (list p1)))
    (setq plst (append plst (list p2)))
)
)
(setq plst (vl-sort plst '(lambda (x y) (< (car x) (car y)))))
(command "pline")
(foreach p plst
     (command p)
)
(command "")
(setvar "osmode" oldos)
(princ)
)
(defun c:vpl ()
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(alert "\n Chon cac line can moi")
(setq ssl (acet-ss-to-list (ssget (list (cons 0 "line")))))
(setq plst (list))
(foreach e ssl
(setq elst (entget e)
          p1 (cdr (assoc 10 elst))
          p2 (cdr (assoc 11 elst)) )
(if (< (cadr p1) (cadr p2)) 
    (setq plst (append plst (list p1)))
    (setq plst (append plst (list p2)))
)
)
(setq plst (vl-sort plst '(lambda (x y) (< (car x) (car y)))))
(command "pline")
(foreach p plst
     (command p)
)
(command "")
(setvar "osmode" oldos)
(princ)
)

<<

Filename: 300106_vpl.lsp
Tác giả: q288
Bài viết gốc: 62297
Tên lệnh: qh
Hỏi về thông tin của Spline và một số hàm VL..,Vlax..


Không hiểu mảng bạn nói là gì và ý bạn muốn là giải bài toán hay chỉ đơn giản là từ cái hình bên trái vẽ thành cái hình giống như bên phải,
nếu chỉ là vẽ thì mình có làm cái lisp sau, kết quả ra cũng giống, chỉ có hình thức hơi khác:

Filename: 62297_qh.lsp
Tác giả: phamhung12
Bài viết gốc: 300358
Tên lệnh: mcm
Lisp móng
 ;;Ham ve mc cac thanh thep
(defun mcthep (pd pc d n)
 (setq old (getvar "osmode"))
 (setvar "osmode" 0)
 (setq kc (/ (- (distance pd pc) d) (- n 1)))
 (command ".line" pd pc "")
 
 (setq  a (angle pd pc)
  pd (list (+ (car pd) (/ d 2)) (+ (cadr pd) (/ d 2)))
 )
 
 (repeat n
  (command ".donut" 0 d pd c^)
  (setq pd(polar pd a kc))
 )
 ;;(command ".donut" 0 d (polar pc (+ a (* pi 0.75)) d) c^)
 (setvar "osmode" old)
)
;;Ham ve thep dai va thep chiu luc cua dam...
>>
 ;;Ham ve mc cac thanh thep
(defun mcthep (pd pc d n)
 (setq old (getvar "osmode"))
 (setvar "osmode" 0)
 (setq kc (/ (- (distance pd pc) d) (- n 1)))
 (command ".line" pd pc "")
 
 (setq  a (angle pd pc)
  pd (list (+ (car pd) (/ d 2)) (+ (cadr pd) (/ d 2)))
 )
 
 (repeat n
  (command ".donut" 0 d pd c^)
  (setq pd(polar pd a kc))
 )
 ;;(command ".donut" 0 d (polar pc (+ a (* pi 0.75)) d) c^)
 (setvar "osmode" old)
)
;;Ham ve thep dai va thep chiu luc cua dam mong
(defun vdai (p1 a b n1 n2 d)
 (setq old (getvar "osmode"))
 (setvar "osmode" 0)
 (command ".rectangle" p1 (list (+ (car p1) a) (+ (cadr p1) b)))
 (setq  kc (/ (- a d) (- n1 1))
  p1 (list (+ (car p1) (/ d 2)) (+ (cadr p1) (/ d 2)))
 )
 ;(princ n1)
 (setq p p1)
 (repeat n1
  (command ".donut" 0 d p c^)
  (setq p (polar p 0 kc))
 );end of repeat1
 (setq p (polar p1 (/ pi 2) (- b d)))
 (repeat n1
  (command ".donut" 0 d p c^)
  (setq p (polar p 0 kc))
 );end of repeat2
 (setq  kc (/ (- b d) (- n2 1)))
 (setq p (polar p1 (/ pi 2) kc))
 (repeat (- n2 1)
  (command ".donut" 0 d p c^)
  (setq p (polar p (/ pi 2) kc))
 );end of repeat3
 (setq p (polar p1 0 (- a d)))
 (setq p (polar p (/ pi 2) kc))
 (repeat ( - n2 1)
  (command ".donut" 0 d p c^)
  (setq p (polar p (/ pi 2) kc))
 );end of repeat4
 
 (setvar "osmode" old)
)
;; Chuong trinh chinhs vex mc mongs
(defun c:mcm ()
	(initget 1 "MC MB")
   (setq res (getkword "\n<M.BANG/M.COT><MB/MC>:"))
 (setq   p1 (getpoint "\nDiem chen:")
  l1 (getreal "\nBe rong mong:")
  l2 (getreal "\nBe rong co mong:")
  l3 (/ (- l1 l2) 2)
  h1 (getreal "\nChieu cao ben mong:")
  h2 (getreal "\nChieu cao phan nghieng:")
  h3 (getreal "\nChieu cao co mong:")
  bv (getreal "\nBe day lop bao ve:")
  d (getreal "\nDuong kinh thep:")
  n (getint "\nS.luong thep day mong:")
 l (getreal "\nLop Be tong lot:")
 )
 (setq old (getvar "osmode"))
 (setvar "osmode" 0)
 (setq p (polar p1 pi l))
 (setq p (polar p (/ (- 0 pi) 2) l))
 (command  ".rectangle" p (list (+ (car p) ( * 2 l) l1) (+ (cadr p) l)))
 (command  ".pline" p1 "W" 0 0 (setq p (polar p1 (/ pi 2) h1)) (setq p (list (+ (car p) l3) (+ (cadr p) h2))) (setq p (polar p (/ pi 2) h3)) ""
 )
 (command ".mirror" "l" "" (setq p (polar p1 0 (/ l1 2))) (setq p (polar p (/ pi 2) (/ l1 2))) "")
 
 (IF (= res "MB")
  (progn
   (setq pd (list (+ (car p1) bv) (+ (cadr p1) bv))
   	pc (polar pd 0 (* (- l1 (* 4 bv) l2) 0.5))
 )
  (mcthep pd pc d (fix (* n 0.5)))
 
  (command ".line" pc (setq pc (polar pc 0 (+ l2 (* 2 bv))))  "")
  (setq pd (polar pd 0 (- l1 (* 2 bv))))
 
 (mcthep pc pd d (fix (* n 0.5)))
   (setq  p (list (+ (car p1) l3 bv) (+ (cadr p1) d bv))
	a (- l2 (* 2 bv))
	b (- (+ h1 h2 h3) (* 2 bv) d)
	n1 (getint "\nS.luong thep ngang dam mong:")
	n2 (getint "\nS.luong thep doc dam mong:")
   )
   (vdai p a b n1 n2 d)
  );end of progn1
  (progn
 	(setq pd (list (+ (car p1) bv) (+ (cadr p1) bv))
  pc (polar pd 0 (- l1 (* 2 bv)))
 )
 (mcthep pd pc d n)
   (setq p (list (+ (car p1) l3 bv (- 0 (* 10 d))) (+ (cadr p1) (* 2 d) bv))); end of setq
   (command ".pline" p "W" 0 0  (setq p (polar p 0 (* 10 d)))
	(setq p (polar p (/ pi 2) (+ h1 h2 h3 (* 20 d) (- 0 (* 2 d)  bv))))
	(setq p (polar p (/ (- 0 pi) 4) (* 2 d))) ""
   ); end of co
   (command ".mirror" "l" "" (setq p (polar p1 0 (/ l1 2))) (setq p (polar p (/ pi 2) (/ l1 2))) ""  ); end of co
  );end of progn2
 
 ); end of if
 (setvar "osmode" old)
)


<<

Filename: 300358_mcm.lsp
Tác giả: Tot77
Bài viết gốc: 300611
Tên lệnh: tmp
Hỏi cách link từ file excel vào khung tên trong autocad

Việc này cũng có thể giải quyết bằng lisp. Tôi không rành lắm về lệnh của cad, có thể có lệnh nào đó giải quyết vấn đề này nhưng tạm thời bạn dùng cái lisp dưới đây.

Tuy nhiên có vài vấn đề cần đặt ra là :

1. Trong ô ngày tháng (02/07/2014) và scale của bản vẽ (1:20) trong file excel bạn phải cho format của nó là text (thêm dấu ' đằng trước) , nếu không cad sẽ hiểu đó là...

>>

Việc này cũng có thể giải quyết bằng lisp. Tôi không rành lắm về lệnh của cad, có thể có lệnh nào đó giải quyết vấn đề này nhưng tạm thời bạn dùng cái lisp dưới đây.

Tuy nhiên có vài vấn đề cần đặt ra là :

1. Trong ô ngày tháng (02/07/2014) và scale của bản vẽ (1:20) trong file excel bạn phải cho format của nó là text (thêm dấu ' đằng trước) , nếu không cad sẽ hiểu đó là số chứ không phải text.

2. File dwg và xls ở cùng thư mục và file excel tên là Link.xlsx. Nếu bạn làm 100 cái khung thì nên copy 100 cái khung đó trong cùng bản vẽ, đồng thời ghi 100 dòng trong file excel tương ứng. Tức là khi làm việc chỉ có 1 file cad và 1 excel thôi.

3. Còn 1 vấn đề tôi chưa giải quyết được là font chữ, tức là chữ tiếng việt có dấu không hiển thị được, cái này tính sau.

 

Lisp sẽ hỏi số dòng trong file excel (ở ví dụ này là 2), sau đó nhấp vào cái Attribute Block, nó sẽ điền thông tin từ excel vào cad.

 

Cái này có thể làm hàng loạt nếu trong Dynamic Block của bạn có thêm 1 cái att ghi số dòng (từ 2 -> 101 chẳng hạn), hoặc bạn dùng att có sẵn sửa số cũng được.

(defun c:tmp()
 (setq l0 (list "$DWGNAME1" "$R_DAY0" "$R_DESCR0" "$R_DWR0" "$R_CHK0" "$R_APP0"  "$SCALES"  "$FORMAT"
"$R_DAY0_1" "$TITLE_1" "$TITLE_2" "$TITLE_3"  "$TITLE_4" "$DWGNAME1" "$NR1")
       row (getint "\nChon dong trong file Excel:")
       col 0)
 
 (setq excel (vlax-create-object "Excel.Application")  
       currworkbook (vlax-invoke-method (vlax-get-property excel 'Workbooks)
'Open (strcat (getvar 'dwgprefix) "Link.xlsx"))
       cells (vlax-get-property (vlax-get-property excel 'ActiveSheet) 'Cells))
 (setq l1 (mapcar '(lambda(x) (cons x
(vlax-variant-value (vlax-get-property (vlax-variant-value (vlax-get-property cells 'ITem row (setq col (1+ col)))) 'Value)))) l0))
 
 (setq en (car (entsel "\nChon dynamic Block:")))
 (while (and (setq en (entnext en))
    (/= (cdr (assoc 0 (entget en))) "SEQEND"))
    (if (and (vlax-property-available-p (setq obj (vlax-ename->vla-object en)) 'TagString)
    (setq tm (assoc (vla-get-TagString obj) l1)))
      (vla-put-TextString obj (cdr tm)))
 )
)
 
 

<<

Filename: 300611_tmp.lsp
Tác giả: Tot77
Bài viết gốc: 300952
Tên lệnh: tnt
Languages where to buy acyclovir tablets There are also serious defense implications should Scotland vote for independence, not just for the United Kingdom but for the United States and NATO

Vậy bạn thử cái lisp dưới đây. Vì các ống phân phối tuy nhiều layer khác nhau nhưng đều có màu cyan nên tôi chọn màu này để làm.

Khi chạy ct thì không nên quét toàn bộ bản vẽ , vì do bản vẽ lớn khó kiểm tra kết quả có đúng ý mình không, chỉ nên quét một khoảng nhỏ (tuỳ theo mắt mình nhìn).

(defun c:tnt(/ os mau tt10 tt11 tm tm1 ent it gd n kc)
 ...
>>

Vậy bạn thử cái lisp dưới đây. Vì các ống phân phối tuy nhiều layer khác nhau nhưng đều có màu cyan nên tôi chọn màu này để làm.

Khi chạy ct thì không nên quét toàn bộ bản vẽ , vì do bản vẽ lớn khó kiểm tra kết quả có đúng ý mình không, chỉ nên quét một khoảng nhỏ (tuỳ theo mắt mình nhìn).

(defun c:tnt(/ os mau tt10 tt11 tm tm1 ent it gd n kc)
  (defun dxf(id v) (cdr (assoc id (entget v))))
  (defun ints (o1 o2 mo / l0 l)
    (setq l (vlax-Invoke (vlax-EName->vla-Object o1) "IntersectWith" (vlax-EName->vla-Object o2) mo)
l0 nil)
    (while l
      (setq l0 (append l0 (list (list (car l) (cadr l) (caddr l))))
 l (cdddr l)))
    l0
  )
  (defun mau(/ l1 l0 ent)
    (command "-layer" "on" "*" "")
    (setq l0 '((0 . "LWPOLYLINE") (-4 . "<or")))
    (setq l1 (if (= 4 (cdr (assoc 62 (tblnext "LAYER" t))))
      (append nil (list (cons 8 (cdr (assoc 2 (tblnext "LAYER" t)))))) nil))
    (while (setq ent (tblnext "LAYER"))
      (if (= 4 (cdr (assoc 62 ent))) (setq l1 (append l1 (list (cons 8 (cdr (assoc 2 ent))))))))
    (append l0 (append l1 (list '(-4 . "or>"))))
  )
  ;;;
  (setq os (getvar 'osmode)
mau (mau))
  (setvar 'osmode 0)    
  (foreach x (acet-ss-to-list (ssget '((0 . "LINE") (8 . "DN ONG NGANH PE"))))
    (setq  tt10 (dxf 10 x)  tt11 (dxf 11 x))
    (if (setq tm (ssget "F" (list tt10 tt11) mau))
      (progn
        (setq ent (ssname tm 0))
        (if (setq it (ints x ent acextendnone))
 (setq gd (if (< (distance (car it) tt10) (distance (car it) tt11)) tt10 tt11)
tm (command "trim" ent "" (list x gd) ""))))
      (progn
        (setq n 1 kc 1 tm nil tm1 nil)
(while (not (or (setq tm (ssget "F" (list tt10 (polar tt10 (angle tt11 tt10) kc)) mau))
(setq tm1 (ssget "F" (list tt11 (polar tt11 (angle tt10 tt11) kc)) mau))))
 (setq kc (* (setq n (1+ n)) kc)))
(if tm (command "extend" (ssname tm 0) "" (list x tt10) ""))
(if tm1 (command "extend" (ssname tm1 0) "" (list x tt11) "")))
    )
  )
  (setvar 'osmode os)
  (princ)  
)
 

<<

Filename: 300952_tnt.lsp
Tác giả: truyencd1
Bài viết gốc: 301029
Tên lệnh: udt
Tính tổng diện tích các hình trên bản vẽ, "Ed" vào text sẵn có
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/2490-da-xong-tinh-tong-dien-tich-cac-hinh-tren-ban-ve-ed-vao-text-san-co/page-3
(defun c:udt(/ ss tong ham tmp tt hstl oldim toe frome cur dt)
(prompt "\n Kich thuoc cua chuong trinh tinh theo don vi mm ")
(if (not hstlo) (setq hstlo 0.001))
(setq hstl (getreal (strcat "\n Nhap ti le chuyen doi don vi <" (rtos hstlo 2 3) "> :")))
(if (not hstl) (setq hstl...
>>
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/2490-da-xong-tinh-tong-dien-tich-cac-hinh-tren-ban-ve-ed-vao-text-san-co/page-3
(defun c:udt(/ ss tong ham tmp tt hstl oldim toe frome cur dt)
(prompt "\n Kich thuoc cua chuong trinh tinh theo don vi mm ")
(if (not hstlo) (setq hstlo 0.001))
(setq hstl (getreal (strcat "\n Nhap ti le chuyen doi don vi <" (rtos hstlo 2 3) "> :")))
(if (not hstl) (setq hstl hstlo) (setq hstlo hstl))
(if (not tpo) (setq tpo 2))
(setq tp (getint (strcat "\n Nhap So chu so thap phan <" (itoa tpo) "> :")))
(if (not tp) (setq tp tpo) (setq tpo tp))
(setq oldim (getvar "Dimzin"))
(setvar "Dimzin" 0) 
(prompt "\n Chon doi tuong de tinh dien tich hay Enter de tinh dien tich theo Pick diem ")
(setq
ss (ssget '((-4 . "<OR")(0 . "LWPOLYLINE")(0 . "REGION")(0 . "CIRCLE")(0 . "ARC")(-4 . "OR>"))) 
tong 0.0
ham (lambda (x) (command ".area" "o" x) (setq tong (+ tong (getvar "area"))))
tmp (mapcar 'ham (ss2ent ss)) 
)

(if (not ss) (progn
(setq tong 0.0 ss (ssadd))
(while (setq p (getpoint "\n Pick vao vung tinh dien tich :"))
(setq frome (entlast))
(command ".boundary" p "")
(setq toe (entlast))

(setq cur frome)
(while (not (eq cur toe))
(setq
cur (entnext cur)
ss (ssadd cur ss))
(command "area" "S" "O" ss "" "")
(setq dt (getvar "area"))
(setq tong (+ tong dt))
)
(command "area" "A" "O" "L" "" "")
(setq dt (getvar "area"))
(setq tong (+ tong (* dt 2))) 
(sssetfirst ss ss)
)
(command "erase" ss "")
))


(setq tt (entget (car (entsel "\nChon text ket qua: ")))
tong (vl-string-right-trim "." (vl-string-right-trim "0" (rtos tong)))
)
(entmod (subst (cons 1 (rtos (* (atof tong) hstl hstl) 2 tp)) (assoc 1 tt) tt))

(setvar "Dimzin" oldim)


(princ)
)
;
(defun ss2ent(ss / sodt index lstent)
(setq 
sodt (if ss (sslength ss) 0) 
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)
(princ "\nUpdate Area - free lisp from cadviet.com")
(princ "\nUse UDT command to start!")
(vl-load-com) 

 

Mấy anh em giúp mình cái này với, chuyện là thế này, mình thấy trên diễn đàn có cái lisp tính tổng diện hay mà mình đang cần dùng nhưng nó không ghi ra TEXT trực tiếp mà phải chọn TEXT rồi chuyển TEXT chọn sang diện tích.

Anh e nào có thể giúp mình điều chỉnh lại khi pick xong diện tích chỉ cần ENTER rồi pick tiếp cái nữa là nhập chiều cao chữ rồi điền diện tích tại điểm pick được không, có mình đang cần.

file dinh kèm bên trên nhé !!!!!!!!!!!!!!!


<<

Filename: 301029_udt.lsp
Tác giả: Tot77
Bài viết gốc: 301093
Tên lệnh: ddi
Cần tìm lisp về thiết lập cho toàn bộ Dim

Bạn thử lisp sau, chọn dimstyle nguồn qua 1 đối tượng của nó, sửa thông số, rồi chọn đối tượng thuộc dimstyle đích.

(defun c:ddi(/ a entg0 entg1 li tm name)
  (setq a (car (entsel "\nChon doi tuong thuoc dimstyle nguon:"))
entg0 (tblsearch "DIMSTYLE" (cdr (assoc 3 (entget a)))))
  (command "-dimstyle" "R" (cdr (assoc 3 (entget a))))
  (command "ddim")
  (setq entg1 (tblsearch "DIMSTYLE" (cdr (assoc 3...
>>

Bạn thử lisp sau, chọn dimstyle nguồn qua 1 đối tượng của nó, sửa thông số, rồi chọn đối tượng thuộc dimstyle đích.

(defun c:ddi(/ a entg0 entg1 li tm name)
  (setq a (car (entsel "\nChon doi tuong thuoc dimstyle nguon:"))
entg0 (tblsearch "DIMSTYLE" (cdr (assoc 3 (entget a)))))
  (command "-dimstyle" "R" (cdr (assoc 3 (entget a))))
  (command "ddim")
  (setq entg1 (tblsearch "DIMSTYLE" (cdr (assoc 3 (entget a))))
li (vl-remove nil (mapcar '(lambda(x y)
(if (not (equal x y)) y nil)) entg0 entg1)))
  
  (prompt "\nChon doi tuong thuoc dimstyle dich can doi:")
  (mapcar '(lambda(x)
    (setq name (cdr (assoc 3 (entget x)))
  tm (tblobjname "DIMSTYLE" name))
    (foreach y li
      (entmod (if (assoc (car y) (entget tm))
      (subst y (assoc (car y) (entget tm)) (entget tm))
      (append (entget tm) (list y)))))
    (command "-dimstyle" "R" name)
    (command "-dimstyle" "A" (ssget "X" (list '(0 . "DIMENSION") (cons 3 name))) ""))
 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "DIMENSION")))))))
  
  (princ)
)

<<

Filename: 301093_ddi.lsp
Tác giả: ketxu
Bài viết gốc: 127212
Tên lệnh: d dc da qd dg
Viết lisp theo yêu cầu [phần 2]


Layer : 08-dim

Filename: 127212_d_dc_da_qd_dg.lsp
Tác giả: Tot77
Bài viết gốc: 301138
Tên lệnh: rvx
I"ll put her on how much does phenergan cost without insurance "Finally, it is perhaps best to focus on the family, as it is usual that parents of overweight children are themselves overweight

Ủa bạn xài lisp nào vậy? cái của tôi đâu có hỏi vuông góc gì đâu!!

Thôi gửi lại cho chắc ăn. Lisp này có thể dùng với spline nhưng với cung tròn thì có thể sai vì trên cung tròn không có điểm đầu điểm cuối gì cả. Nếu cung tron thì bạn dùng lệnh array của cad cũng được rồi.

(defun c:rvx(/ pl ss dd dc cd tm sl el en ang dd1 ang1 os)
  (defun thgoc (ent pt...
>>

Ủa bạn xài lisp nào vậy? cái của tôi đâu có hỏi vuông góc gì đâu!!

Thôi gửi lại cho chắc ăn. Lisp này có thể dùng với spline nhưng với cung tròn thì có thể sai vì trên cung tròn không có điểm đầu điểm cuối gì cả. Nếu cung tron thì bạn dùng lệnh array của cad cũng được rồi.

(defun c:rvx(/ pl ss dd dc cd tm sl el en ang dd1 ang1 os)
  (defun thgoc (ent pt / param)
    (if (setq param (vlax-curve-getParamAtPoint ent pt))
      (- (angle '(0 0 0) (vlax-curve-getFirstDeriv ent param)) (/ pi 2))
      nil)
  )
  (command "ucs" "W")
  (setq pl (car (entsel "\nChon duong dan:")))
  (prompt "\nChon doi tuong can rai:")
  (setq ss (ssget)
dd (getpoint "\nDiem bat dau rai (nam tren duong dan) :")
dc (getpoint "\nDiem cuoi cung rai (nam tren duong dan) :")
cd (getreal "\nNhap buoc rai <Enter neu nhap so khoang rai>:")
tm (- (vlax-curve-getDistAtPoint pl dc) (vlax-curve-getDistAtPoint pl dd)))
  (if (< tm 0) (setq lenh -) (setq lenh +))
  (if (not cd)
    (setq sl (getint "\nNhap so khoang rai:")
 cd (/ (abs tm) sl))
    (setq sl (fix (/ (abs tm) cd))))
  
  (setq os (getvar "OSMODE"))  
  (setvar "OSMODE" 0)
  (repeat sl
    (setq el (entlast)
 ang (thgoc pl dd))
    (command "copy" ss "" dd (setq dd1 (vlax-curve-getPointAtDist pl
(lenh (vlax-curve-getDistAtPoint pl dd) cd))))
    (setq ss (ssadd)
 dd dd1
 ang1 (thgoc pl dd))
    (while (setq en (entnext el))
      (ssadd en ss)
      (setq el en))
    (command "rotate" ss "" dd "r" dd (polar dd ang 1) (polar dd ang1 1))
    )  
  (setvar "OSMODE" os) (command "ucs" "p")
  (princ)
)
 
 
 
 

<<

Filename: 301138_rvx.lsp
Tác giả: 18011985
Bài viết gốc: 111053
Tên lệnh: thu
Sắp xếp đỉnh polyline

Bác philip ui, lisp của bác tạo thêm 1 node nữa nên không thích hợp với công việc của em lắm. Em đã viết 1 đoạn code và có chút vướng mắc mong các bác chỉ cho.
Tại những polyline có arc khi thay đổi chiều của các đỉnh thì nó bị lệch các bác chỉ giúp em làm sao để nó không lệch nữa với. THANKS

Filename: 111053_thu.lsp
Tác giả: Chiron
Bài viết gốc: 238780
Tên lệnh: mly
[Thư Viện] Tập hợp một số hàm entmake object

bỏ hết if đi xem sao.

Đã thử rồi bác, không có tác dụng chi hết.

(defun c:mly ()
(MakeLayer "1" 2 "Continuous" 0.3 1)
)

Đổi thử màu layer 1 thành màu 5 rồi chạy lại. Màu của layer 1 vẫn là màu số 5 chứ không phải màu số 2 như mình muốn.


Filename: 238780_mly.lsp
Tác giả: lyky
Bài viết gốc: 274716
Tên lệnh: test
Lisp vẽ đoạn thẳng giữa 2 đoạn thẳng?

Thuật toán trên không đúng trong trường hợp tổng quát là 2 line bất kỳ. Nếu 2 line // mà có phương // trục x hoặc y và ngược chiều nhau (VD explode 1 HCN) kết quả cũng sai.
Với 2 line AB và CD cần so sánh tổng AC+BD và AD+BC để quyết định

>>

Thuật toán trên không đúng trong trường hợp tổng quát là 2 line bất kỳ. Nếu 2 line // mà có phương // trục x hoặc y và ngược chiều nhau (VD explode 1 HCN) kết quả cũng sai.
Với 2 line AB và CD cần so sánh tổng AC+BD và AD+BC để quyết định

không quan tâm 2 line co song song hay không, chỉ cần vẽ đường giữa là đủ.

Thêm osmode kẻo nguy hiểm.

 
Bạn Tot77 đã không hiểu ý bác NDT rồi.
 
1/- Nếu bạn vẽ một HCN (// hệ trục Oxy) rồi nổ ra, chọn 2 đoạn đối diện (là 2 đoạn song song ngược chiều) để test thì kết quả cho ra đường chéo (chứ không phải đường trung bình?!!)
 

22665_lyky_3.jpg

 
2/- Nếu bạn vẽ một HCN rồi quay đi một góc nào đó, sau đó nổ ra, test sẽ cho ra kết qủa là một đoạn thẳng có chiều dài bằng 0, vì điểm đầu điểm cuối trùng nhau?! (Tương đương một điểm).
 
3/- Không cần đâu 2 đường thẳng song song, chỉ cần 2 đường thẳng trái chiều là LISP của bạn đã trả ra kết quả sai rồi?!
 
4/- Có một điều rất kì quặc trong code của bạn Tot77:
(defun c:test(/ n ss l1 l2 cl)
....
(setq n 0)
(while (/= 2 n)
....
Đặt: n = 0 thì đương nhiên là: 0 ≠ 2 chứ mắc mớ gì phải kiểm tra rồi mới chạy vòng lặp?!
 
5/- Trước dòng (command "line" (midp (car l1) (car l2)) (midp (last l1) (last l2)) ""), bạn nên đặt OSMODE bằng 0 để tắt chế độ bắt điểm - đối với những đường line gần nhau - nếu không làm vậy sẽ xuất ra kết quả sai (đặc biệt là đối với bài toán mà chúng tôi đề nghị sau đây, ở mục ).
 
6/- Bạn nên thêm vào code: Kiểm tra xem bản vẽ đã có sẵn layer "DUONG BAO" chưa, nếu đã có, đặt hiện hành nó trước khi vẽ line, nếu không, tạo layer "DUONG BAO" trước rồi mới đặt hiện hành, vẽ line xong, phục hồi về layer cũ... Nếu không làm như vậy, trong bản vẽ chưa có sẵn layer "DUONG BAO" lisp sẽ báo lỗi.
 
7/- Vì sao chúng ta không mở rộng bài toán này cho trường hợp vẽ n đoạn thẳng "rải xoè quạt" bên trong 2 đoạn thẳng ban đầu chọn làm biên? Bài toán này sẽ ứng dụng trong vẽ kết cấu mặt sàn dạng hình thang, cốt thép rải xòe quạt.
<<

Filename: 274716_test.lsp
Tác giả: pikeman286
Bài viết gốc: 13036
Tên lệnh: mc
PDF to DWG Converter V.1.4.0.1
Sao minh down về nó lại không giống file Instart nhỉ?Hay không cài được định dạng này :)

Filename: 13036_mc.lsp
Tác giả: ndtnv
Bài viết gốc: 55937
Tên lệnh: dsc
Viết Lisp theo yêu cầu

Do không có thời gian nên mình chỉ test trên các đường trong bản vẽ mẫu, vì vậy có lỗi khi đường chuẩn là spline.
-Đánh số không đúng là vì mình đã nói hàm TachTen là hàm giả, trị default mình lấy theo bản vẽ mẫu.
Bạn nên sửa lại theo lisp của bạn để cho đúng với các trường hợp khác. Nếu không thì mỗi khi chạy với trị default khác, bạn sửa trực tiếp trong lisp này...
>>

Do không có thời gian nên mình chỉ test trên các đường trong bản vẽ mẫu, vì vậy có lỗi khi đường chuẩn là spline.
-Đánh số không đúng là vì mình đã nói hàm TachTen là hàm giả, trị default mình lấy theo bản vẽ mẫu.
Bạn nên sửa lại theo lisp của bạn để cho đúng với các trường hợp khác. Nếu không thì mỗi khi chạy với trị default khác, bạn sửa trực tiếp trong lisp này theo:
pre: tiền tố, id: số bắt đầu, pos: hậu tố đã bớt ký tự cuối nếu là ABCabc
asc=97 nếu là abc, =65 nếu là ABC. nếu không thì là nil
las= 0: A,a, =1: B,b, =2: C,c
-Lý do mất hết các object snap đã chọn là vì có lỗi nên dòng lệnh khôi phục lại object snap không thực hiện được
Đây là lisp đã fix lỗi spline

<<

Filename: 55937_dsc.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 301499
Tên lệnh: chk
Đố vui với LISP

Trước khi xem Germany và Brasil đá bán kết, mời các bạn cùng thư giản với câu đố vui sau:

Trong mặt phẳng cho 4 điểm bất kỳ p1, p2, p3, p4.

Hãy thiết lập hàm kiểm tra xem 4 điểm đó có tạo thành 1 hình chữ nhật hay không? Hàm trả về T nếu nó tạo thành HCN, nil nếu không.

Điều kiện: càng ít...

>>

Trước khi xem Germany và Brasil đá bán kết, mời các bạn cùng thư giản với câu đố vui sau:

Trong mặt phẳng cho 4 điểm bất kỳ p1, p2, p3, p4.

Hãy thiết lập hàm kiểm tra xem 4 điểm đó có tạo thành 1 hình chữ nhật hay không? Hàm trả về T nếu nó tạo thành HCN, nil nếu không.

Điều kiện: càng ít cặp () càng có giá trị.

Hề hề hề,

Thử tài tí chơi.

(defun c:chk (/ p1 p2 p3 p4)
 (and (= (distance p1 p2) (distance p3 p4)) (= (distance p1 p3) (distance p2 p4)) (= (distance p1 p4) (distance p2 p3)))
)

<<

Filename: 301499_chk.lsp
Tác giả: giang_081190
Bài viết gốc: 301741
Tên lệnh: flat
Thắc mắc lisp xuất cạnh của line

Em tìm được lisp Flat trên diễn đàn để chuyển Z=0 rồi ạ.:D
Cảm ơn các bác, các anh em.:D

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/54646-yeu-cau-chuyen-cao-do-z-cua-cac-loai-doi-tuong-ve-z-0/
(defun c:flat ( / acsel elv ) (vl-load-com)
  (if (ssget "_X" (list (cons 410 (getvar 'CTAB))))
	(progn
  	(vlax-for obj
    	(setq acsel
      	(vla-get-ActiveSelectionSet
     ...
>>

Em tìm được lisp Flat trên diễn đàn để chuyển Z=0 rồi ạ.:D
Cảm ơn các bác, các anh em.:D

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/54646-yeu-cau-chuyen-cao-do-z-cua-cac-loai-doi-tuong-ve-z-0/
(defun c:flat ( / acsel elv ) (vl-load-com)
  (if (ssget "_X" (list (cons 410 (getvar 'CTAB))))
	(progn
  	(vlax-for obj
    	(setq acsel
      	(vla-get-ActiveSelectionSet
        	(vla-get-ActiveDocument (vlax-get-acad-object))
      	)
    	)
    	(foreach elv '(1e99 -1e99)
      	(vl-catch-all-apply 'vla-move
        	(list obj (vlax-3D-point '(0. 0. 0.)) (vlax-3D-point (list 0. 0. elv)))
      	)
    	)
  	)
  	(vla-delete acsel)
	)
  )
  (princ)
)


<<

Filename: 301741_flat.lsp
Tác giả: Tot77
Bài viết gốc: 301890
Tên lệnh: ctnc
From: Lisp công trừ trong text

Bạn thử cái này. Khi nó hỏi "Phep tinh:" thì bạn gõ vào, thí dụ "+2" hay "-3" , "*4", "/5" thì nó sẽ đổi.

Cái này chỉ dùng với text, không dùng cho mtext và nếu trong chữ có nhiều số thì chỉ đổi số đầu tiên.

(defun C:ctnc(/ tg obj nd so nd1)
  (setvar 'dimzin 8)
  (setq tg (getstring "\nPhep tinh:" ))  
  (foreach v (vl-remove-if 'listp (mapcar 'cadr (ssnamex  (ssget (list...
>>

Bạn thử cái này. Khi nó hỏi "Phep tinh:" thì bạn gõ vào, thí dụ "+2" hay "-3" , "*4", "/5" thì nó sẽ đổi.

Cái này chỉ dùng với text, không dùng cho mtext và nếu trong chữ có nhiều số thì chỉ đổi số đầu tiên.

(defun C:ctnc(/ tg obj nd so nd1)
  (setvar 'dimzin 8)
  (setq tg (getstring "\nPhep tinh:" ))  
  (foreach v (vl-remove-if 'listp (mapcar 'cadr (ssnamex  (ssget (list '(0 . "TEXT") )))))
    (setq nd (vla-get-TextString (setq obj (vlax-ename->vla-object v)))
 so (rtos (atof (vl-list->string (mapcar '(lambda(x) (if (or (= 46 x) (<= 48 x 57)) x 32)) (vl-string->list nd)))))
 nd1 (rtos (cal (strcat so tg)))
 nd (vl-string-subst nd1 so nd)
    )
    (vla-put-TextString obj nd)
   )
)

<<

Filename: 301890_ctnc.lsp
Tác giả: giang_081190
Bài viết gốc: 301676
Tên lệnh: dd
Thắc mắc lisp xuất cạnh của line

Em có file CaD và em cần xuất cạnh của 1 cạnh như sau ạ

http://www.cadviet.com/upfiles/3/37777_nghiapeo.lsp

http://www.cadviet.com/upfiles/3/37777_thac_mac.dwg

 

Đây là file lisp và file CAD em thắc mắc ạ.

>>

Em có file CaD và em cần xuất cạnh của 1 cạnh như sau ạ

http://www.cadviet.com/upfiles/3/37777_nghiapeo.lsp

http://www.cadviet.com/upfiles/3/37777_thac_mac.dwg

 

Đây là file lisp và file CAD em thắc mắc ạ.

2014fd65b76f-3ebf-41d8-b91d-10bafd4f7c30

Sẽ chẳng vấn đề gì khi như mọi file khác em dùng lisp trên xuất từng cạnh mình cần

Nhưng khi em xuất cạnh ở file CAD trên bằng Lisp ở trên luôn thì no hiện là hiện 3D length (Mục 3) = 2.58

Hay khi em dùng lệnh DI ( Distance ) thì nó hiện kết quả là 1.47

Nhưng chiều dài thực tế của line này là 0.37 (Mục 2 ) ạ. 

Bác nào giải thích giúp em với.

 

Em dùng máy Toàn đạc điện tử Gowin xuất ra tọa độ rồi triển điểm lên CAD ạ. @@

Nhiều file bị chứ k riêng file em ví dụ này.   =>> Các máy toàn đạc khác thì em chưa thử. @@

 

// Mong các bác giải thích cho em với. :(

 

Đây là nội dung lisp ạ.@@

(defun c:dd ( )
(command "undo" "be")
  (command "-style" "ktdt" "VNI-HELVE" "0" "1" "0" "n" "n")
  (if (null dolora)(setq dolora "1"))
(Setq temp T)
(While temp
(setq a (strcat "\nD lon text hien hanh la (" dolora ") /<Diem dau tien>: "))
(Initget "d D")
(setq str (getpoint a))
(Cond
  ((= str "d") (setq dolora (getstring (strcat"\nDo lon text <" dolora "> :"))))
  ((= str "D") (setq dolora (getstring (strcat"\nDo lon text <" dolora "> :"))))
   (Progn
  (Setq a str)
   (setq temp nil)
  )
)
)
 
(setq b (getpoint a"\nChon diem tiep theo: "))
(setq luubatdiem (getvar "osmode"))
  (setvar "osmode" 0)
	(setq doclora (atof dolora))
	(setq gocxeo(angle a B))
	(setq daiab (Distance a B))
	(setq c (polar a gocxeo (/ daiab 2)))
	(setq d (polar c (+ gocxeo (/ pi 2)) (/ doclora 4)))
 z
(command ".line" a b "")
(command "text" "j" "c" c doclora b (rtos daiab 2 2) "")
(command ".move" "last" "" c d)
(cond
((> gocxeo (/ pi 2)) (command ".rotate" "last" "" c 0))
)
(setvar "osmode" luubatdiem)
(command "undo" "end")
	(Princ)
)

<<

Filename: 301676_dd.lsp
Tác giả: ssg
Bài viết gốc: 13063
Tên lệnh: cadviet
Chuyển số từ cad sang Excel

Bạn hãy post lên 2 file: 1 file *.dwg bạn có và 1 file *.xls ghi kết quả bạn muốn, kèm theo các ghi chú giải thích rõ hơn nếu thấy cần thiết.

Filename: 13063_cadviet.lsp

Trang 163/330

163