Jump to content
InfoFile
Tác giả: luanpq86
Bài viết gốc: 414193
Tên lệnh: p2e
Nhờ viết lisp dim kích thước các pline và xuất ra file cel

 

Nhờ các bác viết dùm lisp như này:

- Lisp 1: ghi kích thước theo dimstyle hiện hành

Có các thanh thép là các đường...

>>

 

Nhờ các bác viết dùm lisp như này:

- Lisp 1: ghi kích thước theo dimstyle hiện hành

Có các thanh thép là các đường pline, line như trong file đính kèm (phần "ban đầu"), em muốn đo các kích thước của các thanh thép đó như phần "Dùng lisp" có cả kích thước chiều dài cung tròn, kích thước bán kính cung tròn, góc nghiêng.

Chú ý là thanh X3 đo kích thước cung tròn bằng lệnh 'dar' thì không đẹp, các bác có thể viết lisp thay thế bằng lệnh đo góc 'dan' mà giá trị ghi vẫn là chiều dài cung đó được ko.

- Lisp 2: Tính chiều dài và điền vào text, xuất sang cel

Cụ thể là pick vào từng thanh một sẽ tính chiều dài thanh đó (có thể là line hoặc pline) rồi pick vào từng text sẽ điền giá trị chiều dài thanh đó vào phần cuối của text.

VD: pick vào hình vẽ thanh X1 sẽ hiện lên command "điền giá trị vào text" rồi pick vào text "x1-d25, l=" sẽ thành "x1-d25, l=4545", sau đó hiện lên command "chọn thanh tiếp theo" pick vào thanh x2 rồi pick vào text "x2-d16, l=" v.v.....

Kết thúc bằng lệnh enter sẽ xuất chiều dài các thanh vừa pick sang file excel với giá trị chiều dài các thanh nằm trên 1 cột như file đính kèm

 

http://www.cadviet.com/upfiles/3/83908_cotthep_1.rar

Mong các bác giúp đỡ, em xin cám ơn trước.

 

P/S: Em cũng tìm mấy hôm trên diễn đàn về lisp tính chiều dài pline và xuất sang excel thì chưa tìm được lisp đúng ý.

Lisp này thì tính chiều dài từng phần trong pline mà ko tính tổng, lại ko tính liên tục các pline được, nhờ các bác sửa giúp em

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=43033
(defun c:p2E(/ i ent ss lstV pt_lst nb)
; Polyline Vertex Length to Excel
; @ gia_bach
  (vl-load-com)
  (if (setq ss (ssget (list (cons 0 "*POLYLINE"))))
    (progn
    (repeat (setq i (sslength ss))
	(setq ent (ssname ss (setq i (1- i))) 
		  nb (strcat "Pline " (rtos (- (sslength ss) i) 2 0)) 
		  lstV (append (list(list nb))(pll ent)))
	(foreach pt lstV
	  (setq pt_lst (append pt_lst (list pt)))
	))	  
      (if (vlax-get-or-create-object "Excel.Application")
	(WriteToExcel pt_lst)
	(WriteToCSV pt_lst) )))
  (princ))

(defun WriteToExcel (lst_data / col row x xlApp xlCells)
  (setq xlApp (vlax-get-or-create-object "Excel.Application")
	xlCells (vlax-get-property
		  (vlax-get-property
		    (vlax-get-property
		      (vlax-invoke-method
			(vlax-get-property xlApp "Workbooks")
			"Add")
		      "Sheets")
		    "Item" 1)
		  "Cells"))
  (setq row 3)
  (foreach pt lst_data
    (setq col 3)
    (foreach coor pt
      (vlax-put-property xlCells 'Item row col coor)
      (setq col (1+ col)))
    (setq row (1+ row)) )
  (vla-put-visible xlApp :vlax-true)
  (mapcar
    (function (lambda (x)
		(vl-catch-all-apply (function (lambda ()(if x (vlax-release-object x)))))))
    (list xlCells xlApp))
  (gc) (gc) )

(defun WriteToCSV (lst_data / fl)  
  (if (setq fl (getfiled "Output File" "" "csv" 1))
    (if (setq fl (open fl "w"))
      (progn
	(foreach pt lst_data 
	  (write-line (strcat (rtos (car pt)) "," (rtos (cadr pt)) "," (rtos (caddr pt))) fl) )
	(close fl) ) ) )
  (princ))
  
  
  
  (defun pll ( e / j)         
  (setq j (1- (vlax-curve-getStartParam e)) lst '())
  (while (<= (setq j (1+ j)) (vlax-curve-getEndParam e))
    (setq lst
        (cons 
          (list (- (vlax-curve-getDistatParam e j)
             (if (zerop j) 0
             (vlax-curve-getDistatParam e (1- j)))))
		lst
		)
	)
  )
	(setq lst (cdr (reverse lst)))
	lst
)

 

Hoặc lisp này thì lại chỉ tính được line:

(defun c:btk ( / plst e p0 p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 n i obj els pa pf ps len txt fn fw ans)
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq plst (list)  i 0)
(alert "\n Chon cac doan can thong ke")
(setq e  (entsel "\n Chon doan can thong ke"))
(While e
        (princ (strcat " 1 found. " (rtos (1+ i) 2 0) "total"))
        (setq plst (cons e plst)
                  e (entsel "\n Chon doan tiep theo")
                  i (1+ i)
        )
)
(setq plst (reverse plst))
(setq p1 (getpoint "\n Chon diem dat bang thong ke")
          p2 (polar p1 0 2.5)
          p3 (polar p2 0 5.5)
          p4 (polar p3 0 5.5)
          p5 (polar p4 0 5.5)
          n (length plst)
          p6 (polar p1 (* 1.5 pi) (* (1+ n) 1.5))
          p7 (polar p2 (* 1.5 pi) (* (1+ n) 1.5))
          p8 (polar p3 (* 1.5 pi) (* (1+ n) 1.5))
          p9 (polar p4 (* 1.5 pi) (* (1+ n) 1.5))
          p10 (polar p5 (* 1.5 pi) (* (1+ n) 1.5))
)
(command "line" p1 p5 p10 p6 p1 "")
(command "line" p2 p7 "")
(command "line" p3 p8 "")
(command "line" p4 p9 "")
(styleset)
(command "text" "j" "mc" (list (+ (car p1) 1.25) (- (cadr p1) 0.75)) 0.3 0 "TT  ÐO\\U+1EA0N" )
(command "text" "j" "mc" (list (+ (car p2) 2.75) (- (cadr p1) 0.75)) 0.3 0 "T\\U+1EEA  ÐI\\U+1EC2M" )
(command "text" "j" "mc" (list (+ (car p3) 2.75) (- (cadr p1) 0.75)) 0.3 0 "T\\U+1EDAI  ÐI\\U+1EC2M" )
(command "text" "j" "mc" (list (+ (car p4) 2.75) (- (cadr p1) 0.75)) 0.3 0 "CHI\\U+1EC0U  DÀI")
(command "text" "j" "mc" (list (+ (car p1) 9.5) (+ (cadr p1) 0.5 )) 0.5 0 "B\\U+1EA2NG XU\\U+1EA4T RA K\\U+1EBET QU\\U+1EA2")
(setq ans (getstring "\n Ban muon luu sang file cvs khong?? <Y or N>: "))
(if (= (strcase ans) "Y")
    (progn
            (setq fn (getfiled "Chon file de save" "" "csv" 1)
   	       fw (open fn "w"))
       	(princ  "BANG XUAT TOA DO RA FILE CSV \n" fw)
                  (princ " TT doan , Tu diem , Toi diem , Chieu dai \n" fw)
   )
)
(setq i 0)
(foreach a plst
   	(setq i (1+ i)
                obj (vlax-ename->vla-object (car a))
                els (entget (car a))
                p0 (polar p1 (* 1.5 pi) 1.5)
                p1 p0
   	)
   	(cond
         	( (or (= (cdr (assoc 0 els)) "LWPOLYLINE") (= (cdr (assoc 0 els)) "POLYLINE"))
                  (setq pa (vlax-curve-getparamatpoint obj (vlax-curve-getclosestpointto obj (cadr a)))
                            pf (vlax-curve-getpointatparam obj (fix pa))
                            ps (vlax-curve-getpointatparam obj (1+ (fix pa)))
                            len (- (vlax-curve-getdistatpoint obj ps) (vlax-curve-getdistatpoint obj pf))                          
                  ) )
         	( (= (cdr (assoc 0 els)) "LINE")
                  (setq pf (cdr (assoc 10 els))
                       	ps (cdr (assoc 11 els))
                       	len (distance pf ps)
                  ) )
         	( (or (= (cdr (assoc 0 els)) "SPLINE") (=  (cdr (assoc 0 els)) "ARC") )
                  (setq pf (vlax-curve-getstartpoint obj)
                       	ps (vlax-curve-getendpoint obj)
                       	len (vlax-curve-getdistatpoint obj ps)
                  ) )
         	(T nil)
   	)
   	(setq txt (strcat (rtos i 2 0) "," "X=" (rtos (car pf) 2 4) "  Y=" (rtos (cadr pf) 2 4) "," "X=" (rtos (car ps) 2 4) "  Y=" (rtos (cadr ps) 2 4) "," (rtos len 2 4) "\n"))
   	(command "line" p0 (polar p0 0 19) "")
   	(command "text" "j" "mc" (list (+ (car p0) 1.25) (- (cadr p0) 0.75)) 0.2 0 (rtos i 2 0) )
   	(command "text" "j" "mc" (list (+ (car p0) 5.25) (- (cadr p1) 0.75)) 0.2 0 (strcat "X=" (rtos (car pf) 2 4) "  Y=" (rtos (cadr pf) 2 4)) )
   	(command "text" "j" "mc" (list (+ (car p0) 10.75) (- (cadr p1) 0.75)) 0.2 0 (strcat "X=" (rtos (car ps) 2 4) "  Y=" (rtos (cadr ps) 2 4)) )
   	(command "text" "j" "mc" (list (+ (car p0) 16.25) (- (cadr p1) 0.75)) 0.2 0 (rtos len 2 4))
   	(if (= (strcase ans) "Y")
       	(princ txt fw)
   	)
)
(if fw
   (close fw)
)
(setvar "osmode" oldos)
(command "undo" "e")
(princ)
)
 
(defun styleset ()
(setq stl (getvar "textstyle")
     	h (getvar "textsize"))
(if (/= h 0) (command "style" stl "" 0 "" "" "" "" ""))
)                  

 

 

Nhờ các bác viết dùm lisp như này:

- Lisp 1: ghi kích thước theo dimstyle hiện hành

Có các thanh thép là các đường pline, line như trong file đính kèm (phần "ban đầu"), em muốn đo các kích thước của các thanh thép đó như phần "Dùng lisp" có cả kích thước chiều dài cung tròn, kích thước bán kính cung tròn, góc nghiêng.

Chú ý là thanh X3 đo kích thước cung tròn bằng lệnh 'dar' thì không đẹp, các bác có thể viết lisp thay thế bằng lệnh đo góc 'dan' mà giá trị ghi vẫn là chiều dài cung đó được ko.

- Lisp 2: Tính chiều dài và điền vào text, xuất sang cel

Cụ thể là pick vào từng thanh một sẽ tính chiều dài thanh đó (có thể là line hoặc pline) rồi pick vào từng text sẽ điền giá trị chiều dài thanh đó vào phần cuối của text.

VD: pick vào hình vẽ thanh X1 sẽ hiện lên command "điền giá trị vào text" rồi pick vào text "x1-d25, l=" sẽ thành "x1-d25, l=4545", sau đó hiện lên command "chọn thanh tiếp theo" pick vào thanh x2 rồi pick vào text "x2-d16, l=" v.v.....

Kết thúc bằng lệnh enter sẽ xuất chiều dài các thanh vừa pick sang file excel với giá trị chiều dài các thanh nằm trên 1 cột như file đính kèm

 

http://www.cadviet.com/upfiles/3/83908_cotthep_1.rar

Mong các bác giúp đỡ, em xin cám ơn trước.

 

P/S: Em cũng tìm mấy hôm trên diễn đàn về lisp tính chiều dài pline và xuất sang excel thì chưa tìm được lisp đúng ý.

Lisp này thì tính chiều dài từng phần trong pline mà ko tính tổng, lại ko tính liên tục các pline được, nhờ các bác sửa giúp em

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=43033
(defun c:p2E(/ i ent ss lstV pt_lst nb)
; Polyline Vertex Length to Excel
; @ gia_bach
  (vl-load-com)
  (if (setq ss (ssget (list (cons 0 "*POLYLINE"))))
    (progn
    (repeat (setq i (sslength ss))
	(setq ent (ssname ss (setq i (1- i))) 
		  nb (strcat "Pline " (rtos (- (sslength ss) i) 2 0)) 
		  lstV (append (list(list nb))(pll ent)))
	(foreach pt lstV
	  (setq pt_lst (append pt_lst (list pt)))
	))	  
      (if (vlax-get-or-create-object "Excel.Application")
	(WriteToExcel pt_lst)
	(WriteToCSV pt_lst) )))
  (princ))

(defun WriteToExcel (lst_data / col row x xlApp xlCells)
  (setq xlApp (vlax-get-or-create-object "Excel.Application")
	xlCells (vlax-get-property
		  (vlax-get-property
		    (vlax-get-property
		      (vlax-invoke-method
			(vlax-get-property xlApp "Workbooks")
			"Add")
		      "Sheets")
		    "Item" 1)
		  "Cells"))
  (setq row 3)
  (foreach pt lst_data
    (setq col 3)
    (foreach coor pt
      (vlax-put-property xlCells 'Item row col coor)
      (setq col (1+ col)))
    (setq row (1+ row)) )
  (vla-put-visible xlApp :vlax-true)
  (mapcar
    (function (lambda (x)
		(vl-catch-all-apply (function (lambda ()(if x (vlax-release-object x)))))))
    (list xlCells xlApp))
  (gc) (gc) )

(defun WriteToCSV (lst_data / fl)  
  (if (setq fl (getfiled "Output File" "" "csv" 1))
    (if (setq fl (open fl "w"))
      (progn
	(foreach pt lst_data 
	  (write-line (strcat (rtos (car pt)) "," (rtos (cadr pt)) "," (rtos (caddr pt))) fl) )
	(close fl) ) ) )
  (princ))
  
  
  
  (defun pll ( e / j)         
  (setq j (1- (vlax-curve-getStartParam e)) lst '())
  (while (<= (setq j (1+ j)) (vlax-curve-getEndParam e))
    (setq lst
        (cons 
          (list (- (vlax-curve-getDistatParam e j)
             (if (zerop j) 0
             (vlax-curve-getDistatParam e (1- j)))))
		lst
		)
	)
  )
	(setq lst (cdr (reverse lst)))
	lst
)

 

Hoặc lisp này thì lại chỉ tính được line:

(defun c:btk ( / plst e p0 p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 n i obj els pa pf ps len txt fn fw ans)
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq plst (list)  i 0)
(alert "\n Chon cac doan can thong ke")
(setq e  (entsel "\n Chon doan can thong ke"))
(While e
        (princ (strcat " 1 found. " (rtos (1+ i) 2 0) "total"))
        (setq plst (cons e plst)
                  e (entsel "\n Chon doan tiep theo")
                  i (1+ i)
        )
)
(setq plst (reverse plst))
(setq p1 (getpoint "\n Chon diem dat bang thong ke")
          p2 (polar p1 0 2.5)
          p3 (polar p2 0 5.5)
          p4 (polar p3 0 5.5)
          p5 (polar p4 0 5.5)
          n (length plst)
          p6 (polar p1 (* 1.5 pi) (* (1+ n) 1.5))
          p7 (polar p2 (* 1.5 pi) (* (1+ n) 1.5))
          p8 (polar p3 (* 1.5 pi) (* (1+ n) 1.5))
          p9 (polar p4 (* 1.5 pi) (* (1+ n) 1.5))
          p10 (polar p5 (* 1.5 pi) (* (1+ n) 1.5))
)
(command "line" p1 p5 p10 p6 p1 "")
(command "line" p2 p7 "")
(command "line" p3 p8 "")
(command "line" p4 p9 "")
(styleset)
(command "text" "j" "mc" (list (+ (car p1) 1.25) (- (cadr p1) 0.75)) 0.3 0 "TT  ÐO\\U+1EA0N" )
(command "text" "j" "mc" (list (+ (car p2) 2.75) (- (cadr p1) 0.75)) 0.3 0 "T\\U+1EEA  ÐI\\U+1EC2M" )
(command "text" "j" "mc" (list (+ (car p3) 2.75) (- (cadr p1) 0.75)) 0.3 0 "T\\U+1EDAI  ÐI\\U+1EC2M" )
(command "text" "j" "mc" (list (+ (car p4) 2.75) (- (cadr p1) 0.75)) 0.3 0 "CHI\\U+1EC0U  DÀI")
(command "text" "j" "mc" (list (+ (car p1) 9.5) (+ (cadr p1) 0.5 )) 0.5 0 "B\\U+1EA2NG XU\\U+1EA4T RA K\\U+1EBET QU\\U+1EA2")
(setq ans (getstring "\n Ban muon luu sang file cvs khong?? <Y or N>: "))
(if (= (strcase ans) "Y")
    (progn
            (setq fn (getfiled "Chon file de save" "" "csv" 1)
   	       fw (open fn "w"))
       	(princ  "BANG XUAT TOA DO RA FILE CSV \n" fw)
                  (princ " TT doan , Tu diem , Toi diem , Chieu dai \n" fw)
   )
)
(setq i 0)
(foreach a plst
   	(setq i (1+ i)
                obj (vlax-ename->vla-object (car a))
                els (entget (car a))
                p0 (polar p1 (* 1.5 pi) 1.5)
                p1 p0
   	)
   	(cond
         	( (or (= (cdr (assoc 0 els)) "LWPOLYLINE") (= (cdr (assoc 0 els)) "POLYLINE"))
                  (setq pa (vlax-curve-getparamatpoint obj (vlax-curve-getclosestpointto obj (cadr a)))
                            pf (vlax-curve-getpointatparam obj (fix pa))
                            ps (vlax-curve-getpointatparam obj (1+ (fix pa)))
                            len (- (vlax-curve-getdistatpoint obj ps) (vlax-curve-getdistatpoint obj pf))                          
                  ) )
         	( (= (cdr (assoc 0 els)) "LINE")
                  (setq pf (cdr (assoc 10 els))
                       	ps (cdr (assoc 11 els))
                       	len (distance pf ps)
                  ) )
         	( (or (= (cdr (assoc 0 els)) "SPLINE") (=  (cdr (assoc 0 els)) "ARC") )
                  (setq pf (vlax-curve-getstartpoint obj)
                       	ps (vlax-curve-getendpoint obj)
                       	len (vlax-curve-getdistatpoint obj ps)
                  ) )
         	(T nil)
   	)
   	(setq txt (strcat (rtos i 2 0) "," "X=" (rtos (car pf) 2 4) "  Y=" (rtos (cadr pf) 2 4) "," "X=" (rtos (car ps) 2 4) "  Y=" (rtos (cadr ps) 2 4) "," (rtos len 2 4) "\n"))
   	(command "line" p0 (polar p0 0 19) "")
   	(command "text" "j" "mc" (list (+ (car p0) 1.25) (- (cadr p0) 0.75)) 0.2 0 (rtos i 2 0) )
   	(command "text" "j" "mc" (list (+ (car p0) 5.25) (- (cadr p1) 0.75)) 0.2 0 (strcat "X=" (rtos (car pf) 2 4) "  Y=" (rtos (cadr pf) 2 4)) )
   	(command "text" "j" "mc" (list (+ (car p0) 10.75) (- (cadr p1) 0.75)) 0.2 0 (strcat "X=" (rtos (car ps) 2 4) "  Y=" (rtos (cadr ps) 2 4)) )
   	(command "text" "j" "mc" (list (+ (car p0) 16.25) (- (cadr p1) 0.75)) 0.2 0 (rtos len 2 4))
   	(if (= (strcase ans) "Y")
       	(princ txt fw)
   	)
)
(if fw
   (close fw)
)
(setvar "osmode" oldos)
(command "undo" "e")
(princ)
)
 
(defun styleset ()
(setq stl (getvar "textstyle")
     	h (getvar "textsize"))
(if (/= h 0) (command "style" stl "" 0 "" "" "" "" ""))
)                  

Mình muốn lấy chiều dài đường polyline sau khi vẽ trên cad chuyển đến ô cell mà con trỏ hiện hành trong file excel mình đang mở sẵn rồi chứ không phải là book mới thì làm sao bạn?? thanks


<<

Filename: 414193_p2e.lsp
Tác giả: littlerock
Bài viết gốc: 116727
Tên lệnh: cvav 1 04
CADViet Antivirus !!!
Rất nhiều người phàn nàn về việc bị virus acad.lsp,

 

Nó làm cho máy tính của họ không pan bằng phím giữa được, zoom bằng phím giữa rất chậm, hatch...

>>
Rất nhiều người phàn nàn về việc bị virus acad.lsp,

 

Nó làm cho máy tính của họ không pan bằng phím giữa được, zoom bằng phím giữa rất chậm, hatch chạy đâu mất, đối tượng được chọn không highlight.

 

Giải pháp được đưa ra để khắc phục:

- xóa hết các file acad.lsp trong máy đi, đặt các biến:

- zoomfactor về 60

- mbuttonpan về 1

- HIGHLIGHT về 1

- fillmode về on

 

Nhưng khổ nỗi làm việc trong công ty, mở file qua mạng LAN, mình xóa hết hôm nay, nhưng đến ngày mai thì lại bị lây từ máy khác trong mạng.

 

Không thể suốt ngày ngồi xóa acad.lsp và đặt lại thông số hệ thống được. CADViet Antivirus sẽ giúp bạn trong tình thế này.

 

Bạn hãy download file CVAV về (bằng cách phải chuột vào link rồi chọn save link as hoặc save target as) rồi làm theo hướng dẫn:

;; --------- 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)

 

1. Phải chuột vào link rồi chọn save as về máy bạn.

CVAVHelp1.png

 

2. Dùng lệnh appload: Tool > Load Application

CVAVHelp2.png

 

3. Chọn mục content

CVAVHelp3.png

 

4. Nhấn Add

CVAVHelp4.png

 

5. Chọn đến file file CVAV.lsp

CVAVHelp5.png

 

6. file file CVAV.lsp đã nằm trong danh sách khởi động, nhấn close để kết thúc

CVAVHelp6.png

 

Bây giờ bạn đã được bảo vệ khỏi sự quấy nhiễu của acad.lsp, mỗi khi thấy không còn có acad.lsp nữa, bạn muốn gỡ CVAV ra khỏi autocad, chỉ đơn giản là remove CVAV.lsp ra khỏi mục content là được.

 

Hãy thử sử dụng và cho chúng tôi biết ý kiến của bạn.

Lời khuyên: Hiên nay biến thể của virus này rất nhiều, rất nhiều trong số đó chưa được cập nhật vào trong CADViet Antivirus. Nếu bạn đã cài CADViet Antivirus vào máy thì máy bạn sẽ không bị nhiễm những biến thể thể này (cho dù CVAV chưa cập nhật). Vì vậy, tôi khuyên các bạn (nhất là các bạn không rành về IT) nên cài CADViet Antivirus vào máy tính của bạn vì CADViet Antivirus gần như không ảnh hưởng đến AutoCAD của bạn nhưng bạn sẽ tránh được các rắc rối do biến thể của virus gây nên.

 

Cám ơn anh Hoành rất nhiều, đúng cái em đang tìm. Mà anh ơi, em đã đang bị nhiễm acad.lsp rồi, nó làm vô hiệu PLOT. Bây giờ em phải cài lại CAD rồi mới cài CACV vô hay là cài vô luôn cho nó diệt hả anh?!


<<

Filename: 116727_cvav_1_04.lsp
Tác giả: proconeng86
Bài viết gốc: 241586
Tên lệnh: ha
lisp chia ngang màn hình

http://www.cadviet.com/upfiles/3/9928_vv_chia_doc_2_man_hinh.lsp

 

Lisp thay đổi Arrowhead của Leader và Dimension. Tưởng bạn đã quên ai ngờ vẫn nhớ.

 

;; Thay doi Arrowhead cua cac Leader va Dimension duoc chon.
;; Doan Van Ha - CadViet.com - ngay 16/7/2013
(vl-load-com)
(defun C:HA( / lst ss txt i ent L->Ptr #String:Replace)
 (defun L->Ptr(lst)
  (vl-string-trim "()" (vl-princ-to-string lst)))
 (defun #String:Replace(new old str / inc len)
  (setq len (strlen new) inc 0)
  (while (setq inc (vl-string-search old str inc))
   (setq str (vl-string-subst new old str inc) inc (+ inc len)))
  str)
 (setq lst
 '(("01.ClosedFilled" acArrowDefault)
   ("02.Dot" acArrowDot)
   ("03.DotSmall" acArrowDotSmall)
   ("04.DotBlank" acArrowDotBlank)
   ("05.OriginIndicator" acArrowOrigin)
   ("06.OriginIndicator2" acArrowOrigin2)
   ("07.Open" acArrowOpen)
   ("08.RightAangle" acArrowOpen90)
   ("09.Open30" acArrowOpen30)
   ("10.Closed" acArrowClosed)
   ("11.DotSmallBlank" acArrowSmall)
   ("12.None" acArrowNone)
   ("13.Oblique" acArrowOblique)
   ("14.BoxFilled" acArrowBoxFilled)
   ("15.Box" acArrowBoxBlank)
   ("16.ClosedBlank" acArrowClosedBlank)
   ("17.DatumTriangleFilled" acArrowDatumFilled)
   ("18.DatumTriangle" acArrowDatumBlank)
   ("19.Integral" acArrowIntegral)
   ("20.ArchitecturalTick" acArrowArchTick)))
 (setq lst (list (mapcar 'car lst) (mapcar 'cadr lst)))
 (if
  (and 
   (princ "\nChon cac Leader can thay doi Arrowhead...")
   (setq ss (ssget '((0 . "LEADER,DIMENSION"))))
   (not (initget (strcat (L->Ptr (car lst)) " _" (L->Ptr (cadr lst)))))
   (setq txt (getkword (strcat "\nNhap 1 tuy chon tu 01 den 20 : "))))
  (repeat (setq i (sslength ss))
   (if (eq (cdr (assoc 0 (entget (setq ent (ssname ss (setq i (1- i))))))) "LEADER")
    (vla-put-ArrowheadType (vlax-ename->vla-object ent) (eval (read txt)))
(progn
     (vla-put-Arrowhead1Type (vlax-ename->vla-object ent) (eval (read txt)))
     (vla-put-Arrowhead2Type (vlax-ename->vla-object ent) (eval (read txt)))))))
 (princ))
 

 

bác xem lại nhé.. hình như không cần lisp mình vẫn chia được màn hình theo phương ngang, bàn độ H (Horizontal) bác thử theo bước sau được không

1. nhấn vào View trên thanh công cụ

2. nhấn vào Viewports

3. sau đó chọn số luợng màn hình cần chia 1,2,3,4 Viewports

4. trên dòng command bác chỉ vần chon V (Vertical) hoặc H (Horizontal) bác muốn chọnchia theo ngang màn hình bác chọn H là oke.. 

Thanh công cụ của CAD thì mình biết chứ nhưng mỗi lần chọn lại rất mất thời gian, chọn view/view port/ 2 view port/horizontal. Rất mất thời gian mà. Nếu có lisp thì mình gõ lệnh rồi chọn điểm cái là đc, chuyển lại 1 màn hình gõ tiếp lệnh 1 lần nữa, sẽ đỡ tốn thời gian hơn nhiều chứ

Ngoài ra CAD mặc định chia 2 màn hình đều nhau, có lisp thì mình có thể tùy ý chọn tỉ lệ bằng cách click chuột trên màn hình, sẽ tiện hơn để vẽ rất nhiều vì màn hình để gióng không cần thiết quá to mà.

Trước mình thấy trên diễn đàn có chia lisp chia dọc rất hay, giá như lisp chia ngang thì tuyệt biết bao.

Cao thủ nào giúp mình cái


<<

Filename: 241586_ha.lsp
Tác giả: phongtran86
Bài viết gốc: 328831
Tên lệnh: mbkc
lisp vẽ mặt bằng kết cấu

 

Lấy ý tưởng từ bài

 

Lấy ý tưởng từ bài

http://www.cadviet.com/forum/topic/93584-nho-viet-lisp-hatch-vung-kin-cua-cac-doi-tuong-giao-nhau/

Tôi sửa lại lisp của bạn Doan Van Ha như sau:

- Sửa hàm chính: MBCK

- Sửa lỗi hàm HA:PointInOut luôn trả về nil nếu flag là "N"

- Các hàm khác như cũ.

Các bạn check xem còn lỗi nào không

 

(defun SsNext (e f / ss)
    (setq ss (ssadd))
    (while (setq e (entnext e))
        (if (or (not f) (vl-position (cons 0 f) (entget e)))(ssadd e ss))    )
)
(defun C:MBKC(/ c col ent giao i kc ll lst lstb lstg1 lsti n o ss sv sy)
 (command "undo" "be") (redraw)
    (setq sy '("CMDECHO" "OSMODE" "PEDITACCEPT" "DELOBJ") sv (mapcar 'getvar sy))
    (mapcar 'setvar sy '(0 0 1 1))
 (setq col 1)
 (while
  (and
   (princ "\nChon cac Line duong truc...")
   (setq ss (ssget '((0 . "LINE"))))
   (setq lsti (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
   (or kc (setq kc 110))
   (setq kc (cond ((getdist (strcat "\nBe rong tuong/dam <" (rtos kc 2 2) ">:"))) (kc))))
  (mapcar '(lambda(ent) (grdraw (vlax-curve-getStartPoint ent) (vlax-curve-getEndPoint ent) col)) lsti)
  (setq lst (append (mapcar '(lambda(ent) (list ent kc)) lsti) lst))
  (setq lstb (append lsti lstb))
  (setq col (1+ col)))
 (command "zoom" "w" (car (setq c (LM:ListBoundingBox lstb))) (cadr c))
 (setq lst (reverse lst))
    (setq ll (entlast))
 (foreach n1 lst
  (setq lstg1 nil)
  (foreach n2 lst
   (if (setq giao (car (HA:Giao (vlax-ename->vla-object (car n1)) (vlax-ename->vla-object (car n2)) acExtendNone)))
    (setq lstg1 (cons giao lstg1)))
        )
     (if lstg1
         (progn
             (setq i 0 o (cdr (assoc 10 (entget (car n1)))))
             (setq lstg1 (LM:UniqueFuzz(vl-sort lstg1 '(lambda(p q) (< (distance p o) (distance q o)) ))1e-10))
             (repeat (1- (length lstg1))
                 (entmake (list (cons 0 "LINE") (cons 10 (nth i lstg1)) (cons 11 (nth (setq i (1+ i)) lstg1)) ))         )
         )
    ))
 ;(load "overkillsup.lsp")
    (vl-cmdf "._REGION" (SsNext ll nil) "")
    (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex (SsNext ll "REGION"))))
        (vl-cmdf "._EXPLODE" ent)
        ;(acet-overkill2 (list (ssget "P") 1E-3))
        (vl-cmdf "PEDIT" "M" "p" "" "J" "" "" )
        )
    
    (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex (SsNext ll "LWPOLYLINE")))))
    (setq ss (vl-sort ss '(lambda(p q) (> (vlax-curve-getarea p) (vlax-curve-getarea q)) )))
 (HA:OffsetInOut (car ss) lst "N")
 (foreach ent (cdr ss)
  (HA:OffsetInOut ent lst "T"))
    (mapcar 'setvar sy sv)(command "undo" "e")
    (redraw) (princ))

(defun HA:PointInOut (p obj flag / flag1 obj1 obj2 lon nho)
 (setq obj1 (car (vlax-invoke obj 'Offset 1E-1))
       obj2 (car (vlax-invoke obj 'Offset -1E-1)))
 (if (> (vla-get-area obj1)(vla-get-area obj2))
  (setq lon obj1 nho obj2)
  (setq lon obj2 nho obj1))
 (if (> (distance p (vlax-curve-getClosestPointTo lon p))(distance p (vlax-curve-getClosestPointTo nho p)))
  (if (= flag "T")(setq flag1 T))
     (if (= flag "N")(setq flag1 T)
   ))
 (mapcar 'vla-delete (list lon nho))
 flag1)
 

cảm ơn bạn đoàn văn hà đã viết code và bạn đã có công phát triển hoàn thiện tiếp, bạn nghĩ sao nếu phát triển trục dầm là đường cong  :D


<<

Filename: 328831_mbkc.lsp
Tác giả: qh2qa06
Bài viết gốc: 313683
Tên lệnh: tbcc
Lisp tính giá trị trung bình của các Text !!!!

 

nhoc có 1 lsp mót chỉnh sữa lại 1 tí theo ý bạn, bạn xem sao ^^

;;;Dung de tinh tong cac so
(defun...
>>

 

nhoc có 1 lsp mót chỉnh sữa lại 1 tí theo ý bạn, bạn xem sao ^^

;;;Dung de tinh tong cac so
(defun C:tbcc()
  (setq ss (ssget '((0 . "TEXT"))))
  (setq c 0 tong 0)
  (if (/= ss nil)
    (while (< c (sslength ss))
      (setq oldob (entget (ssname ss c)))
      (setq txtstr (assoc 1 oldob))
	  (setq realk (assoc 40 oldob))
	(if (/= txtstr nil)
        (progn
		  (setq ctext (cdr realk))
          (setq num (cdr txtstr))
          (setq tam (atof num))
          (setq tong (+ tong tam))
		  (setq tbc (/ tong (sslength ss)))
        );progn
      );if
      (setq c (1+ c))
    );while
  );if
  (while (/= tong 0)
    (setq p (getpoint "\nNhap vi tri xuat ket qua: "))
    (command "TEXT" p ctext 0 (rtos tbc 2 3) "")
    (setq tong 0)
  );while
)
(prompt "ten lenh : tbcc")

Cảm ơn bạn! Lisp của bạn mình dùng tốt rồi. Phản ứng nhanh thật! Không thấy có icon tặng hoa hay vỗ tay gì cả 


<<

Filename: 313683_tbcc.lsp
Tác giả: tungquach165
Bài viết gốc: 268317
Tên lệnh: cisov cunisov
Ẩn hiện đối tượng theo màu

Chui vào bên trong xem tốc độ có ổn hơn không. Mình sử dụng VL

 

(defun c:cisov(/ _table _vlacol lays adoc...
>>

Chui vào bên trong xem tốc độ có ổn hơn không. Mình sử dụng VL

 

(defun c:cisov(/ _table _vlacol lays adoc col)
	(vl-load-com) 
	(defun _table (s / d r)
		(while (setq d (tblnext s (null d)))
			(setq r (append  (list (cons (cdr (assoc 2 d)) (cdr (assoc 62 d)))) r))
		)	
	)
	(defun _vlacol(obj lays / col)(if (/= (setq col (vla-get-color obj)) 256) col (cdr (assoc (vla-get-layer obj) lays))))
	(setq lays (_table "LAYER"))
	(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
	(setq col (_vlacol (vlax-ename->vla-object (car(entsel))) lays)) 
	(vla-startundomark adoc)
	(vlax-for block (vla-get-blocks adoc)     
		  (vlax-for   ent block 
			(if (/= (_vlacol ent lays) col) (vla-put-visible ent 0))
		)
	)
	(vla-endundomark adoc)
)

(defun c:cunisov(/ adoc)
	(vl-load-com) 	
	(setq adoc (vla-get-activedocument (vlax-get-acad-object)))	
	(vlax-for block (vla-get-blocks adoc)     
		  (vlax-for   ent block 
			(vla-put-visible ent 1)
		)
	)
)

Cái này không chọn được nhiều màu cùng 1 lúc à bác, bác có thể viết thêm lệnh, chọn vào mà nó ẩn đi nữa đc ko?

em chạy thử cái này thấy nhanh hơn rồi:))

cảm ơn bác nhiều nhé


<<

Filename: 268317_cisov_cunisov.lsp
Tác giả: nguyenthe09d1
Bài viết gốc: 263653
Tên lệnh: khsn vol ttol themtext cdtc rgdd cdtb thkl
xin lisp san nền

 

Mình có xin được lisp của anh Sáu rất hay đang sử dụng cho công việc nhưng hiện tại lưới khi nhập vào là lưới ô vuông tức là...

>>

 

Mình có xin được lisp của anh Sáu rất hay đang sử dụng cho công việc nhưng hiện tại lưới khi nhập vào là lưới ô vuông tức là chỉ nhập vào 1 số 10m chẳng hạn,

giờ mình muốn nhập lưới hình chữ nhật 10mx20m hoặc lưới tam giác, nhờ các bác giúp đỡ

 

 

 

;tao layer cho ban ve
(defun c:khsn ()
  (command ".layer" "n" "sn-luoi o vuong" "c" "8" "sn-luoi o vuong" ""
       ".layer" "n" "sn-STT o luoi" "c" "120" "sn-STT o luoi" ""
       ".style" "text" "VNI-Helve" "" "" "" "" "" ""
       ".layer" "n" "sn-vong tron o luoi" "c" "1" "sn-vong tron o luoi" ""
       	".layer" "n" "sn-DTdap" "c" "210" "sn-DTdap" ""
       ".Layer" "n" "sn-CDTK" "c" "1" "sn-CDTK" ""
       ".layer" "n" "sn-CD Trung binh" "c" "30" "sn-CD trung binh" ""
       ".Layer" "n" "sn-CDTCdao" "c" "4" "sn-CDTCdao" ""
       ".Layer" "n" "sn-CDTCdap" "c" "2" "sn-CDTCdap" ""
       ".layer" "n" "sn-KLuongdap" "c" "42" "sn-KLuongdap" ""
       ".Layer" "n" "sn-CDTN" "c" "3" "sn-CDTN" ""
       )
  (command ".layer" "n" "sn-KLuongdao" "c" "91" "sn-KLuongdao" ""
         ".layer" "n" "sn-CD Trung binh" "c" "30" "sn-CD trung binh" ""
         ".layer" "n" "sn-KLuongdap" "c" "241" "sn-KLuongdap" ""
         ".layer" "n" "sn-DTdao" "c" "151" "sn-DTdao" ""
         )  
  (command ".layer" "n" "THop-KLuongdao" "c" "91" "THop-KLuongdao" ""
       ".layer" "n" "THop-KLuongdap" "c" "241" "THop-KLuongdap" ""
       ".layer" "n" "THop-DTdap" "c" "210" "THop-DTdap" ""
       ".layer" "n" "THop-DTdao" "c" "151" "THop-DTdao" ""
           ;".layer" "n" "THop-KLuongdao" "c" "7" "THop-KLuongdao" ""
       ;".layer" "n" "THop-KLuongdap" "c" "7" "THop-KLuongdap" ""
       ;".layer" "n" "THop-DTdap" "c" "7" "THop-DTdap" ""
       ;".layer" "n" "THop-DTdao" "c" "7" "THop-DTdao" ""
       ".layer" "n" "THop-DThang" "c" "2" "THop-DThang" ""
       ".layer" "n" "THop-TEXT" "c" "7" "THop-TEXT" ""
       ".layer" "n" "sn-ranhgioidaodap" "c" "91" "sn-ranhgioidaodap"""
       )
  (princ)
  )
;danh so thu tu o luoi
(defun TTOL ()
  (setvar "cmdecho" 0)  
  (setq SS (ssget '((0 . "text") (8 . "sn-STT o luoi")))
	LS (sslength SS)
	)
  (setq N 0)
  (setq M LS)
  (setq CDD (getstring "\nChu so dung dau (tien to):"))
  (repeat LS
    ;lay ra ma doi tuong
    (setq MDT (entget (ssname SS N)))
    ;lay ra gia tri text
    (setq TEXT1 (assoc 1 MDT))
    (setq STT1 (strcat CDD (rtos M 2 0)))
    ;danh so thu tu
    (setq STT (subst (cons 1 STT1) TEXT1 MDT))
    (setq N (1+ N))
    (setq M (1- M))
    ;cap nhat lai ma doi tuong
    (entmod STT)
    )  
  (princ)
  )
***************************************
;them dau tru "-" vao o trong ranh gio dao va them bat ky vao dau text
(defun themtext ()	;
  (setvar "cmdecho" 0)  
  (setq SS (ssget '((0 . "text")))
	LS (sslength SS)
	)
  (setq N 0)
  (setq CDD (getstring "\nThem gi:"))
  (repeat LS
    ;lay ra ma doi tuong
    (setq MDT (entget (ssname SS N)))
    ;lay ra gia tri text
    (setq TEXT1 (assoc 1 MDT))
    (setq TEXT2 (cdr TEXT1))
    (setq STT1 (strcat CDD TEXT2))
    (setq STT (subst (cons 1 STT1) TEXT1 MDT))
    (setq N (1+ N))
 	;cap nhat lai ma doi tuong
    (entmod STT)
    )
  (princ)
  )
******************************************
;ve o luoi san nen
(defun vol () ;vol:Ve o luoi
  (setvar "cmdecho" 0)
  (setvar "orthomode" 0)
  (setvar "gridmode" 0)
  (setvar "snapmode" 0)
  (setvar "osmode" 0)  
  ;vao hai diem
  (setq pt1 (getpoint "\nChon diem thu nhat: ")
	pt2 (getcorner pt1 "\nChon diem thu hai: ")
	)
  (setq ktol (getint "\nKich thuoc o luoi: ")) ;ktol:kich thuoc o luoi
  ;lay ra toa do hai diem
  (setq pt1_x (car pt1)
	pt1_y (cadr pt1)
	pt2_x (car pt2)
	pt2_y (cadr pt2)
	)
  ;tao cac diem moi de ve o luoi
  (setq pt3 (polar pt1 0 (- pt2_x pt1_x))
	)
  ;xac dinh bao nhieu line trong o luoi
  (setq ln (distance pt3 pt1)	;chieu dai toan bo luoi theo phuong ngang
	ld (distance pt2 pt3)	;chieu dai toan bo luoi theo phuong dung
	sln (fix (/ ln ktol))	;so duong thang theo phuong ngang
	sld (fix (/ ld ktol))	;so duong thang theo phuong dung
	)
  (setq pt4 (polar pt1 0 (* ktol sln))
	pt5 (polar pt4 (/ pi 2) (* ktol sld))
	)
  (command ".layer" "s" "sn-luoi o vuong" "")
  (command ".line" pt1 pt4 ""       
       ".array" "l" "" "r" (+ 1 sld) 1 ktol
       ".line" pt4 pt5 ""
       ".array" "l" "" "r" 1 (+ 1 sln) (- ktol)
       )
  ;tinh cac diem trong o luoi
  (setq pt6 (polar pt1 (/ pi 2) (* ktol sld))
	pt7 (polar pt6 (/ pi 2) (- (/ ktol 2)))
	pt8 (polar pt7 0 (/ ktol 2))
	;pt9 pt8
	)   
  (repeat sld
    ;ve vong tron khoi luong
    (setq bkol (/ ktol 3.00))	;bkol:ban kinh o luoi
    (command ".layer" "s" "sn-vong tron o luoi" "")
    (command ".circle" pt8 bkol
         ".array" "l" "" "r" 1  sln ktol
       )    
    ;ghi so thu tu o luoi vao o luoi
    (setq htext (/ ktol 14.00))	;chieu cao chu
    (setq pt11 (polar pt8 (/ pi 2) (/ ktol 5.33)))
    (command ".layer" "s" "sn-STT o luoi" "")
    (command ".text" "j" "mc" pt11 htext 0  "STT"
         ".array" "l" "" "r" 1  sln ktol
       )
    ;ve cac doan thang vao o luoi
    (setq ol_ld (/ ktol (* 2 5.00))	;duong thang dung
  	pt12 (polar pt8 (/ pi 2) ol_ld)
  	pt13 (polar pt8 (/ pi 2) (- ol_ld))
  	ol_ln (/ ktol (* 2 1.572427175))
  	pt14 (polar pt12 0 ol_ln)
  	pt15 (polar pt12 0 (- ol_ln))
  	pt16 (polar pt13 0 ol_ln)
  	pt17 (polar pt13 0 (- ol_ln))
  	)
    (command ".layer" "s" "sn-vong tron o luoi" "")
    (command ".line" pt12 pt13 ""
         ".array" "l" "" "r" 1  sln ktol
         ".line" pt14 pt15 ""
         ".array" "l" "" "r" 1  sln ktol
         ".line" pt16 pt17 ""
         ".array" "l" "" "r" 1  sln ktol
         )
    ;dien dien tich o luoi
    (setq pt18 (polar pt8 0 (- (/ ktol 6.289703755))))
    (command ".layer" "s" "sn-DTdap" "")
    (command ".text" "j" "mc" pt18 htext 0 (rtos (* ktol ktol) 2 0)
         ".array" "l" "" "r" 1  sln ktol
         )       
 	;doi cuoi thanh dau
    (setq pt10 (polar pt8 (/ pi 2) (- ktol)))
    (setq pt8 pt10)    
    )
  ;(alert "Hay su dung nhung layer duoc tao ra va dung xoa di")
  (princ)
  )
 
*********************************************
;tinh cao do trung binh
(defun CDTB ()
  (setvar "cmdecho" 0)
  (setvar "orthomode" 0)
  (setvar "gridmode" 0)
  (setvar "snapmode" 0)
  (setvar "osmode" 0)    
  (alert (strcat "Khong chon nhung o luoi thuoc ranh gioi dao dap va cac o le"
     	  	"\nChon nhung o luoi nam hoan toan trong vung dao hoac dap")
     )
  ;kiem tra kich thuoc o luoi
  ;(if ( = ktol nil)
   ; (progn
 	; (setq KTOL (getreal "\nKich thuoc o luoi: "))
 	; )
    <img src='http://www.cadviet.com/forum/public/style_emoticons/<#EMO_DIR#>/wink.png' class='bbc_emoticon' alt=';)' />
  (setq SSC (ssget '((0 . "circle") (8 . "sn-vong tron o luoi")))
	LSC (sslength SSC)
     )  
  (setq N 0)
  (repeat LSC
 	;lay ra ma doi tuong
    (setq MDTC (entget (ssname SSC N))
  	pt_tam (cdr (assoc 10 MDTC)) ;lay ra toa do tam duong tron
  	nol (/ KTOL 2)	;do lon nua o luoi
  	;xac dinh hai diem ben phai     
  	pt19 (polar pt_tam 0 nol)
  	pt20 (polar pt19 (/ pi 2) (- nol))
  	;xac dinh diem ben phai
  	pt21 (polar pt_tam 0 (- (+ nol (* nol 0.8))))
  	pt22 (polar pt21 (/ pi 2) (+ nol (* nol 0.8)))
  	)
    ;tinh cao do trung binh
    (setq CDTB (ssget "w" pt22 pt20 '((0 . "text") (8 . "sn-CDTC*")))
  	SL_CDTB (sslength CDTB)
  	)
    ;cao do thi cong cac diem nut
    (setq CDTC_1 (entget (ssname CDTB 0))
  	CDTC_11 (atof (cdr (assoc 1 CDTC_1)))
  	)
    (setq CDTC_2 (entget (ssname CDTB 1))
  	CDTC_22 (atof (cdr (assoc 1 CDTC_2)))
  	)
    (setq CDTC_3 (entget (ssname CDTB 2))
  	CDTC_33 (atof (cdr (assoc 1 CDTC_3)))
     )
    (setq CDTC_4 (entget (ssname CDTB 3))
  	CDTC_44 (atof (cdr (assoc 1 CDTC_4)))
     )
    ;tinh ra cao do trung binh
    (setq CDTBKq (/ (+ CDTC_11 CDTC_22 CDTC_33 CDTC_44) 4)
  	CDTBKq (atof (rtos CDTBKq 2 2))
  	KLOL (* KTOL KTOL CDTBKq)
  	)
    ;in gia tri
    (setq pt23 (polar pt_tam 0 (/ nol 3.144851877))
  	pt24 (polar pt_tam (/ pi 2) (- (/ nol 2.45)))
  	)    
    (command ".layer" "s" "sn-CD Trung binh" ""
               ".text" "j" "mc" pt23 htext 0 (rtos CDTBKq 2 2)
         )
    (if (< CDTBKq 0)
      (progn
	(setq SSdao (ssget "w" pt22 pt20 '((0 . "text") (8 . "sn-DTdap")))
      	dautru "-"	;them dau "-" vao nhung dien tich dao
      	)
	(setq MDT (entget (ssname SSdao 0)))
	;lay ra gia tri text them dau tru
        (setq TEXT1 (assoc 1 MDT))
        (setq TEXT2 (cdr TEXT1))
        (setq STT1 (strcat dautru TEXT2))
        (setq STT (subst (cons 1 STT1) TEXT1 MDT))
	;cap nhat lai ma doi tuong
	(entmod STT)    
	(command ".layer" "s" "sn-KLuongdao" "")
      )
      (progn    
      (command ".layer" "s" "sn-KLuongdap" "")
      )
      );ket thuc if
    ;chuyen sang layer moi neu CDTBKq <0
    (if (< CDTBKq 0)
      (progn
	(setq SSdao1 (ssget "w" pt22 pt20 '((0 . "text") (8 . "sn-DTdap"))))
	(setq layer (entget (ssname SSdao1 0)))
	(setq CLayer (subst '(8 . "sn-DTdao") (assoc 8 layer) layer))
     ;cap nhat lai ma doi tuong       
	(entmod CLayer)
      )
      )
         
    (command ".text" "j" "mc" pt24 htext 0 (rtos KLOL 2 2)
         )    
    (setq N (1+ N))    
    )
    (princ )   
  )
********************************************
;Lap bang tong hop khoi luong
(defun THKL ()	;THKL:Tong hop khoi luong
  (setvar "cmdecho" 0)
  (setvar "orthomode" 0)
  (setvar "gridmode" 0)
  (setvar "snapmode" 0)
  (setvar "osmode" 0)
  
  ;khoang cah giua cac dong
  (setq KCDC (* 0.3 ktol))	;KCDC: khoang cach dong chu
  ;lua chon phuong lap bang tong hop
  (initget 1 "Y X")
  (setq plb (getkword "\nBang tong hop dat theo phuong Y hay X ? <Y/X>: "))
  ;tao diem ao cua pt1
  (setq pt1_1 pt1   
	)
  (if (= plb "X")
    (progn
      (setq pt23 (polar pt1_1 (/ pi 2) (- (* 0.75 ktol)))
    	pt23_1 (polar pt23 0 (* ktol sln))
    	pt23_2 (polar pt23_1 0 (* 1.5 ktol))
    	pt24 (polar pt23 0 (- (* 2 ktol)))       
    	)
      ;ve duong thang
      (command ".layer" "s" "THop-DThang" ""
           ".line" pt23 pt24 ""
           ".array" "l" "" "r" 5  1 (- KCDC)
           ".line" pt24 (polar pt24 (/ pi 2) (- (* 4 KCDC))) ""
           ".line" pt23 (polar pt23 (/ pi 2) (- (* 4 KCDC))) ""
           ".array" "l" "" "r" 1  (+ 1 sln) ktol
           ".line" pt23 (polar pt23 0 (* ktol sln)) ""
           ".array" "l" "" "r" 5  1 (- KCDC)
           ".line" pt23_1 pt23_2 ""
           ".array" "l" "" "r" 5  1 (- KCDC)
           ".line" pt23_2 (polar pt23_2 (/ pi 2) (- (* 4 KCDC))) ""
           )
      ;tinh diem de dat text dau bang tong hop
      (setq pt25 (polar pt24 (/ pi 2) (- (/ KCDC 2)))
    	pt25_1 (polar pt23_1 (/ pi 2) (- (/ KCDC 2)))
    	pt25_2 (polar pt25_1 0 (* ktol 0.4))
    	pt26 (polar pt25 0 (* ktol 0.245))
    	)
      (command ".layer" "s" "THop-TEXT" ""
           ".text" "j" "ml" pt26 htext 0 "DIEÄN TÍCH ÑAÉP (M2)"
           ".text" "j" "ml" (polar pt26 (/ pi 2) (- KCDC)) htext 0 "DIEÄN TÍCH ÑAØO (M2)"
                 ".text" "j" "ml" (polar pt26 (/ pi 2) (- (* 2 KCDC))) htext 0 "KHOÁI LÖÔÏNG ÑAÁT ÑAÉP (M3)"
           ".text" "j" "ml" (polar pt26 (/ pi 2) (- (* 3 KCDC))) htext 0 "KHOÁI LÖÔÏNG ÑAÁT ÑAØO (M3)"
           ".text" "j" "m" pt25_2 htext 90 "M"
           ".array" "l" "" "r" 4  1 (- KCDC)
		)
      ;thu hien vong lap
      (repeat sln
	;tinh diem de chon doi tuong
	(setq pt27 (polar pt1_1 0 ktol)
    	pt28 (polar pt27 (/ pi 2) (* ktol sld))
    	)
	;tinh diem in gia tri
	(setq pt29 (polar pt1_1 (/ pi 2) (- (* 0.75 ktol)))
      	pt30 (polar pt29 (/ pi 2) (- (/ KCDC 2)))
      	pt31 (polar pt30 0 (/ ktol 2))
      	)
	;tinh dien tich dap
	(setq DTdap (ssget "w" pt1_1 pt28 '((0 . "text") (8 . "sn-DTdap"))))
	(if (= DTdap nil)     
  	(progn
    	(command ".layer" "s" "THop-DTdap" ""
	         ".text" "j" "mc" pt31 htext 0 "00.00"
	         )
    	)
  	(progn
    	(setq N 0
	  	Tong 0
	       SLDTdap (sslength DTdap)
	  	)
    	(repeat SLDTdap
      	(setq MDT_DTdap (entget (ssname DTdap N))
	    	DTdap_1 (atof (cdr (assoc 1 MDT_DTdap)))
	    	)
      	;tinh tong
      	(setq Tong (+ DTdap_1 Tong))
      	(setq N (1+ N))
      	)
    	(command ".layer" "s" "THop-DTdap" ""
	         ".text" "j" "mc" pt31 htext 0 (rtos Tong 2 2)
	         )
    	)
  	)
	;tinh dien tich dao
	(setq DTdao (ssget "w" pt1_1 pt28 '((0 . "text") (8 . "sn-DTdao"))))
	(if (= DTdao nil)     
  	(progn
    	(command ".layer" "s" "THop-DTdao" ""
	         ".text" "j" "mc" (polar pt31 (/ pi 2) (- KCDC)) htext 0 "00.00"
	         )
    	)
  	(progn
    	(setq N 0
	  	Tong 0
	       SLDTdao (sslength DTdao)
	  	)
    	(repeat SLDTdao
      	(setq MDT_DTdao (entget (ssname DTdao N))
	    	DTdao_1 (atof (cdr (assoc 1 MDT_DTdao)))
	    	)
      	;tinh tong
      	(setq Tong (+ DTdao_1 Tong))
      	(setq N (1+ N))
      	)
    	(command ".layer" "s" "THop-DTdao" ""
	         ".text" "j" "mc" (polar pt31 (/ pi 2) (- KCDC)) htext 0 (rtos Tong 2 2)
	         )
    	)
  	)
	;tinh khoi luong dap
	(setq KLdap (ssget "w" pt1_1 pt28 '((0 . "text") (8 . "sn-KLuongdap"))))
	(if (= KLdap nil)     
  	(progn
    	(command ".layer" "s" "THop-KLuongdap" ""
	         ".text" "j" "mc" (polar pt31 (/ pi 2) (- (* 2 KCDC))) htext 0 "00.00"
	         )
    	)
  	(progn
    	(setq N 0
	  	Tong 0
	       SLKLdap (sslength KLdap)
	  	)
    	(repeat SLKLdap
      	(setq MDT_KLdap (entget (ssname KLdap N))
	    	KLdap_1 (atof (cdr (assoc 1 MDT_KLdap)))
	    	)
      	;tinh tong
      	(setq Tong (+ KLdap_1 Tong))
      	(setq N (1+ N))
      	)
    	(command ".layer" "s" "THop-KLuongdap" ""
	         ".text" "j" "mc" (polar pt31 (/ pi 2) (- (* 2 KCDC))) htext 0 (rtos Tong 2 2)
	         )
    	)
  	)
	;tinh khoi luong dao
	(setq KLdao (ssget "w" pt1_1 pt28 '((0 . "text") (8 . "sn-KLuongdao"))))
	(if (= KLdao nil)     
  	(progn
    	(command ".layer" "s" "THop-KLuongdao" ""
	         ".text" "j" "mc" (polar pt31 (/ pi 2) (- (* 3 KCDC))) htext 0 "00.00"
	         )
    	)
  	(progn
    	(setq N 0
	  	Tong 0
	       SLKLdao (sslength KLdao)
	  	)
    	(repeat SLKLdao
      	(setq MDT_KLdao (entget (ssname KLdao N))
	    	KLdao_1 (atof (cdr (assoc 1 MDT_KLdao)))
	    	)
      	;tinh tong
      	(setq Tong (+ KLdao_1 Tong))
      	(setq N (1+ N))
      	)
    	(command ".layer" "s" "THop-KLuongdao" ""
	         ".text" "j" "mc" (polar pt31 (/ pi 2) (- (* 3 KCDC))) htext 0 (rtos Tong 2 2)
	         )
    	)
  	)
	;doi dau thanh cuoi
	(setq pt1_1 pt27)
	)
	;tinh tong cac gia tri dien vao cot cuoi cung
      ;tao diem ao pt23
      (setq pt32 pt23)
      (repeat 2
	(setq  pt33 (polar pt32 0 (* ktol sln))
           pt34 (polar pt33 (/ pi 2) (- KCDC))
           pt35 (polar pt33 (/ pi 2) (- (/ KCDC 2)))
           pt36 (polar pt35 0 (/ ktol 2))
           )
	(setq sum_all (ssget "w" pt32 pt34 '((0 . "text")))
      	sum_SL (sslength sum_all)
      	)
	(setq N 0
      	sum 0
      	)
	(repeat sum_SL
  	(setq MDT_sum_all (entget (ssname sum_all N))
	    	sum_all_1 (atof (cdr (assoc 1 MDT_sum_all)))
	    	)
  	;tinh tong
  	(setq sum (+ sum_all_1 sum))
  	(setq N (1+ N))
  	)
	(command ".layer" "s" "THop-TEXT" ""
	     ".text" "j" "ml"  pt36 htext 0 (strcat "= "(rtos sum 2 2) " (M2)")
	         )
	;doi dau thanh cuoi
	(setq pt32 (polar pt32 (/ pi 2) (- KCDC)))
	)
      (repeat 2
	(setq  pt33 (polar pt32 0 (* ktol sln))
           pt34 (polar pt33 (/ pi 2) (- KCDC))
           pt35 (polar pt33 (/ pi 2) (- (/ KCDC 2)))
           pt36 (polar pt35 0 (/ ktol 2))
           )
	(setq sum_all (ssget "w" pt32 pt34 '((0 . "text")))
      	sum_SL (sslength sum_all)
      	)
	(setq N 0
      	sum 0
      	)
	(repeat sum_SL
  	(setq MDT_sum_all (entget (ssname sum_all N))
	    	sum_all_1 (atof (cdr (assoc 1 MDT_sum_all)))
	    	)
  	;tinh tong
  	(setq sum (+ sum_all_1 sum))
  	(setq N (1+ N))
  	)
	(command ".layer" "s" "THop-TEXT" ""
	     ".text" "j" "ml"  pt36 htext 0 (strcat "= "(rtos sum 2 2) " (M3)")
	         )
	;doi dau thanh cuoi
	(setq pt32 (polar pt32 (/ pi 2) (- KCDC)))
	)    
      )   ;dong progn
    ;da tinh xong khi lap bang theo phuong X
    ;neu lap bang theo phuong Y
    (progn
      (setq pt23 (polar pt1_1 0 (- (* 0.75 ktol)))
    	pt23_1 (polar pt23 (/ pi 2) (* ktol sld))
    	pt23_2 (polar pt23_1 (/ pi 2) (* 1.5 ktol))
    	pt24 (polar pt23 (/ pi 2) (- (* 2 ktol)))       
    	)
      ;ve duong thang
      (command ".layer" "s" "THop-DThang" ""
           ".line" pt23 pt24 ""
           ".array" "l" "" "r" 1  5 (- KCDC)
           ".line" pt24 (polar pt24 0 (- (* 4 KCDC))) ""
           ".line" pt23 (polar pt23 0 (- (* 4 KCDC))) ""
           ".array" "l" "" "r" (+ 1 sld) 1 ktol
           ".line" pt23 (polar pt23 (/ pi 2) (* ktol sld)) ""
           ".array" "l" "" "r" 1  5 (- KCDC)
           ".line" pt23_1 pt23_2 ""
           ".array" "l" "" "r" 1  5 (- KCDC)
           ".line" pt23_2 (polar pt23_2 0 (- (* 4 KCDC))) ""
           )
      ;tinh diem de dat text dau bang tong hop
      (setq pt25 (polar pt24 0 (- (/ KCDC 2)))
    	pt25_1 (polar pt23_1 0 (- (/ KCDC 2)))
    	pt25_2 (polar pt25_1 (/ pi 2) (* ktol 0.4))
    	pt26 (polar pt25 (/ pi 2) (* ktol 0.245))
    	)
      (command ".layer" "s" "THop-TEXT" ""
           ".text" "j" "ml" pt26 htext 90 "DIEÄN TÍCH ÑAÉP (M2)"
           ".text" "j" "ml" (polar pt26 0 (- KCDC)) htext 90 "DIEÄN TÍCH ÑAØO (M2)"
                 ".text" "j" "ml" (polar pt26 0 (- (* 2 KCDC))) htext 90 "KHOÁI LÖÔÏNG ÑAÁT ÑAÉP (M3)"
           ".text" "j" "ml" (polar pt26 0 (- (* 3 KCDC))) htext 90 "KHOÁI LÖÔÏNG ÑAÁT ÑAØO (M3)"
           ".text" "j" "m" pt25_2 htext 180 "M"
           ".array" "l" "" "r" 1  4 (- KCDC)
		)
      ;thu hien vong lap
      (repeat sld
	;tinh diem de chon doi tuong
	(setq pt27 (polar pt1_1 (/ pi 2) ktol)
    	pt28 (polar pt27 0 (* ktol sln))
    	)
	;tinh diem in gia tri
	(setq pt29 (polar pt1_1 0 (- (* 0.75 ktol)))
      	pt30 (polar pt29 0 (- (/ KCDC 2)))
      	pt31 (polar pt30 (/ pi 2) (/ ktol 2))
      	)
	;tinh dien tich dap
	(setq DTdap (ssget "w" pt1_1 pt28 '((0 . "text") (8 . "sn-DTdap"))))
	(if (= DTdap nil)     
  	(progn
    	(command ".layer" "s" "THop-DTdap" ""
	         ".text" "j" "mc" pt31 htext 90 "00.00"
	         )
    	)
  	(progn
    	(setq N 0
	  	Tong 0
	       SLDTdap (sslength DTdap)
	  	)
    	(repeat SLDTdap
      	(setq MDT_DTdap (entget (ssname DTdap N))
	    	DTdap_1 (atof (cdr (assoc 1 MDT_DTdap)))
	    	)
      	;tinh tong
      	(setq Tong (+ DTdap_1 Tong))
      	(setq N (1+ N))
      	)
    	(command ".layer" "s" "THop-DTdap" ""
	         ".text" "j" "mc" pt31 htext 90 (rtos Tong 2 2)
	         )
    	)
  	)
	;tinh dien tich dao
	(setq DTdao (ssget "w" pt1_1 pt28 '((0 . "text") (8 . "sn-DTdao"))))
	(if (= DTdao nil)     
  	(progn
    	(command ".layer" "s" "THop-DTdao" ""
	         ".text" "j" "mc" (polar pt31 0 (- KCDC)) htext 90 "00.00"
	         )
    	)
  	(progn
    	(setq N 0
	  	Tong 0
	       SLDTdao (sslength DTdao)
	  	)
    	(repeat SLDTdao
      	(setq MDT_DTdao (entget (ssname DTdao N))
	    	DTdao_1 (atof (cdr (assoc 1 MDT_DTdao)))
	    	)
      	;tinh tong
      	(setq Tong (+ DTdao_1 Tong))
      	(setq N (1+ N))
      	)
    	(command ".layer" "s" "THop-DTdao" ""
	         ".text" "j" "mc" (polar pt31 0 (- KCDC)) htext 90 (rtos Tong 2 2)
	         )
    	)
  	)
	;tinh khoi luong dap
	(setq KLdap (ssget "w" pt1_1 pt28 '((0 . "text") (8 . "sn-KLuongdap"))))
	(if (= KLdap nil)     
  	(progn
    	(command ".layer" "s" "THop-KLuongdap" ""
	         ".text" "j" "mc" (polar pt31 0 (- (* 2 KCDC))) htext 90 "00.00"
	         )
    	)
  	(progn
    	(setq N 0
	  	Tong 0
	       SLKLdap (sslength KLdap)
	  	)
    	(repeat SLKLdap
      	(setq MDT_KLdap (entget (ssname KLdap N))
	    	KLdap_1 (atof (cdr (assoc 1 MDT_KLdap)))
	    	)
      	;tinh tong
      	(setq Tong (+ KLdap_1 Tong))
      	(setq N (1+ N))
      	)
    	(command ".layer" "s" "THop-KLuongdap" ""
	         ".text" "j" "mc" (polar pt31 0 (- (* 2 KCDC))) htext 90 (rtos Tong 2 2)
	         )
    	)
  	)
	;tinh khoi luong dao
	(setq KLdao (ssget "w" pt1_1 pt28 '((0 . "text") (8 . "sn-KLuongdao"))))
	(if (= KLdao nil)     
  	(progn
    	(command ".layer" "s" "THop-KLuongdao" ""
	         ".text" "j" "mc" (polar pt31 0 (- (* 3 KCDC))) htext 90 "00.00"
	         )
    	)
  	(progn
    	(setq N 0
	  	Tong 0
	       SLKLdao (sslength KLdao)
	  	)
    	(repeat SLKLdao
      	(setq MDT_KLdao (entget (ssname KLdao N))
	    	KLdao_1 (atof (cdr (assoc 1 MDT_KLdao)))
	    	)
      	;tinh tong
      	(setq Tong (+ KLdao_1 Tong))
      	(setq N (1+ N))
      	)
    	(command ".layer" "s" "THop-KLuongdao" ""
	         ".text" "j" "mc" (polar pt31 0 (- (* 3 KCDC))) htext 90 (rtos Tong 2 2)
	         )
    	)
  	)
	;doi dau thanh cuoi
	(setq pt1_1 pt27)
	)
	;tinh tong cac gia tri dien vao cot cuoi cung
      ;tao diem ao pt23
      (setq pt32 pt23)
      (repeat 2
	(setq  pt33 (polar pt32 (/ pi 2) (* ktol sld))
           pt34 (polar pt33 0 (- KCDC))
           pt35 (polar pt33 0 (- (/ KCDC 2)))
           pt36 (polar pt35 (/ pi 2) (/ ktol 2))
           )
	(setq sum_all (ssget "w" pt32 pt34 '((0 . "text")))
      	sum_SL (sslength sum_all)
      	)
	(setq N 0
      	sum 0
      	)
	(repeat sum_SL
  	(setq MDT_sum_all (entget (ssname sum_all N))
	    	sum_all_1 (atof (cdr (assoc 1 MDT_sum_all)))
	    	)
  	;tinh tong
  	(setq sum (+ sum_all_1 sum))
  	(setq N (1+ N))
  	)
	(command ".layer" "s" "THop-TEXT" ""
	     ".text" "j" "ml"  pt36 htext 90 (strcat "= "(rtos sum 2 2) " (M2)")
	         )
	;doi dau thanh cuoi
	(setq pt32 (polar pt32 0 (- KCDC)))
	)
      (repeat 2
	(setq  pt33 (polar pt32 (/ pi 2) (* ktol sld))
           pt34 (polar pt33 0 (- KCDC))
           pt35 (polar pt33 0 (- (/ KCDC 2)))
           pt36 (polar pt35 (/ pi 2) (/ ktol 2))
           )
	(setq sum_all (ssget "w" pt32 pt34 '((0 . "text")))
      	sum_SL (sslength sum_all)
      	)
	(setq N 0
      	sum 0
      	)
	(repeat sum_SL
  	(setq MDT_sum_all (entget (ssname sum_all N))
	    	sum_all_1 (atof (cdr (assoc 1 MDT_sum_all)))
	    	)
  	;tinh tong
  	(setq sum (+ sum_all_1 sum))
  	(setq N (1+ N))
  	)
	(command ".layer" "s" "THop-TEXT" ""
	     ".text" "j" "ml"  pt36 htext 90 (strcat "= "(rtos sum 2 2) " (M3)")
	         )
	;doi dau thanh cuoi
	(setq pt32 (polar pt32 0 (- KCDC)))
	)    
      )    ;dong progn
      )	;dong if
  (princ)
  )    
*********************************************
;tinh cao do thi cong
(defun CDTC ()
  (setvar "cmdecho" 0)
  (setvar "orthomode" 0)
  (setvar "gridmode" 0)
  (setvar "snapmode" 0)
  (setvar "osmode" 0)    
  ;kiem tra bao nhieu doi tuong co do tu nhien
  (setq sum_CDTK (ssget '((0 . "text") (8 . "sn-CDTK")))
	SL_CDTK (sslength sum_CDTK)
	)
  (setq N 0)
  (repeat SL_CDTK
    (setq MDT_CDTK (entget (ssname sum_CDTK N))
       pt37 (cdr (assoc 10 MDT_CDTK))
  	)
    (setq pt38 ( polar pt37 0 (- (* ktol 0.3)))
  	pt39 (polar pt38 (/ pi 2) (* ktol 0.3))
  	pt40 (polar pt37 0 (* ktol 0.3))
  	pt41 (polar pt40 (/ pi 2) (- (* ktol 0.3)))
  	)
    (setq cdtk_1 (ssget "w" pt39 pt41 '((0 . "text") (8 . "sn-CDTK")))
  	MDT_cdtk_1 (entget (ssname cdtk_1 0))
  	cdtk_2 (atof (cdr (assoc 1 MDT_CDTK)))
  	)
 	(setq cdtn_1 (ssget "w" pt39 pt41 '((0 . "text") (8 . "sn-CDTN")))
  	MDT_cdtn_1 (entget (ssname cdtn_1 0))
  	cdtn_2 (atof (cdr (assoc 1 MDT_cdtn_1)))
  	)
    (setq cdtc_1 (- cdtk_2 cdtn_2))
    (setq pt42 (polar pt37 0 (- (* ktol 0.056))))
    (if (< cdtc_1 0)
      (progn
	;dat layer hien hanh
  	(command ".layer" "s" "sn-CDTCdao" "")   
    	(command ".text" "j" "r" pt42 htext 0 (rtos cdtc_1 2 2))
	)
      (progn
	(command ".layer" "s" "sn-CDTCdap" "")   
    	(command ".text" "j" "r" pt42 htext 0 (rtos cdtc_1 2 2))
	)
      )
    ;tang so luong N
    (setq N (1+ N))
    )
  (princ)
  )  
********************************************
;ve ranh gio dao dap
(defun rgdd  ();ranh gio dao dap
  (setq SSC_rgdd (ssget '((0 . "circle") (8 . "sn-vong tron o luoi")))
	LSC_rgdd (sslength SSC_rgdd)
     )  
  (setq N 0)
  (repeat LSC_rgdd
    (command ".layer" "s" "sn-ranhgioidaodap" ""
         )
    ;lay ra ma doi tuong
    (setq MDT_rgdd (entget (ssname SSC_rgdd N))
  	pt_tam_rgdd (cdr (assoc 10 MDT_rgdd)) ;lay ra toa do tam duong tron
  	nol (/ KTOL 2)	;do lon nua o luoi
  	;xac dinh hai diem ben phai     
  	pt19_rgdd (polar pt_tam_rgdd 0 nol)
  	pt20_rgdd (polar pt19_rgdd (/ pi 2) (- nol))
  	;xac dinh diem ben phai
  	pt21_rgdd (polar pt_tam_rgdd 0 (- (+ nol (* nol 0.8))))
  	pt22_rgdd (polar pt21_rgdd (/ pi 2) (+ nol (* nol 0.8)))
  	)
    ;tinh cao do trung binh
    (setq CDTC_dao (ssget "w" pt22_rgdd pt20_rgdd '((0 . "text") (8 . "sn-CDTCdao")))
  	SL_CDTC_dao (sslength CDTC_dao)
  	)
 	(if (= CDTC_dao nil)
      (progn
	(prompt "\nKhong co ranh gioi dao dap")
	)
      (progn    
	(prompt "\nCo ranh gioi dao dap")
	)
      )
    ;(setq CDTC_dap (ssget "w" pt22_rgdd pt20_rgdd '((0 . "text") (8 . "sn-CDTCdap")))
  	;SL_CDTC_dap (sslength CDTC_dap)
  	<img src='http://www.cadviet.com/forum/public/style_emoticons/<#EMO_DIR#>/wink.png' class='bbc_emoticon' alt=';)' />
  
    ;cao do thi cong cac diem nut
    ;(setq CDTC_1 (entget (ssname CDTB 0))
  	;CDTC_11 (atof (cdr (assoc 1 CDTC_1)))
     ; )
    ;(setq CDTC_2 (entget (ssname CDTB 1))
     ; CDTC_22 (atof (cdr (assoc 1 CDTC_2)))
     ; )
    ;(setq CDTC_3 (entget (ssname CDTB 2))
     ; CDTC_33 (atof (cdr (assoc 1 CDTC_3)))
     <img src='http://www.cadviet.com/forum/public/style_emoticons/<#EMO_DIR#>/wink.png' class='bbc_emoticon' alt=';)' />
   ; (setq CDTC_4 (entget (ssname CDTB 3))
     ; CDTC_44 (atof (cdr (assoc 1 CDTC_4)))
	; )
    (setq N (1+ N))
    );dong vong lap repeat
  (princ)
  );ket thuc ham
     
      
********************************************
;chuong trinh chinh goi cac ham tren
;ve o luoi
(defun c:vol ()
  (vol)
  )
;ghi thu tu o luoi
(defun c:TTOL ()
  (TTOL)
  )
;them text vao text cu
(defun c:themtext ()
  (themtext)
  )
;tinh cao do thi cong
(defun c:CDTC ()
  (CDTC)
    )
;ve ranh gioi dao dap
(defun c:RGDD ()
  (RGDD)
  )
;tinh cao do trung binh o luoi
(defun c:CDTB ()
  (CDTB)
  (setq Timfile (findfile "ve o luoi va tinh gia tri o luoi.LSP"))
  (load Timfile)
  (prompt Timfile)
  (princ)
  )
;lap bang tong hop khoi luong
(defun c:THKL ()
  (THKL)
  )

chào bác: e mới bắt đầu học san nền nên ko biết cách dùng lisp của bác?

bác có thể chỉ cách dùng lisp này ko ạ


<<

Filename: 263653_khsn_vol_ttol_themtext_cdtc_rgdd_cdtb_thkl.lsp
Tác giả: thanhduan2407
Bài viết gốc: 160697
Tên lệnh: adv edv
Lisp thêm đỉnh cho PL

code trên rất hay. nhưng có 1 nhuợc điểm cũng rất... dở là không cho undo trong quá trình thêm hoặc bớt đỉnh ketxu ạ. cách thức...

>>

code trên rất hay. nhưng có 1 nhuợc điểm cũng rất... dở là không cho undo trong quá trình thêm hoặc bớt đỉnh ketxu ạ. cách thức undo như khi vẽ 1 pline, có 1 đỉnh nào đó mình pick sai thì gõ U, bỏ đỉnh đó đi để vẽ lại í. Bạn có thể tham khảo code này của mình để sửa nó ngon hơn.

;;; Add vertext into Polyline and LWPolyline 2010 by Thaistreetz
(defun c:Adv (/ DKCV LST LSTPT N PL PL1 PLS PLSTLAST PT PTA WP)
 (if (and (setq PL (car (entsel (TCVN3-Unicode " - Chän ®­êng Pline cÇn thªm ®Ønh ")))) (wcmatch (cdr (assoc 0 (entget PL))) "*POLYLINE"))
	(progn      
		(vl-cmdf "undo" "begin")
		(if (= (cdr (assoc 0 (entget PL))) "POLYLINE")
			(progn
				(setq DKCV T PLSTLAST (getvar "PLINETYPE"))
				(setvar "PLINETYPE" 1)
				(vl-cmdf "convert" "P" "S" PL "")
				(setvar "PLINETYPE" PLSTLAST)
				);progn
			);if
  (setq PLs (ssadd PL (ssadd)))
  (while (progn
           (sssetfirst nil PLs)
					(initget 128 "u")
					(setq PTa (getpoint (TCVN3-Unicode "\nPick ®Ønh cÇn thªm ")))
					(if (= PTa "u") (progn (prompt "- Undo") (vl-cmdf "undo" "Back")) PTa))
	(if (/= PTa "u")
	(progn
	(vl-cmdf "undo" "mark")
   (setq PT (vlax-curve-getPointatParam PL (setq n (fix (vlax-curve-getParamatPoint PL (vlax-curve-getClosestPointto PL (setq PTa (trans PTa 1 0))))))))
	(setq Lst nil)
	(if (= n 0)
		(progn
			(setq Lstpt (reverse(acet-geom-pline-point-list PL nil))
						PL1 (makeLWPolyline lstpt nil nil nil nil nil nil))
			(if (= (fix (vlax-curve-getParamatPoint PL1 (vlax-curve-getClosestPointto PL1 PTa))) (- (length Lstpt) 1))
				(mapcar	'(lambda (x)
					(setq Lst (if (equal x (list 10 (car PT) (cadr PT)) 0.0001)
							(cons x (cons (list 10 (car PTa) (cadr PTa)) Lst))
							(cons x Lst))))
					(entget PL))
				(mapcar	'(lambda (x)
					(setq Lst	(if (equal x (list 10 (car PT) (cadr PT)) 0.0001)
							(cons (list 10 (car PTa) (cadr PTa)) (cons x Lst))
							(cons x Lst))))
					(entget PL)))
			(entdel PL1))						
   (mapcar '(lambda (x)
		(setq Lst (if (equal x (list 10 (car PT) (cadr PT)) 0.0001)
							(cons (list 10 (car PTa) (cadr PTa)) (cons x Lst))
							(cons x Lst)))) (entget PL)))
     (entmod (reverse Lst))))
 );while
 (sssetfirst)
 (if DKCV (vl-cmdf "CONVERTPOLY" "H" wp "")))
 (prompt (TCVN3-Unicode "\n§èi t­îng kh«ng ph¶i Polyline ")));if
(vl-cmdf "undo" "end")
 (princ)
);end
;;; remove vertext into Polyline and LWPolyline
;;; copyright 2010 by Gia_Bach
;;; Edited 2010 by thaistreetz
(defun c:edv (/ removenth bulges coords ent idx param pt DKCV PLSTLAST)
 (defun removenth (n lst / i rtn)
   (setq i -1)
   (foreach x lst (if (/= n (setq i (1+ i)))	(setq rtn (cons x rtn))))
  (reverse rtn))
(vl-cmdf "undo" "begin")
 (while (progn
				 (initget 128 "u")
				 (setq ent (entsel (TCVN3-Unicode "\nChän ®Ønh Pline cÇn xãa: ")))
				 (if (= ent "u") (progn (prompt "- Undo") (vl-cmdf "undo" "Back")) ent))
	(if (and (/= ent "u") (wcmatch (cdr (assoc 0 (entget (car ent)))) "*POLYLINE"))
		(progn
			(vl-cmdf "undo" "Mark")
			(princ (setq pt (osnap (cadr ent) "near")))
			(if (= (cdr (assoc 0 (entget (car ent)))) "POLYLINE")
				(progn
	       (setq DKCV T PLSTLAST (getvar "PLINETYPE"))
	       (setvar "PLINETYPE" 1)
	       (vl-cmdf "convert" "P" "S" (car ent) "")
	       (setvar "PLINETYPE" PLSTLAST)))		    
	    (setq ent (vlax-ename->vla-object (car ent))
						param (atoi (rtos (vlax-curve-getparamatpoint ent pt) 2 0))
						coords (vlax-get ent 'coordinates) idx -1 bulges nil)
	    (repeat (/ (length coords) 2) (setq bulges (cons (vla-getbulge ent (setq idx (1+ idx))) bulges)))
	    (setq bulges (removenth param (reverse bulges)))
	    (repeat 2 (setq coords (removenth (* 2 param) coords)))
	    (vlax-put ent 'coordinates coords)
	    (setq idx -1)
	    (foreach bulge bulges (vla-setbulge ent (setq idx (1+ idx)) bulge))))
);while
(if DKCV (vl-cmdf "CONVERTPOLY" "H" ent ""))
(vl-cmdf "undo" "end")
 (princ)
 );end
(defun TCVN3-Unicode (stsua / index stdich chuht chusua tapsua)
(if (= (getvar "acadver") "16.1s (LMS Tech)") stsua (progn
(setq tapsua
(list	(cons "µ" "\U+00E0")(cons "Ì" "\U+00E8")(cons "ß" "\U+00F2")(cons "ï" "\U+00F9")
(cons "¸" "\U+00E1")(cons "Ð" "\U+00E9")(cons "ã" "\U+00F3")(cons "ó" "\U+00FA")
(cons "¶" "\U+1EA3")(cons "Î" "\U+1EBB")(cons "á" "\U+1ECF")(cons "ñ" "\U+1EE7")
(cons "·" "\U+00E3")(cons "Ï" "\U+1EBD")(cons "â" "\U+00F5")(cons "ò" "\U+0169")
(cons "¹" "\U+1EA1")(cons "Ñ" "\U+1EB9")(cons "ä" "\U+1ECD")(cons "ô" "\U+1EE5")
(cons "©" "\U+00E2")(cons "ª" "\U+00EA")(cons "«" "\U+00F4")(cons "­" "\U+01B0")
(cons "Ç" "\U+1EA7")(cons "Ò" "\U+1EC1")(cons "å" "\U+1ED3")(cons "õ" "\U+1EEB")
(cons "Ê" "\U+1EA5")(cons "Õ" "\U+1EBF")(cons "è" "\U+1ED1")(cons "ø" "\U+1EE9")
(cons "È" "\U+1EA9")(cons "Ó" "\U+1EC3")(cons "æ" "\U+1ED5")(cons "ö" "\U+1EED")
(cons "É" "\U+1EAB")(cons "Ô" "\U+1EC5")(cons "ç" "\U+1ED7")(cons "÷" "\U+1EEF")
(cons "Ë" "\U+1EAD")(cons "Ö" "\U+1EC7")(cons "é" "\U+1ED9")(cons "ù" "\U+1EF1")
(cons "¨" "\U+0103")(cons "×" "\U+00EC")(cons "¬" "\U+01A1")(cons "ú" "\U+1EF3")
(cons "»" "\U+1EB1")(cons "Ý" "\U+00ED")(cons "ê" "\U+1EDD")(cons "ý" "\U+00FD")
(cons "¾" "\U+1EAF")(cons "Ø" "\U+1EC9")(cons "í" "\U+1EDB")(cons "û" "\U+1EF7")
(cons "¼" "\U+1EB3")(cons "Ü" "\U+0129")(cons "ë" "\U+1EDF")(cons "ü" "\U+1EF9")
(cons "½" "\U+1EB5")(cons "Þ" "\U+1ECB")(cons "ì" "\U+1EE1")(cons "þ" "\U+1EF5")
(cons "Æ" "\U+1EB7")(cons "®" "\U+0111")(cons "î" "\U+1EE3")(cons "¦" "\U+01AF")
(cons "¢" "\U+00C2")(cons "§" "\U+0110")(cons "¤" "\U+00D4")(cons "¥" "\U+01A0")
(cons "¡" "\U+0102")(cons "£" "\U+00CA")))
(setq index 1 stdich "")
(repeat (strlen stsua)
(setq chuht  (substr stsua index 1)
index  (1+ index)
chusua (cond ((assoc chuht tapsua) (cdr (assoc chuht tapsua))) (t chuht))
stdich (strcat stdich chusua)))
stdich)))
(defun MakeLWPolyline (listpoint closed Linetype LTScale Layer Color xdata / Lst)
(setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 6 (if Linetype Linetype "bylayer"))
(cons 48 (if LTScale LTScale 1))
(cons 62 (if Color Color 256))
'(100 . "AcDbPolyline")
(cons 90 (length listpoint))
(cons 70 (if closed 1 0))))
(foreach PP listpoint	(setq Lst (append Lst (list (cons 10 PP)))))
(if xdata (setq Lst (append lst (list (cons -3 (list xdata))))))
(entmakex Lst));end 

Lisp của bác viết rất hay. Vote cho bác 1 cái. Tuy nhiên nếu như mình kích chọn Pline rồi chọn 1 điểm xa cái Pline đó thì điểm thêm sẽ không đúng ý (Giống như của Ketxu đó). Vẫn còn thiếu chức năng xóa đỉnh Pline. Hii. Đấy là em nhận xét và so sánh thôi vì cả 2 lisp đều pro mà. Hii.


<<

Filename: 160697_adv_edv.lsp
Tác giả: tvkill
Bài viết gốc: 201620
Tên lệnh: kb ccd
xin lisp ghi cao độ

Mình đã sửa lại một chút cho thuận tiện hơn

Bạn dùng thử nhé

;;;-----Free lisp code from CADViet.com - Edited...
>>

Mình đã sửa lại một chút cho thuận tiện hơn

Bạn dùng thử nhé

;;;-----Free lisp code from CADViet.com - Edited by Mathan - From VECC
(defun CheckObj(e MyType) (equal (cdr (assoc 0 (entget e))) MyType))
;;;-----------------------------------------
(defun FilObj(ss1 MyType / ss2 i e)
(setq ss2 (ssadd) i 0)
(repeat (sslength ss1)
(setq e (ssname ss1 i) i (1+ i))
(if (CheckObj e MyType) (ssadd e ss2) )
)
(eval ss2)
)
;;;-----------------------------------------
(defun SelData( / OK)
(setq OK nil)
(while (not OK)
(prompt "\tChon text: ")
(setq ss (FilObj (ssget) "TEXT"))
(if (> (sslength ss) 0) (setq OK T) (princ "\nDoi tuong chon khong phai text"))
)
)
;;;-----------------------------------------
(defun WriteRes1(kq / OK e chen data txt)
(setq OK nil)
(while (not OK)
(if (null cheno) (setq cheno ""))
(setq chen (getstring (strcat "Text chen them vao phia truoc: an 1 de nhan text( " cheno " ) hoac nhap text: ")))
(if (= chen "1") (setq chen cheno) (setq cheno chen))
(setq e (car (entsel "\nChon text ghi ket qua cao do: ")))
(if (CheckObj e "TEXT") (setq OK T) (princ "\nDoi tuong chon khong phai text"))
)
(setq txt (strcat chen (rtos kq 2 tp)))
(entmod (subst (cons 1 txt) (assoc 1 (setq data (entget e))) data))
(princ)
)
;;;-----------------------------------------
(defun C:kb( / new1 )
(if (null newo) (setq newo 1000.0))
(setq new1 (getreal (strcat "\nNhap ty le ban ve 1/ <" (rtos newo) ">:ok  or: ")))
(if (null new1) (setq new1 newo) (setq newo new1))
(setq tyle newo)
(setq tp (getint "\nNhap vao so chu so thap phan: "))
(setq phuongan (getint "\nNhap vao goc phuong an chen vao text co san (1) hoac tao text moi (2): "))
(if (= phuongan 2)
  (progn
(setq caochu (getreal "\nNhap vao chieu cao chu: "))
(setq goctext (getreal "\nNhap vao goc ra chu: "))
)
)
)
;;;;;;;;;;---------------------------------
(defun C:ccd( / )
(setq dgoc (getpoint "\nChon diem goc cao do: "))
(setq cdg (getreal "\nNhap vao cao do goc: "))
(setq i 1 n 1000)
(while (< i n)
(setq dchon (getpoint "\nChon diem can tinh cao do: "))
(setq cddc (- cdg (* (/ 1 tyle) (- (cadr dgoc) (cadr dchon) )))	)
(if (= phuongan 1) (WriteRes1 cddc) )
(if (= phuongan 2) (command "TEXT" dchon caochu goctext (rtos cddc 2 tp)))
(setq i (+ i 1))
)
(princ)
)

Vẫn dùng lệnh KB để khai báo và CCD để chèn cao độ bạn nhé

Lưu ý:

Text bạn định chèn vào phải là TEXT chứ không phải là MTEXT bạn nhé, nếu là MTEXT thì bạn phải EXPLODE nó ra

Chèn vào text có sẵn bạn nhập phương án là 1 nhé.

Nếu không cần chèn thêm Text phía trước cao độ ghi ra thì bạn chỉ cần ENTER hoặc SPACE để bỏ qua thôi

thak bạn nha!nhưng bạn có thể giúp mình là:

1.chỉ cần nhập một lần cao độ gốc không,->> để pick các điêm khác nữa

2.chi cho ra 1 phương án chon text cần sửa lại(giông như lệnh tính diện tích cho ra text có sẵn)

vì một mặt cắt ngang có đến gần chục điểm làm như thế cung lâu lắm bạn à,mong bạn giúp mình cái.


<<

Filename: 201620_kb_ccd.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 420869
Tên lệnh: test
Hàm block trong lisp?

Tặng bạn.

	(defun c:test (/ p d1 d2 d3 tm1 tm2)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq p (getpoint "\Chon diem dat:"))
(setq d1 (polar p (/ (* pi 90) 180) 2000))
(setq d2 (polar p 0 2000))
(setq d (polar p (/ (* pi 45) 180) 1000))
(command "pline" p d1 d2 p "")
(setq tm1 (entlast))
(command "-hatch" "p" "ANSI31" 500 0 d "")
(setq tm2 (entlast))
 (Objs2Blk (mapcar 'vlax-ename->vla-object (list tm1 tm2)) p "abc")
(setvar...
>>

Tặng bạn.

	(defun c:test (/ p d1 d2 d3 tm1 tm2)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq p (getpoint "\Chon diem dat:"))
(setq d1 (polar p (/ (* pi 90) 180) 2000))
(setq d2 (polar p 0 2000))
(setq d (polar p (/ (* pi 45) 180) 1000))
(command "pline" p d1 d2 p "")
(setq tm1 (entlast))
(command "-hatch" "p" "ANSI31" 500 0 d "")
(setq tm2 (entlast))
 (Objs2Blk (mapcar 'vlax-ename->vla-object (list tm1 tm2)) p "abc")
(setvar "osmode" oldos)
(princ)
)
;----- Converts a selection of objects to a block reference. by HA.
(defun Objs2Blk(lst pt bn / doc)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vlax-invoke doc 'copyobjects lst (setq bn (vlax-invoke (vla-get-blocks doc) 'add (trans pt 1 0) bn)))
 (vlax-invoke (vlax-get-property doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)) 'insertblock (trans pt 1 0) (vla-get-name bn) 1.0 1.0 1.0 0.0)
 (mapcar 'vla-delete lst))
	


<<

Filename: 420869_test.lsp
Tác giả: vantuan18nd
Bài viết gốc: 285746
Tên lệnh: rft
lisp Phun tọa độ các điểm từ file txt vào CAD

 

Bạn chạy thử LISP đọc file txt có cấu trúc file dữ liệu như yêu cầu : STTXYH

Chú ý : trong file dữ liệu bạn Post lên, 3...

>>

 

Bạn chạy thử LISP đọc file txt có cấu trúc file dữ liệu như yêu cầu : STTXYH

Chú ý : trong file dữ liệu bạn Post lên, 3 dòng (57,189,213) có cấu trúc khác biệt.

Chiều cao Txt có thể thay đổi tại dòng : (setq h ....)

(defun c:RFT(/ data f h line pt spc ten val);Read File Txt(vl-load-com)  (defun Split (Str Char / Lst pos)    (while (setq pos (vl-string-search Char Str))      (if (null Lst)	(setq Lst (list (substr Str 1 pos)))	(setq Lst (append Lst (list (read (substr Str 1 pos))))))      (setq Str (substr Str (+ pos 2)) ))    (setq Lst (append Lst (list (read Str)))))    (if (setq ten (getfiled "Chon File txt" (getvar "dwgprefix") "txt" 8))    (progn      (setq spc (vla-get-ModelSpace (vla-get-ActiveDocument(vlax-get-Acad-Object))))      (setq h (* (getvar "dimtxt")(getvar "dimscale")))      (setq f (open (findfile ten) "r"))      (while (setq Line (read-line f))	(if (vl-string-search "\t" Line)	  (progn	    (setq data (split Line "\t" )		  val (car data)		  pt  (cdr data) )	    (if (not(vl-catch-all-error-p (vl-catch-all-apply 'vlax-3d-point pt)))	      (vla-addtext spc val (vlax-3d-point pt) h) ))))  ))  (princ))

Lisp bị lỗi thế này : Command: ; error: malformed list on input

Ai giúp với


<<

Filename: 285746_rft.lsp
Tác giả: Khangrm
Bài viết gốc: 323099
Tên lệnh: cc
Hỏi cách đổi màu đối tượng trong CAD?

 

Các bạn test cái elleHCSC viết xem nhé, mình chạy thấy nó ổn:

>>

 

Các bạn test cái elleHCSC viết xem nhé, mình chạy thấy nó ổn:

;;---------------------------------------------------------------------------------Test func(defun C:CC ( / ss1 col)  (vl-load-com)  (prompt "\n<< Change color for TEXT, MTEXT only >>")  (initget (+ 1 2 4))  (setq col (getint "\n - Color (from 1 to 255, 256 for ByLayer)?: "))  (setq ss1 (ssget (list(cons 0 "*TEXT"))))  (DoiMau1 ss1 col)  (princ));;---------------------------------------------------------------------------------Test func(defun DoiMau1 (ss mau / ent i j Vla-obj mt mc tmp tf bef aff ret)  (setq i 0)  (setq tmp (strcat "C" (itoa mau)))    (while (< i (sslength ss))    (setq ent (ssname ss i))    (setq Vla-obj (vlax-ename->vla-object ent))    (if (= (cdr (assoc 0 (entget ent))) "MTEXT")      (progn	(setq mt (vlax-get-property Vla-obj 'TextString))		;find color def	(setq j (vl-string-search (strcase "\\c") mt))	(if (/= j nil)	  (progn	    (setq bef (SubStr mt 1 j))	    (setq ret (vl-string-left-trim bef mt))	    (setq tf (LeftStr ";" ret))	    (setq aff (vl-string-left-trim tf ret))	    (setq mc (strcat bef "\\" tmp aff))    	    (vlax-put-property Vla-obj 'TextString mc)	    	  )	  (vlax-put-property Vla-obj 'Color mau)	);if      );      (vlax-put-property Vla-obj 'Color mau) ;for TEXT obj    );if    (setq i (1+ i))  ));;---------------------------------------------------------------------------------Test func(Defun LeftStr (Key Str / S i n)  (if (or Str Key)    (Progn      (Setq i 1 n(Strlen Str))      (While (and (<= i n) (/= Key (SubStr Str i 1)))	(Setq i (+ 1 i))      );while      (Setq S (SubStr Str 1 (- i 1)))    );progn  );if  S);;---------------------------------------------------------------------------------Test func

Thanks bạn

elleHCSC. Lisp chạy tốt bạn nhé
<<

Filename: 323099_cc.lsp
Tác giả: hang xom
Bài viết gốc: 15986
Tên lệnh: cot00 dc
Đánh cốt tự động bằng lisp DC
Bạn đã bao giờ mệt vì phải tính toán để đánh cốt cao độ của mặt cắt và mặt đứng hay chưa?

vừa phải tính xem từ điểm cần tính đến cốt 0.00 có khoảng...

>>
Bạn đã bao giờ mệt vì phải tính toán để đánh cốt cao độ của mặt cắt và mặt đứng hay chưa?

vừa phải tính xem từ điểm cần tính đến cốt 0.00 có khoảng cách h bao nhiêu, rồi lại nhập vào bản vẽ.

 

Bây giờ, bạn có thể làm điều này một cách nhanh chóng và tự động nhờ vào lisp dc của cadviet.

với lisp này, bạn chỉ cần gõ lệnh dc, chương trình sẽ hỏi bạn điểm bạn cần đánh cốt, sau đó chương trình sẽ chèn ký hiệu cốt vào đúng vị trí và giá trị mà bạn cần. Bạn dùng lệnh cot00 để định nghĩa điểm có cao độ là cot00.

 

Để sử dụng lệnh, trước tiên phải copy file cot.dwg vào thư mục support - Đây là file chứa nội dung của ký hiệu cốt. Sau đó appload file danhcot.lsp để sử dụng lệnh.

 

(defun c:cot00 ()
 (setq Cot00 (cadr (getpoint "\nDiem co cot 0.000: ")))
 (princ)
)
(defun c:dc (/ diem caodo dau giatri dodaichuoi)
 (if (not cot00)
(progn
  (alert "chua co cot 0.000")
  (c:cot00)
)
 )
 (grdraw (list	(+ (car (getvar "VIEWCTR")) (* -1.0 (getvar "VIEWSIZE")))
	cot00
  )
  (list	(+ (car (getvar "VIEWCTR")) (* 1.0 (getvar "VIEWSIZE")))
	cot00
  )
  1
  1
 )
 (setq
diem   (getpoint "\nVao diem can danh cot: ")
caodo  (- (cadr diem) cot00)
dau	   (cond
	 ((equal caodo 0.0 0.01) "%%p")
	 ((> caodo 0.0) "+")
	 (t "-")
   )
giatri (rtos caodo 2 0)
 )
 (if (= "-" (substr giatri 1 1))
(setq giatri (substr giatri 2))
 )
 (while (< (strlen giatri) 4)
(setq giatri (strcat "0" giatri))
 )
 (setq	dodaichuoi (strlen giatri)
giatri	   (strcat (substr giatri 1 (- dodaichuoi 3))
		   "."
		   (substr giatri (- dodaichuoi 2))
	   )
 )
 (command ".insert" "danhcot" diem 100.0 100.0 0.0 dau giatri)
 (redraw)
)

file danhcot.lsp: <a href="http://www.cadviet.com/upfiles/danhcot.lsp" target="_blank">http://www.cadviet.com/upfiles/danhcot.lsp</a>

file danhcot.dwg: <a href="http://www.cadviet.com/upfiles/DANHCOT.zip" target="_blank">http://www.cadviet.com/upfiles/DANHCOT.zip</a>

 

Lưu ý: Với mỗi file DWG mà bạn vẽ, bạn phải đặt lại biến ATTDIA về 0 trước khi dùng lệnh DC (chỉ cần đặt 1 lần cho mỗi file).

 

Rất mong có được sự phản hồi.

Cảm ơn.

 

 

Cái Lisp này của bác quá tiện. Cảm ơn bác nhiều (Em đã ấn nút Thanks roi nhé!)


<<

Filename: 15986_cot00_dc.lsp
Tác giả: vbao
Bài viết gốc: 2083
Tên lệnh: mm
Lisp tìm giá trị max hoặc min trong text
Bạn thử dùng trình lisp sau. Appload và gõ mm để chạy. Nếu chưa đúng ý, bạn nêu rõ hơn yêu cầu.

 

(defun C:MM (/ ss i V Vmax Vmin) 
(setq ss (ssget '((0 ....
>>
Bạn thử dùng trình lisp sau. Appload và gõ mm để chạy. Nếu chưa đúng ý, bạn nêu rõ hơn yêu cầu.

 

(defun C:MM (/ ss i V Vmax Vmin) 
(setq ss (ssget '((0 . "TEXT"))) i 0)
(repeat (sslength ss)
   (setq V (atof (cdr (assoc 1 (entget (ssname ss i))))))
   (if (= i 0) (setq Vmax V Vmin V))
   (if (> V Vmax) (setq Vmax V))
   (if (< V Vmin) (setq Vmin V))
   (setq i (1+ i))
)
(command "redraw")
(princ (strcat "\nMax = " (rtos Vmax) "\tMin = " (rtos Vmin)))
(princ)
)

 

 

Cảm ơn bạn ssg đã giúp tôi giải quyết vấn đề đã nêu ra, tuy nhiên bạn có thể viết thêm sau khi hiển thị các giá trị min max tại dòng command, ta có thể hiển thị trạng thái đã chọn số lớn nhất hay nhỏ nhất trên bản vẽ... được không bạn?


<<

Filename: 2083_mm.lsp
Tác giả: KE AN MAY DI VANG
Bài viết gốc: 38011
Tên lệnh: ilp ipp
Tìm giao điểm của 2 đối tượng trong bản vẽ CAD
Mình muốn tìm giao điểm của 2 đường nào đó thì làm thế nào

 

Muốn tìm giao điển của hai đường thẳng cùng nằm trong một mặt phẳng bạn...

>>
Mình muốn tìm giao điểm của 2 đường nào đó thì làm thế nào

 

Muốn tìm giao điển của hai đường thẳng cùng nằm trong một mặt phẳng bạn dùng lệnh FILLET với R= 0 ( Auto Cad 2007)

- Với hai đường thẳng không // với nhau hoặc một đường thẳng nằm trong phạm vi R của một đường cong nó sẽ cắt nhau tại 1 điểm.

- Với hai đường thẳng // với nhau, giao đểm của nó sẽ là một nửa đường tròn có đường kính bằng khoảng cách giữa hai đường thẳng đó.

 

Trường hợp hai đường thẳng chéo nhau trong không gian sẽ không tìm được giao điểm của hai đường thẳng. Nhưng ta vẫn có thể tìm được giao điểm của hai đường thẳng này với đường thẳng thứ 3 vuông góc với mặt phẳng mà hai đường đó tạo bởi với mặt phẳng một góc <90 độ

 

Ví dụ đường thẳng a tạo với mặt phẳng XOY một góc 27 độ, đường thẳng b tạo với mặt phẳng một góc 38 độ. Dùng lệnh TRIM bạn sẽ tìm được giao điểm của hai đường thẳng này với đường thẳng vuông góc với mặt phẳng XOY. ( đường thẳng này sẽ đi qua hai điểm bị cắt bởi lệnh TRIM. Tôi thường xuyên dùng cách này để kết nối đường ống trong không gian nối hai thiết bị có chiều cao khác nhau.

Tôi thấy có cái lips của bạn SSG bạn ngâm cứu thử xem !( lips tìm giao của đường thẳng với mặt phẳng, bạn có thể nhờ SSG viết lips tìm giao của hai đường thẳng)

Các bạn dùng thử lisp này:

1- Lệnh ILP (Intersection between Line and Plane), chọn line và chỉ định 3 điểm thuộc mặt phẳng. Kết quả: 1 point giao điểm

2- Lệnh IPP (Intersection between Plane and Plane), chỉ định 6 điểm xác định 2 mặt phẳng. Kết quả: 1 line giao tuyến.

 

;;;------------------------------------------
(defun intlp(p1 p2 p3 p4 p5 / tp1 tp2 ip)
(command "ucs" "n" "3" p3 p4 p5)
(setq
   tp1 (trans p1 0 1)
   tp2 (trans p2 0 1)
)
(if (setq ip (inters tp1 tp2 (list (car tp1) (cadr tp1) 0) (list (car tp2) (cadr tp2) 0) nil))
   (setq ip (trans ip 1 0))
)
(command "ucs" "w")
ip
)
;;;------------------------------------------
(defun C:ILP(/ dL pL1 pL2 pp1 pp2 pp3 p)
(setq
   dL (entget (car (entsel "\nChon duong thang:")))
   pL1 (cdr (assoc 10 dL))
   pL2  (cdr (assoc 11 dL))
   pp1 (getpoint "\nDiem 1 tren mat phang:")
   pp2 (getpoint pp1 "\nDiem 2 tren mat phang:")
   pp3 (getpoint pp2 "\nDiem 3 tren mat phang:")
   p (intlp pL1 pL2 pp1 pp2 pp3)
)
(setvar "pdmode" 34)
(entmake (list (cons 0 "point") (cons 10 p)))
(princ)
)
;;;------------------------------------------
(defun C:IPP(/ p11 p12 p13 p21 p22 p23 p1 p2)
(setq
   p11 (getpoint "\nDiem 1 tren mat phang 1:")
   p12 (getpoint p11 "\nDiem 2 tren mat phang 1:")
   p13 (getpoint p12 "\nDiem 3 tren mat phang 1:")
   p21 (getpoint "\nDiem 1 tren mat phang 2:")
   p22 (getpoint p21 "\nDiem 2 tren mat phang 2:")
   p23 (getpoint p22 "\nDiem 3 tren mat phang 2:")
   p1 (intlp p11 p12 p21 p22 p23 )
   p2 (intlp p11 p13 p21 p22 p23 )
)
(entmake (list (cons 0 "line") (cons 10 p1) (cons 11 p2)))
(princ)
)
;;;------------------------------------------


<<

Filename: 38011_ilp_ipp.lsp
Tác giả: avi612
Bài viết gốc: 232549
Tên lệnh: cd
Pro ơi Giúp em về lisp Cut Dim!

Em upload lisp CUT DIM được rồi nhưng khi gõ lệnh CD thì trên con trỏ...

>>

Em upload lisp CUT DIM được rồi nhưng khi gõ lệnh CD thì trên con trỏ chuột lại không thấy có lệnh đó xuất hiện mà lại là  cdate, cdorder, cdyndisplaymode. Lúc trước em đã dùng lệnh cutdim được rồi nhưng không hiểu sao lần này không hiệu quả. Rất mong các pro giúp em!!!

 

Chắc vấn đề ở chổ load lisp của bạn đó...nếu lisp load thành công thì tên lệnh CD sẽ hiện ra cho bạn chọn, còn nếu ko thấy nghĩa là lisp chưa load được roài...

 

Có cái lisp chức năng tương tự share cho bạn...cái này đi lang thang gõ Google có được đó...cho bạn 3 lựa chọn (cắt chân, cắt đường thể hiện, cắt chân và đường thể hiện)

 

(DEFUN C:CD (/ CMD SS LTH DEM PT DS KDL N70 GOCX GOCY PT13 PT14 PTI PT13I PT14I

PT13N PT14N O13 O14 N13 N14 OSM OLDERR PT10 PT11)

 

(defun myerror (s) ; If an error (such as CTRL-C) occurs

; while this command is active...

(cond

((= s "quit / exit abort") (princ))

((/= s "Function cancelled") (princ (strcat "\nError: " s)))

)

(setvar "cmdecho" CMD) ; Restore saved modes

(setvar "osmode" OSM)

(setq *error* OLDERR) ; Restore old *error* handler

(princ)

)

 

 

(SETQ CMD (GETVAR "CMDECHO"))

(SETQ OSM (GETVAR "OSMODE"))

(SETQ OLDERR *error*

*error* myerror)

(PRINC "Please select Dimension object!")

(SETQ SS (SSGET))

(SETVAR "CMDECHO" 0)

(SETQ PT (GETPOINT "Point to trim or extend:"))

(SETQ PT (TRANS PT 1 0))

(COMMAND "UCS" "W")

(SETQ LTH (SSLENGTH SS))

(SETQ DEM 0)

(WHILE (< DEM LTH)

(PROGN

(SETQ DS (ENTGET (SSNAME SS DEM)))

(SETQ KDL (CDR (ASSOC 0 DS)))

(IF (= "DIMENSION" KDL)

(PROGN

(SETQ PT10 (CDR (ASSOC 10 DS)))

(SETQ PT11 (CDR (ASSOC 11 DS)))

(SETQ PT13 (CDR (ASSOC 13 DS)))

(SETQ PT14 (CDR (ASSOC 14 DS)))

(SETQ N70 (CDR (ASSOC 70 DS)))

(IF (OR (= N70 32) (= N70 33) (= N70 160) (= N70 161))

(PROGN

(SETQ GOCY (ANGLE PT10 PT14))

(SETQ GOCX (+ GOCY (/ PI 2)))

)

)

(SETVAR "OSMODE" 0)

(SETQ PTI (POLAR PT GOCX 2))

(SETQ PT13I (POLAR PT13 GOCY 2))

(SETQ PT14I (POLAR PT14 GOCY 2))

(SETQ PT13N (INTERS PT PTI PT13 PT13I NIL))

(SETQ PT14N (INTERS PT PTI PT14 PT14I NIL))

(SETQ O13 (ASSOC 13 DS))

(SETQ O14 (ASSOC 14 DS))

(SETQ N13 (CONS 13 PT13N))

(SETQ N14 (CONS 14 PT14N))

(SETQ DS (SUBST N13 O13 DS))

(SETQ DS (SUBST N14 O14 DS))

(ENTMOD DS)

)

)

(SETQ DEM (+ DEM 1))

)

)

(COMMAND "UCS" "P")

(SETVAR "CMDECHO" CMD)

(SETVAR "OSMODE" OSM)

(setq *error* OLDERR) ; Restore old *error* handler

(PRINC)

)

;=======================================================

;Cat duong DIM

(DEFUN C:CX (/ CMD SS LTH DEM PT DS KDL N70 GOCX GOCY PT13 PT14 PTI

PT10 PT10I PT10N O10 N10 PT11 PT11N O11 N11 KC OSM OLDERR)

 

(defun myerror (s) ; If an error (such as CTRL-C) occurs

; while this command is active...

(cond

((= s "quit / exit abort") (princ))

((/= s "Function cancelled") (princ (strcat "\nError: " s)))

)

(setvar "cmdecho" CMD) ; Restore saved modes

(setvar "osmode" OSM)

(setq *error* OLDERR) ; Restore old *error* handler

(princ)

)

 

(SETQ CMD (GETVAR "CMDECHO"))

(SETQ OSM (GETVAR "OSMODE"))

(SETQ OLDERR *error*

*error* myerror)

(PRINC "Please select dimension object!")

(SETQ SS (SSGET))

(SETVAR "CMDECHO" 0)

(SETQ PT (GETPOINT "Point to trim or extend:"))

(SETQ PT (TRANS PT 1 0))

(COMMAND "UCS" "W")

(SETQ LTH (SSLENGTH SS))

(SETQ DEM 0)

(WHILE (< DEM LTH)

(PROGN

(SETQ DS (ENTGET (SSNAME SS DEM)))

(SETQ KDL (CDR (ASSOC 0 DS)))

(IF (= "DIMENSION" KDL)

(PROGN

(SETQ PT13 (CDR (ASSOC 13 DS)))

(SETQ PT14 (CDR (ASSOC 14 DS)))

(SETQ PT10 (CDR (ASSOC 10 DS)))

(SETQ PT11 (CDR (ASSOC 11 DS)))

(SETQ N70 (CDR (ASSOC 70 DS)))

(IF (OR (= N70 32) (= N70 33) (= N70 160) (= N70 161))

(PROGN

(SETQ GOCY (ANGLE PT10 PT14))

(SETQ GOCX (+ GOCY (/ PI 2)))

)

)

(SETVAR "OSMODE" 0)

(SETQ PTI (POLAR PT GOCX 2))

(SETQ PT10I (POLAR PT10 GOCY 2))

(SETQ PT10N (INTERS PT PTI PT10 PT10I NIL))

(SETQ KC (DISTANCE PT10 PT10N))

(SETQ O10 (ASSOC 10 DS))

(SETQ N10 (CONS 10 PT10N))

(SETQ DS (SUBST N10 O10 DS))

(SETQ PT11N (POLAR PT11 (ANGLE PT10 PT10N) KC))

(SETQ O11 (ASSOC 11 DS))

(SETQ N11 (CONS 11 PT11N))

(SETQ DS (SUBST N11 O11 DS))

(ENTMOD DS)

)

)

(SETQ DEM (+ DEM 1))

)

)

(COMMAND "UCS" "P")

(SETVAR "CMDECHO" CMD)

(SETVAR "OSMODE" OSM)

(setq *error* OLDERR)

(PRINC)

)

 

;=======================================================

;Cat chan va duong DIM

(defun c:cdx (/ entdt dcat1 dcat2 sodimsua index sodt ssdt tt)

(defun cdim (entdt pchan pduong / tt old10

old13 old14 new10 new13 new14 p10n

p13n p14n p10o p13o p14o gocduong

gocchan pchanb pduongb loaidim

)

(defun chanvuonggoc (ph p1 p2 / ptemp pkq goc)

(setq

goc (+ (angle p1 p2) (/ pi 2.0))

ptemp (polar ph goc 1000.0)

pkq (inters ph ptemp p1 p2 nil)

)

pkq

)

(setq

tt (entget entdt)

old10 (assoc '10 tt)

old13 (assoc '13 tt)

old14 (assoc '14 tt)

p10o (cdr old10)

p13o (cdr old13)

p14o (cdr old14)

loaidim (logand (cdr (assoc '70 tt)) 7)

gocduong (cond

((= loaidim 1) (angle p13o p14o))

((= loaidim 0) (cdr (assoc '50 tt)))

(t nil)

)

pchan (cond

(pchan (list (car pchan) (cadr pchan) 0.0))

(t pchan)

)

pduong (cond

(pduong (list (car pduong) (cadr pduong) 0.0))

(t pduong)

)

 

)

(if gocduong

(progn

(if pchan

(setq

pchanb (polar pchan gocduong 1000.0)

p13n (chanvuonggoc (list (car p13o) (cadr p13o) 0.0) pchan pchanb)

p14n (chanvuonggoc (list (car p14o) (cadr p14o) 0.0) pchan pchanb)

new13 (cons 13 p13n)

new14 (cons 14 p14n)

tt (subst new13 old13 tt)

tt (subst new14 old14 tt)

)

)

(if pduong

(setq

pduongb (polar pduong gocduong 1000.0)

p10n (chanvuonggoc (list (car p10o) (cadr p10o) 0.0) pduong pduongb)

new10 (cons 10 p10n)

tt (subst new10 old10 tt)

)

)

(entmod tt)

)

)

gocduong

)

(setq ssdt (ssget '((0 . "DIMENSION")))

dcat1 (getpoint "\n\U+0110i\U+1EC3m c\U+1EAFt chân DIM: ")

dcat2 (getpoint "\n\U+0110i\U+1EC3m c\U+1EAFt \U+0111\U+01B0\U+1EDDng DIM: ")

 

dcat1 (cond

(dcat1 (trans dcat1 1 0))

(t nil)

)

dcat2 (cond

(dcat2 (trans dcat2 1 0))

(t nil)

)

sodt (sslength ssdt)

index 0

sodimsua 0

)

(repeat sodt

(setq entdt (ssname ssdt index)

index (1+ index)

tt (entget entdt)

 

)

(if (cdim entdt dcat1 dcat2)

(setq sodimsua (1+ sodimsua))

)

)

(prompt (strcat "\n*** \U+0110ã ch\U+1EC9nh s\U+1EEFa Dimension ***"))

(princ)

(princ)

)

 

nguồn: http://www.tramx.vn/Baiviet.aspx?id=Mr.Cùi422201312006


<<

Filename: 232549_cd.lsp
Tác giả: thanhlong.hygt
Bài viết gốc: 247432
Tên lệnh: kk
lisp xoay block theo hướng pline cho trước

 

Tặng bạn cái Lisp như yêu cầu

;========LISP XOAY BLOCK THEO HUONG...
>>

 

Tặng bạn cái Lisp như yêu cầu

;========LISP XOAY BLOCK THEO HUONG TUYEN==========
;=============KANGKUNG 28/03/2013==================
(defun C:KK()
  (command "UNDO" "BE")
  (setq tuyen nil)
  (while (= (setq tuyen (car (entsel "\n Chon tuyen:\n"))) nil))
  (setq taphop(ssget '((0 . "INSERT"))))
  (setq index 0)
  (while (< index (sslength taphop))
    (setq block(entget (ssname taphop index)))
    (setq insertpoint(cdr (assoc 10 block)))
    (if (= (vlax-curve-getDistAtPoint tuyen (vlax-curve-getClosestPointTo tuyen insertpoint)) (vla-get-length (vlax-ename->vla-object tuyen)))
      (entmod (subst (cons 50 (+ pi (angle (vlax-curve-getClosestPointTo tuyen insertpoint) ( vlax-curve-getPointAtDist tuyen (+ (vlax-curve-getDistAtPoint tuyen (vlax-curve-getClosestPointTo tuyen insertpoint)) -0.001))))) (assoc 50 block) block))
      (entmod (subst (cons 50 (+ pi (angle ( vlax-curve-getPointAtDist tuyen (+ (vlax-curve-getDistAtPoint tuyen (vlax-curve-getClosestPointTo tuyen insertpoint)) 0.001)) (vlax-curve-getClosestPointTo tuyen insertpoint)))) (assoc 50 block) block))
      )
    (setq index (+ index 1)))
  (command "UNDO" "END")
  )
(princ "\n                Written By KangKung - 28/03/2013\n")
(princ "\n                  Nhap KK de chay chuong trinh\n")

Bác ơi e dùng lisp bác nhưng không quay được tối tượng att trong block. bác sửa giúp e với ạ


<<

Filename: 247432_kk.lsp
Tác giả: nghiautc
Bài viết gốc: 59919
Tên lệnh: t2u
chuyển bảng mã từ TCVN3 sang UNICODE
Bạn dùng lệnh T2U (TCVN3 to Unicode)

(defun c:t2u (/ taptext)
 (defun chuyenfontstr
	     (stsua / daichuoi index stdich chuht CHUSUA tAPSUA)                            ...
>>
Bạn dùng lệnh T2U (TCVN3 to Unicode)

(defun c:t2u (/ taptext)
 (defun chuyenfontstr
	     (stsua / daichuoi index stdich chuht CHUSUA tAPSUA)                              
 (setq
   tapsua (list
(cons "®" "\U+0110")
(cons "§" "\U+0110")
(cons "µ" "À")
(cons "¸" "Á")
(cons "¶" "\U+1EA2")
(cons "·" "Ã")
(cons "¹" "\U+1EA0")
(cons "©" "Â")
(cons "¢" "Â")
(cons "Ç" "\U+1EA6")
(cons "Ê" "\U+1EA4")
(cons "È" "\U+1EA8")
(cons "É" "\U+1EAA")
(cons "Ë" "\U+1EAC")
(cons "¨" "\U+0102")
(cons "¡" "\U+0102")
(cons "»" "\U+1EB0")
(cons "¾" "\U+1EAE")
(cons "¼" "\U+1EB2")
(cons "½" "\U+1EB4")
(cons "Æ" "\U+1EB6")
(cons "Ì" "È")
(cons "Ð" "É")
(cons "Î" "\U+1EBA")
(cons "Ï" "\U+1EBC")
(cons "Ñ" "\U+1EB8")
(cons "ª" "Ê")
(cons "£" "Ê")
(cons "Ò" "\U+1EC0")
(cons "Õ" "\U+1EBE")
(cons "Ó" "\U+1EC2")
(cons "Ô" "\U+1EC4")
(cons "Ö" "\U+1EC6")
(cons "×" "Ì")
(cons "Ý" "Í")
(cons "Ø" "\U+1EC8")
(cons "Ü" "\U+0128")
(cons "Þ" "\U+1ECA")
(cons "ß" "Ò")
(cons "ã" "Ó")
(cons "á" "\U+1ECE")
(cons "â" "Õ")
(cons "ä" "\U+1ECC")
(cons "«" "Ô")
(cons "¤" "Ô")
(cons "å" "\U+1ED2")
(cons "è" "\U+1ED0")
(cons "æ" "\U+1ED4")
(cons "ç" "\U+1ED6")
(cons "é" "\U+1ED8")
(cons "¬" "\U+01A0")
(cons "¥" "\U+01A0")
(cons "ê" "\U+1EDC")
(cons "í" "\U+1EDA")
(cons "ë" "\U+1EDE")
(cons "ì" "\U+1EE0")
(cons "î" "\U+1EE2")
(cons "ï" "Ù")
(cons "ó" "Ú")
(cons "ñ" "\U+1EE6")
(cons "ò" "\U+0168")
(cons "ô" "\U+1EE4")
(cons "­" "\U+01AF")
(cons "¦" "\U+01AF")
(cons "õ" "\U+1EEA")
(cons "ø" "\U+1EE8")
(cons "ö" "\U+1EEC")
(cons "÷" "\U+1EEE")
(cons "ù" "\U+1EF0")
(cons "ú" "\U+1EF2")
(cons "ý" "Ý")
(cons "û" "\U+1EF6")
(cons "ü" "\U+1EF8")
(cons "þ" "\U+1EF4")
(cons "a" "A")
(cons "b" "B")
(cons "c" "C")
(cons "d" "D")
(cons "e" "E")
(cons "f" "F")
(cons "g" "G")
(cons "h" "H")
(cons "i" "I")
(cons "j" "J")
(cons "k" "K")
(cons "l" "L")
(cons "m" "M")
(cons "n" "N")
(cons "o" "O")
(cons "p" "P")
(cons "q" "Q")
(cons "r" "R")
(cons "s" "S")
(cons "t" "T")
(cons "u" "U")
(cons "v" "V")
(cons "w" "W")
(cons "x" "X")
(cons "y" "Y")
(cons "z" "Z")

   )
 ) 
 (setq
   daichuoi (strlen stsua)
   index    1
   stdich   ""
 )
 (repeat daichuoi
   (setq
     chuht  (substr stsua index 1)
     index  (1+ index)
     chusua
     (cond
       ((assoc chuht tapsua) (cdr (assoc chuht tapsua)))
       (t chuht)
     )
     stdich (strcat stdich chusua)
   )
 )
 stdich
)

 (defun doone(ent / new old tt)
   (setq
     tt (entget ent)
     old (assoc 1 tt)
     new (cons 1 (chuyenfontstr (cdr old)))      
   )
   (if (/= new old)
     (progn
(setq tt (subst new old tt))
(entmod tt)
(entupd ent)
     )
   )
 )

 (setq	taptext	(ssget '((0 . "TEXT"))))
 (sudung doone taptext)

)
(defun sudung (ham ss / sodt index entdt soapp)
 (setq	sodt  (cond
	(ss (sslength ss))
	(t 0)
      )
soapp 0
index 0
 )
 (repeat sodt
   (setq entdt	(ssname ss index)
  index	(1+ index)
   )
   (if	(ham entdt)
     (setq soapp (1+ soapp))
   )
 )
 soapp
)

 

em đã load máy báo thành công nhưng khi đánh lệnh máy không hiểu lệnh t2u là gì? em cho thêm câu lệnh

(defun c:fff () (command "line"))

vào đầu thì máy vẫn sử dụng được lệnh fff chứng tỏ lisp đã load thành công. anh xem lai ho em


<<

Filename: 59919_t2u.lsp
Tác giả: NguyenNgocSon
Bài viết gốc: 114853
Tên lệnh: tt
Giúp tạo List copy nội dung text (khi nhấp chuột vào text1, text2 thì text1 chuyển thành text 2)!
Bạn thử lại cái này nhé. hì

(defun c:tt(/ ltt i text2 el el2 text str str2 n)
(setq ltt '()
i 0
n 0
text2 nil)
(while (and (setq textthay (car(entsel"\nChon text...
>>
Bạn thử lại cái này nhé. hì

(defun c:tt(/ ltt i text2 el el2 text str str2 n)
(setq ltt '()
i 0
n 0
text2 nil)
(while (and (setq textthay (car(entsel"\nChon text lay noi dung:"))) (/= textthay ""))
(setq el (entget textthay)
str (cdr (assoc 1 el)))
(setq ltt (append ltt (list str)))
(princ str)
(setq n (1+ n))
)
(reverse ltt)
(princ ltt)
(princ (strcat "\nSo doi tuong nguon la: " (rtos n 2 0) " "))
(while (and (= text2 nil) (> n i))
(setq text2 (car(entsel"\nChon text thay:"))
stt (nth i ltt);lay stt
);setq
( moddxf 1 stt text2)
(setq text2 nil)
(setq i (1+ i))
(princ (strcat "\nBan da chon: "(rtos i 2 0) "/"(rtos n 2 0)" "))
)
(while (= n i)
(alert "\n       Het nguon ")
(setq n nil
)
)
(princ)
)
(defun moddxf (dxf chdxf ss) (entmod (subst (cons dxf chdxf) (assoc dxf (entget ss)) (entget ss))))

 

Làm ngược là vì mình thấy viết sẽ phức tạp hơn bạn ạ, nên đành phải như thế này, bạn thông cảm nhé!!

p/s: mình vừa thêm mấy cái thông báo theo ý của bạn.

Cái của bạn khá hay nhưng nếu xử lý theo cách chọn chuỗi là ok ???

Thân !


<<

Filename: 114853_tt.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 422282
Tên lệnh: chon
Lisp chọn tất cả các đối tượng thuộc 1 layer !

Thì vầy:


(defun c:chon()

 (cadr (sssetfirst nil (ssget "X" (list (assoc  8 (entget (car (entsel "\nChon doi tuong mau: "))))))))


Filename: 422282_chon.lsp

Trang 227/304

227