Đây là Lisp của anh Sơn em sửa lại (setq chuoi (100/strcat (rtos i 2 tphan)"%")):...

>>

Đây là Lisp của anh Sơn em sửa lại (setq chuoi (100/strcat (rtos i 2 tphan)"%")):

(defun c:TLT ()
  (setq os (getvar "osmode"))
   (setq p (getpoint "\nChon diem dau: " ))
   (setq p1 (getpoint "\nChon diem cuoi: " p))
   (cond ((null tphan) (setq tphan 2)))
   (setq dau1 (car p))
   (setq cuoi1 (cadr p))
   (setq dau2 (car p1))
   (setq cuoi2 (cadr p1))
   (setq lx (abs (- dau1 dau2)))
   (setq ly (abs (- cuoi1 cuoi2)))
   (setq i (/ lx ly))
  (setq caochu (getreal "\nnhap cao chu: "))
  (setvar "osmode" 0)
   (command "layer" "S" "0" "")
   (setq pt1 (polar p (angle p p1) (/ (distance p p1) 2)))
          (setq dau1 (+ 5 (car pt1)))
          (setq cuoi1 (cadr pt1))
          (setq goc (/ (* (angle p p1) 180) pi))
  (setq pt2 (polar pt1 (+ (angle p p1) (/ pi 2)) caochu))
          (setq chuoi (100/strcat  (rtos i 2 tphan)"%"))
          (command "text" "J" "M" pt2 caochu goc chuoi )
(setvar "osmode" os)         
)

 

Còn đây là file lisp gốc của anh ấy:

(defun c:TLT ()
  (setq os (getvar "osmode"))
   (setq p (getpoint "\nChon diem dau: " ))
   (setq p1 (getpoint "\nChon diem cuoi: " p))
   (cond ((null tphan) (setq tphan 2)))
   (setq dau1 (car p))
   (setq cuoi1 (cadr p))
   (setq dau2 (car p1))
   (setq cuoi2 (cadr p1))
   (setq lx (abs (- dau1 dau2)))
   (setq ly (abs (- cuoi1 cuoi2)))
   (setq i (/ lx ly))
  (setq caochu (getreal "\nnhap cao chu: "))
  (setvar "osmode" 0)
   (command "layer" "S" "0" "")
   (setq pt1 (polar p (angle p p1) (/ (distance p p1) 2)))
          (setq dau1 (+ 5 (car pt1)))
          (setq cuoi1 (cadr pt1))
          (setq goc (/ (* (angle p p1) 180) pi))
  (setq pt2 (polar pt1 (+ (angle p p1) (/ pi 2)) caochu))
          (setq chuoi "1/"(strcat  (rtos i 2 tphan)))
          (command "text" "J" "M" pt2 caochu goc chuoi )
(setvar "osmode" os)         
)

Anh sửa giúp em và chèn giúp em đoạn Code để sau khi thực hiện lệnh nó tự động bật Osnaps trở lại

Đây là đoạn Code bật Osnap:

 

(defun c:bd ()
 (setvar "osmode" 2743)

 (princ)
 )

Cả 2 lisp trên đều sai cú pháp, có thể sửa lại như sau:

1. Sửa dòng (setq chuoi...

thành (setq chuoi (strcat (rtos (* i 100) 2 2) "%" ))

2. Chế độ osnap của 2 file đã đặt đúng (tức là sau khi thực hiện lệnh xong nó trả về giá trị cũ)

<<

Của bạn đây. lisp sẽ tính diện tích thực theo tỷ lệ bản vẽ bạn nhập vào. đầu tiên bạn phải chọn vị trí đặt bảng thống kê diện...

>>

Của bạn đây. lisp sẽ tính diện tích thực theo tỷ lệ bản vẽ bạn nhập vào. đầu tiên bạn phải chọn vị trí đặt bảng thống kê diện tích trên bản vẽ rồi mới pick chọn các miền cần đo diện tích. pick tới đâu diện tích sẽ được thống kê vào bảng đến đó. Mình viết thêm cho bạn một ô tính tổng diện tích các miền đã đo (yêu cầu của bạn không thấy nêu vấn đề này), tuy nhiên bạn phải Enter để kết thúc lệnh (không nhấn Esc nhé) thì lisp mới vẽ được ô cuối cùng này.

(defun c:r()
 (setvar "cmdecho" 0)
 (setq lacol (getvar "CEColor"))
 (setq ladin (getvar "dimzin"))
 (setq laos (getvar "osmode"))  
 (if (not tl) (setq tl 1))
 (if (not h) (setq h 1))
 (setq tl1 (getreal (strcat "\nty le ban ve < 1/" (rtos tl 2 0) " >: 1/"))
caot1 (getreal (strcat "\nCao text < " (rtos h 2 0) " >: ")))
 (if tl1 (setq tl tl1))
 (if caot1 (setq h caot1))

 (setq	 k 0 
tdt 0)
 (setq ss (ssadd))

(setvar "dimzin" 0)
(setvar "OSMODE" 0)
(setq PT (getpoint "\nChon diem xuat bang thong ke dien tich (mep trai):"))
(setq 	P1 (list (+ (car PT)(* 6 h)) (cadr PT))
P2 (list (+ (car PT)(* 22 h)) (cadr PT))
P3 (list (car PT) (- (cadr PT)(* 3 h)))
P4 (list (car P1) (cadr P3))
P5 (list (car P2) (cadr P3))
P6 (list (+ (car PT)(* 11 h)) (+ (cadr PT)(* 2 h)))
P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
);setq
(command 	"pline" PT P2 P5 P3 "C"
	"pline" P1 P4 ""
	"text" "m" P6 (* 1.2 h) 0 "%%UB¶ng thèng kª diÖn tÝch"
	"text" "m" P7 h 0 "STT"
	"text" "m" P8 h 0 "DiÖn tÝch (m2)"
);command

(setq pt1 (getpoint "\n Chon mien tinh dien tich : "))
 (while (/= pt1 nil)
(setq k (+ 1 k))
(command "TEXT" "m" pt1 (* 3 h) 0 (rtos k 2 0))
(setq 	PT (list (car P3) (cadr P3))
P1 (list (+ (car PT)(* 6 h)) (cadr PT))
P2 (list (+ (car PT)(* 22 h)) (cadr PT))
P3 (list (car PT) (- (cadr PT)(* 3 h)))
P4 (list (car P1) (cadr P3))
P5 (list (car P2) (cadr P3))
P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
P9 (list (car PT) (- (cadr P3)(* 3 h)))
P10 (list (car P1) (cadr P9))
P11 (list (car P2) (cadr P9))
P12 (list (car P7) (- (cadr P3)(* 1.5 h)))
P13 (list (car P8) (cadr P12))
);setq
(command "CECOLOR" 4 "-boundary" pt1 "" )
(setvar "CECOLOR" lacol)
(setq et (entlast))
(ssadd et ss)
(command "area" "e" "last")				
(setq et (entlast))
(ssadd et ss)
(setq dtcon (* (getvar "AREA") tl tl))
(setq tdt (+ dtcon tdt))
(command "erase" ss "")

(command "pline" PT P2 P5 P3 "C"
	"pline" P1 P4 ""
	"text" "m" P7 h 0 (rtos k 2 0)
	"text" "m" P8 h 0 (rtos dtcon 2 2))

(setq pt1 (getpoint "\n chon mien tinh dien tich tiep theo hoac enter de ket thuc lenh..."))
);while
(setq ss nil)
(setvar "DIMZIN" ladin)
(command 	"pline" P3 P9 P11 P5 "C"
	"pline" P10 P4 ""
	"text" "m" P12 h 0 "Tæng"
	"text" "m" P13 h 0 (rtos tdt 2 2)
);command
(setvar "OSMODE" laos)
(setvar "cmdecho" 1)
)

Em thấy lisp mày của bác rất hay rùi nhưng nó vẫn còn hai nhược điểm lớn khiến cho tác dung của nó bị giảm rất nhiều

- Nó vô hiệu vơi các đường cong như spl, arc, elip...

-khi đường bao thay đổi kết quả không tự thay đổi theo.

Nếu bác khắc phục được 2 điểm này thì lisp này thật tuyệt, hic em hay phải tính diện tích lắm mà thấy các lisp hiện tại chưa giả quyết được triệt để vấn đề.mong các cao thủ có ý kiến nhé :undecided:

<<

@huunhan : bạn thử cái này 

>>

@huunhan : bạn thử cái này http://www.cadviet.com/forum/topic/99171-xuat-cad-sang-excel/

@tien:  cứ để file excel mở song song với file cad, chừng nào không nhập nữa thì hãy save và tắt excel.

 

(defun c:tta (/ ss sst ssc ssd pl oo txt i lst area *error*)
  (vl-load-com)
  (defun inside(pt l)
    (defun tgoc(a b c) (abs (- pi (abs (- (angle b c) (angle a b))))))
    (equal 6.28319 (apply '+ (mapcar '(lambda(x y) (tgoc x pt y)) l (append (cdr l) (list (car l))))) 0.001)
  )
 
  (if (not xlApp)    
    (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")
row 0 col 1
         xtmp (vla-put-visible xlApp :vlax-true)
    )
  )
 
  (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X" '((0 . "TEXT"))))))
sst (vl-remove-if-not '(lambda (x) (distof (vla-get-TextString (vlax-ename->vla-object x)))) ss)
ssc (vl-remove-if '(lambda (x) (member x sst)) ss)
sst (mapcar '(lambda (x) (list (vlax-get (vlax-ename->vla-object x) 'TextAlignmentPoint)
 (vla-get-TextString (vlax-ename->vla-object x)))) sst) 
  )
  (prompt "\nChon khung pline:")
  (while (setq pl (ssget ":E:S" '((0 . "LWPOLYLINE"))))
    (setq pl (ssname pl 0)) (redraw pl 3)    
    (setq ssd (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget pl)))
 oo (vl-remove-if-not '(lambda (x) (inside (vlax-get (vlax-ename->vla-object x) 'TextAlignmentPoint) ssd)) ssc))
    (if oo
      (progn 
(setq oo (car oo)
     ssc (vl-remove oo ssc)
     lst (list (vla-get-TextString (vlax-ename->vla-object oo))))
        (foreach pt ssd
          (setq txt (car (vl-sort sst '(lambda (x y) (< (distance (car x) pt) (distance (car y) pt)))))
       lst (append lst (list (last txt))) 
          )
        )
        (setq area (rtos (* 0.000001 (vla-get-Area (vlax-ename->vla-object pl))) 2 2)
     i -1 row (1+ row))
        (mapcar '(lambda (x) (vlax-put-property xlCells "Item" row  (+ col (setq i (1+ i))) x)) lst)
        (vlax-put-property xlCells "Item" row 9 area)
       )
    )
    (prompt "\nChon khung pline:")
  )  
  (mapcar '(lambda (x) (redraw x 4)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X")))))
  (redraw)
  (princ)
)

@huaductiep: để lúc nào rảnh tôi sửa theo yêu cầu cuả bạn, lúc này hơi bị "ngán" cái đề tài này.

 Cám ơn Ban Tot nhiều

<<

Thank bác.

Tuy nhiên vẫn chưa đúng ý e lắm :)

+ Chỗ output bác có thể sửa giúp e thành định dạng mtext như yêu cầu ko? hiện tại bác đang để định dạng là text.

+ Một cái nữa là layer của output bác có thể lấy như layer của đối tượng đầu tiên ko? (layer của mtext "2").

>>

Thank bác.

Tuy nhiên vẫn chưa đúng ý e lắm :)

+ Chỗ output bác có thể sửa giúp e thành định dạng mtext như yêu cầu ko? hiện tại bác đang để định dạng là text.

+ Một cái nữa là layer của output bác có thể lấy như layer của đối tượng đầu tiên ko? (layer của mtext "2").

 

Test thử tí. ^_^

(defun c:test  ()
  (if (not (setq ss (ssget '((0 . "*TEXT")))))
    (princ "\nBan da khong chon TEXT.")
    (progn
      (setq n 0)
      (setq sum 0)
      (repeat (sslength ss)
        (setq value (cdr (assoc 1 (entget (ssname ss n)))))
        (setq value (ATOI value))
        (setq sum (+ sum value))
        (setq n (1+ n))
        ) ;progn
      (setq pt (getpoint "\nChon diem chen text: "))
      (entmake
        (list
          (cons 0 "TEXT")
          (cons 10 pt)
          (cons 40 (cdr (assoc 40 (entget (ssname ss 0)))))
          (cons 7 (cdr (assoc 7 (entget (ssname ss 0)))))
          (cons 1 (rtos sum 2 2))
          (cons 50 0)
          )
        )
      )
    )
  (princ)
  )

 ;|«Visual LISP© Format Options»
;*** DO NOT add text below the comment! ***|;

Vào lúc 30/12/2018 tại 22:18, Gia phuc đã nói:

copy được hết các...

>>

Vào lúc 30/12/2018 tại 22:18, Gia phuc đã nói:

copy được hết các đối tượng bên trong nhé bạn. cảm ơn bạn nhiều

(defun C:cco ( / d lis lis1 b e)
(setq d (vlax-ename->vla-object (setq e (car (entsel)))))
(cond
((=(vla-get-ObjectName d) "AcDbPolyline")
(progn
(setq lis (vlax-get d 'Coordinates))
(while lis
(setq lis1 (cons (list (car lis) (cadr lis)) lis1))
(setq lis (cddr lis))
)))
((=(vla-get-ObjectName d) "AcDb3dPolyline")
(progn
(setq lis (vlax-get d 'Coordinates))
(while lis
(setq lis1 (cons (list (car lis) (cadr lis)) lis1))
(setq lis (cdddr lis))
)))
(t nil)
);cond
(setq b (sssetfirst nil (ssdel e (ssget "cp" lis1))))
)

không dùng được cho spline và đường tròn đâu nhé, muốn dùng phải chuyển sang pline

<<

34 phút trước, Gia phuc đã nói:

Đây bạn.

>>

34 phút trước, Gia phuc đã nói:

Đây bạn.

test.dwg

(defun C:cco ( / d lis lis1 lis2 e)
(setq d (vlax-ename->vla-object (car (entsel))))
(cond
((=(vla-get-ObjectName d) "AcDbPolyline")
(progn
(setq lis (vlax-get d 'Coordinates))
(while lis
(setq lis1 (cons (list (car lis) (cadr lis)) lis1))
(setq lis (cddr lis))
)))
((=(vla-get-ObjectName d) "AcDb3dPolyline")
(progn
(setq lis (vlax-get d 'Coordinates))
(while lis
(setq lis1 (cons (list (car lis) (cadr lis)) lis1))
(setq lis (cdddr lis))
)))
(t nil)
);cond
(command "copy" (ssget "cp" lis1) "" pause pause "")
(setq e (car (entsel)))
(command "OFFSET" 0.1 e pause "")
(setq d (vlax-ename->vla-object (entlast)))
(cond
((=(vla-get-ObjectName d) "AcDbPolyline")
(progn
(setq lis (vlax-get d 'Coordinates))
(while lis
(setq lis2 (cons (list (car lis) (cadr lis)) lis2))
(setq lis (cddr lis))
)))
((=(vla-get-ObjectName d) "AcDb3dPolyline")
(progn
(setq lis (vlax-get d 'Coordinates))
(while lis
(setq lis2 (cons (list (car lis) (cadr lis)) lis2))
(setq lis (cdddr lis))
)))
(t nil)
);cond
(command "zoom" "o" e "")
(command "trim" e "" "f")
(foreach tam lis2
(command tam))
(command (car lis2) "" "")
)

vậy phải thủ công chút. đánh lệnh> chọn đường pline> copy từ điểm 1 sang điểm 2> chọn lại đường pline vừa mới copy> chọn 1 điểm bất kỳ bên ngoài pline

<<

 

Bạn dùng cái này thử xem.

Chọn 1 khung pline rồi chọn cái tên khung (ô-..), chọn tới đâu xuất excel tới đó.

Phần diện...

>>

 

Bạn dùng cái này thử xem.

Chọn 1 khung pline rồi chọn cái tên khung (ô-..), chọn tới đâu xuất excel tới đó.

Phần diện tích k biết lấy đơn vị là gì.

 

(defun c:tta (/ ss ss1 y xlApp xlCells row col i iPt)
  (vl-load-com)      
  (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") row 0 col 1)
  (vla-put-visible xlApp :vlax-true)
 
  (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X" '((0 . "TEXT"))))))
sst (vl-remove-if-not '(lambda (x) (distof (vla-get-TextString (vlax-ename->vla-object x)))) ss)
sst (mapcar '(lambda (x) (list (vlax-get (vlax-ename->vla-object x) 'TextAlignmentPoint)
 (vla-get-TextString (vlax-ename->vla-object x)))) sst)
  )
  (prompt "\nChon khung pline:")
  (while (setq pl (ssget ":E:S" '((0 . "LWPOLYLINE"))))
    (mapcar '(lambda (x) (redraw x 4)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X")))))
    (setq pl (ssname pl 0)) (redraw pl 3)
    (setq oo (car (entsel "\nChon ten cua khung:")))  (redraw pl 4) (redraw oo 3)
    
    (setq  ssd (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget pl))) 
 lst (list (vla-get-TextString (vlax-ename->vla-object oo)))
    )
    (foreach pt ssd
      (setq txt (car (vl-sort sst '(lambda (x y) (< (distance (car x) pt) (distance (car y) pt)))))
   lst (append lst (list (last txt))) 
      )
    )
    (setq lst (append lst (list (vla-get-Area (vlax-ename->vla-object pl))))
 i -1 row (1+ row))
    (mapcar '(lambda (x) (vlax-put-property xlCells "Item" row  (+ col (setq i (1+ i))) x)) lst)
    (prompt "\nChon khung pline:")
  )
  (mapcar 'vlax-release-object (list xlApp xlCells))
  (mapcar '(lambda (x) (redraw x 4)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X")))))
  (redraw)
  (princ)
)

ban tot77 oi cái  lisp của bạn chỉ sử dụng được với text nằm ngang thôi còn với các text  khác 0 độ thì ko được bạn có thể sửa lại hộ mình được không cảm ơn bạn.

<<

Theo bài 1:

(defun c:tt  (/ modelSpace lay bv cd pt1 temp create-layer tiep_theo_qm kcach_dau Make-Line...
>>

Theo bài 1:

(defun c:tt  (/ modelSpace lay bv cd pt1 temp create-layer tiep_theo_qm kcach_dau Make-Line laythep)
 (defun kcach_dau  (mm-am len fac / del l-0)
  (if (eq mm-am t)
   (progn (setq l-0 (/ len 4)
                del (rem l-0 50))
          (if (> del 0)
           (setq l-0 (- l-0 del (/ -50 fac)))))
   (progn (setq l-0 (/ len 6)
                del (rem l-0 (/ 50 fac)))
          (if (> del 0)
           (setq l-0 (- l-0 del)))))
  l-0)
 (defun create-layer  (name color lineWeight)
  (entmakex (list '(0 . "LAYER")
                  (cons 100 "AcDbSymbolTableRecord")
                  (cons 100 "AcDbLayerTableRecord")
                  (cons 2 name)
                  (cons 70 0)
                  (cons 62 color)
                  (cons 6 "Continuous")
                  (cons 370 (fix (* 100 lineWeight))))))
 (defun Make-Line  (p1 p2 lay)
  (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2) (cons 8 lay))))
 ;;-------------------
 (defun tiep_theo_qm  (/ cdim pt2 kc pd1 pd2 pd3 pa1 pa2 pa3 ptt)
  (setq cdim (* (getvar "DIMTXT") (getvar "DIMSCALE")))
  (setq pt2 (getpoint "\nNhap toa do diem cuoi duoi dam:" pt1))
  (setq kc (distance pt1 pt2))
  ;; Momen duong
  (setq pd1 (polar pt1 (* pi 0) (kcach_dau nil kc 1))
        pd2 (polar pt2 (* pi 1) (kcach_dau nil kc 1))
        pd3 (polar pt1 (* pi 1.5) (* cdim 4)))
  (setvar "CLAYER" "DIM")
  (mapcar (function (lambda (x y z) (vla-adddimaligned msp x y z)))
          (mapcar 'vlax-3d-point (list pt1 pd1 pd2))
          (mapcar 'vlax-3d-point (list pd1 pd2 pt2))
          (mapcar 'vlax-3d-point (list pd3 pd3 pd3)))
  (Make-Line (setq ptt (polar pd1 (* pi 0.5) bv)) (polar ptt (* pi 0.25) bv) laythep)
  (Make-Line (setq ptt (polar pd2 (* pi 0.5) bv)) (polar ptt (* pi 0.75) bv) laythep)
  ;; Momen am
  (setq pt1 (polar pt1 (* pi 0.5) cd)
        pt2 (polar pt2 (* pi 0.5) cd)
        pa1 (polar pt1 (* pi 0) (kcach_dau t kc 1))
        pa2 (polar pt2 (* pi 1) (kcach_dau t kc 1))
        pa3 (polar pt1 (* pi 0.5) (* cdim 4)))
  (mapcar (function (lambda (x y z) (vla-adddimaligned msp x y z)))
          (mapcar 'vlax-3d-point (list pt1 pa1 pa2))
          (mapcar 'vlax-3d-point (list pa1 pa2 pt2))
          (mapcar 'vlax-3d-point (list pa3 pa3 pa3)))
  (Make-Line (setq ptt (polar pa1 (* pi 1.5) bv)) (polar ptt (* pi 1.25) bv) laythep)
  (Make-Line (setq ptt (polar pa2 (* pi 1.5) bv)) (polar ptt (* pi 1.75) bv) laythep)
  (setvar "CLAYER" lay))
 ;; MAIN
 (vl-load-com)
 (setq msp     (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
       lay     (getvar "clayer")
       laythep "THEPDOC")
 (create-layer laythep 1 0.4)
 (create-layer "DIM" 8 -3)
 (or (and cd (or (= (type cd) 'int) (= (type cd) 'real))) (setq cd 400))
 (or (and bv (or (= (type bv) 'int) (= (type bv) 'real))) (setq bv 20))
 (setq temp "T")
 (while (= temp "T")
  (initget 0 "Cao Bao")
  (setq pt1 (getpoint
             (strcat "\nCaodam <" (rtos cd 2 0) ">/Baove <" (rtos bv 2 0) ">. Nhap toa do diem dau duoi dam: ")))
  (cond ((= pt1 "Cao")
         (setq cd (cond ((getdist (strcat "\nChieu cao dam <" (rtos cd 2 0) ">:")))
                        (cd))))
        ((= pt1 "Bao")
         (setq bv (cond ((getdist (strcat "\nChieu day lop betong bao ve <" (rtos bv 2 0) ">:")))
                        (bv))))
        ((= pt1 nil) (setq temp nil))
        (t (tiep_theo_qm))))
 (princ))

 

 

 

Cái đó là có dim trước, rồi chia dim khác với topic này.

like. Mai em test lisp bác.:). Code bác viết rành mạch, đẹp thế. Nhiều hàm em chưa bik bao giờ :p

<<

 

Update theo yêu cầu.

- chiều cao text lấy theo biến hệ thống TextSize

- số chữ số thập phân lấy theo...

>>

 

Update theo yêu cầu.

- chiều cao text lấy theo biến hệ thống TextSize

- số chữ số thập phân lấy theo biến hệ thống Luprec (giống như trong Cad)

(defun c:entPro2Ex (/ col i obj prolst pros row sosole spc ss x xlapp xlcells)
  ;; By : Gia_Bach 2013 ;;
  (vl-load-com)
  (defun getProEnt(obj sole / area bl cen heigh leng maxp minp obj tr width)
    (setq leng (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj))
	  area (vlax-curve-getArea obj))
    (vla-getBoundingBox obj 'minp 'maxp )
    (setq TR (vlax-safearray->list maxp) BL (vlax-safearray->list minp)
	  width (- (car TR) (car BL)) heigh(- (cadr TR) (cadr BL))
	  cen (mapcar '(lambda (a b) (/ (+ a b) 2.0)) TR BL))
    (list cen (rtos width 2 sole) (rtos heigh 2 sole) (rtos leng 2 sole) (rtos area 2 sole))  )
  ; main
  (if (setq ss (ssget '((0 . "ARC,CIRCLE,ELLIPSE,*POLYLINE,SPLINE"))))
    (progn
      (setq i -1 sosole (getvar "luprec"))
      (repeat (sslength ss)
	(setq obj (vlax-Ename->Vla-Object(ssname ss (setq i (1+ i))))
	      pros (getProEnt obj sosole)
	      proLst (append proLst (list pros))))
      (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 col 2 spc (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-Acad-Object))))
      (foreach pt (list "Length (mm)" "Witdth (mm)" "Perimeter" "Area")
	(vlax-put-property xlCells 'Item 1 col pt)
	(setq col (1+ col)))
      (setq col 1 row 2 txtheight (getvar "TextSize"))
      (foreach pt proLst
	(vla-AddText spc (- row 1) (vlax-3D-point (car pt)) txtheight)
	(vlax-put-property xlCells 'Item row col (- row 1))
	(setq col (1+ col))
	(foreach str (cdr pt)
	  (vlax-put-property xlCells 'Item row col str)
	  (setq col (1+ col)))
	(setq row (1+ row) col 1) )
      (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)) ))
  (princ))

Xin nhờ anh gia_bach giúp cho việc xuất nội dung từ excel sang cad them nội dung diện tích nằm dưới số thứ tụ.

http://www.cadviet.com/upfiles/3/114381_drawing1_1.dwg

Cám ơn

<<

Trước hết nhoc xin chân thành đa tạ pac Bình đã dìu dắt hướng dẫn thằng em nì ^^ tới tới .....:D, sau 1 đêm mày mò , hút hết 2 gói...

>>

Trước hết nhoc xin chân thành đa tạ pac Bình đã dìu dắt hướng dẫn thằng em nì ^^ tới tới .....:D, sau 1 đêm mày mò , hút hết 2 gói thuốc >> ngu người, cuối cùng nhoc cũng đã hoàn tất đc những gì pac Bình chỉ dạy. Cái nỳ để pac chắc mất 2 phút là xong, còn nhoc >> ko đếm nỗi >"<. Không dài dòng vô thẳng, pac Bình và bạn gaibo vô xem thử hàng nhé, trước khi xem nhoc xin đc show quá trình nhoc lên thiên đường, ah thật ra lên chưa tới đâu, đụng nóc mây thui, mà vậy là zui rùi ^^ Tấm đầu tiên, cái bầu này sắp sinh rùi bự lắm ^^ Tấm thứ 2, rừng già amazon nhé :) Tấm cuối cùng, mẹ tròn con vuông, cây cối đã đc tỉa gọn gàng :D :D :D Sau cùng là file lsp tạm gọi là chấp nhận đc ^^

 (defun C:tff (/ tencoc check-nova lytrinh accept nova baoloi node table style DCL_CDN DCL_ID FILE_DCL HTXT TEMP_CDN TSN B1 B2 BB1 BB2 BBL BBR BK BL BLI BR BRI BT1 BT2 BTL BTR BTT BTX BTY EB1 EB2 EBK PT1 PTE PTITLE PTL PTX PTY TD0 X Y SSNODE STTBTD TB ANG COL DEL DIX DIY EGPL EPL GR H K LST-TS N NAME EVK OV SSC VBL VBR VK VLI VRI VTL VTR WH) (command "style" "VnArial NarrowH" ".VnArial NarrowH" "" "" "" "" "") (command "layer" "m" "QKHS" "c" "6" "" "") (command "undo" "be") (setvar "cmdecho" 0) (command "undo" "begin") (vl-load-com) ;======================= Defun ========================== (defun rotate-text ( en ang / p1 p2 a e1) (setq p1 (acet-geom-textbox (setq e1 (entget en)) 0) p1 (acet-geom-midpoint (car p1) (caddr p1)) e1 (subst (cons 11 p1) (assoc 11 e1) e1) a (cdr (assoc 50 e1)) a (+ ang a) e1 (subst (cons 50 a) (assoc 50 e1) e1) e1 (subst (cons 72 1) (assoc 72 e1) e1) e1 (subst (cons 73 2) (assoc 73 e1) e1) );setq (entmod e1) (entupd EN)) (defun DXF (code en) (cdr (assoc code (entget en)))) (defun angle-d2r (ANGD) (if ANGD (/ (* pi ANGD) 180) nil)) (defun angle-r2d (ANGR) (if ANGR (/ (* 180 ANGR) pi) nil)) (defun grnode (point radius color ang node fomp hightlight / ANGi PT0 PT1 PTg COL) (if fomp (setq ANGi 0) (setq ANGi (* 0.5 (angle-d2r ang)))) (if (= color 0) (setq COL 10) (setq COL color)) (setq PT0 (polar point ANGi radius) PTg PT0) (if node (grdraw point PT0 color hightlight)) (while (<= ANGi (* 2 Pi)) (setq ANGi (+ ANGi (angle-d2r ang)) PT1 (polar point ANGi radius)) (if (= color 0) (setq COL (1+ COL))) (if node (grdraw point PT0 COL hightlight) (grdraw PT0 PT1 COL hightlight)) (setq PT0 PT1) );while (if (not node) (grdraw PT0 PTg COL hightlight)) );end grnode (defun tencoc (EN) (if (check-nova EN) (cdr (nth 7 (car(cdr (assoc -3 (entget EN '("*"))))))) (prompt "Doi tuong chon khong co du lieu tuyen"))) (defun check-nova (EN) (if (= (car(car(cdr (assoc -3 (entget EN '("*")))))) "TDNW") T nil)) (defun lytrinh (EN) (if (check-nova EN) (rtos (cdr (nth 5 (car(cdr (assoc -3 (entget EN '("*"))))))) 2 2) (prompt "Doi tuong chon khong co du lieu tuyen"))) (defun accept () (setq TD-value (list (get_tile "node") (get_tile "table") (nth (fix (atof (get_tile "style"))) Lst-TS) (get_tile "height") (get_tile "name") (get_tile "start") 0)) (done_dialog)) (defun nova () (setq TD-value (list (get_tile "node") (get_tile "table") (nth (fix (atof (get_tile "style"))) Lst-TS) (get_tile "height") (get_tile "name") (get_tile "start") 1)) (done_dialog)) (defun node () (if (and (= (get_tile "table") "0") (= (get_tile "node") "0")) (set_tile "table" "1"))) (defun table () (if (and (= (get_tile "table") "0") (= (get_tile "node") "0")) (set_tile "node" "1"))) (defun style (/ htxt htxt0) (setq htxt0 (get_tile "height")) (if (/= (setq htxt (cdr (assoc 40 (tblsearch "style" (nth (fix (atof (get_tile "style"))) Lst-TS))))) 0) (progn (set_tile "height" (rtos htxt 2 3)) (mode_tile "height" 1)) (progn (mode_tile "height" 0) (set_tile "height" htxt0)))) (defun baoloi (val key valkey) (if (= "." (substr val 1 1)) (setq val (strcat "0" val))) (if (not (or (= val "") (and (or (= (type (read val)) 'REAL) (= (type (read val)) 'INT)) (> (atof val) 0)))) (progn (if (or (= key "height") (= key "start")) (repeat 2 (set_tile "err" (strcat " ")) (ACET-SYS-SLEEP 70) (set_tile "err" (strcat "Gia tri " valkey " phai la so thuc duong")) (ACET-SYS-SLEEP 120)) (repeat 2 (set_tile "err" (strcat " ")) (ACET-SYS-SLEEP 70) (set_tile "err" (strcat "Gia tri " valkey " phai la so nguyen duong")) (ACET-SYS-SLEEP 120))) (mode_tile key 2) (mode_tile key 3) );progn (set_tile "err" (strcat "Statistical coordinates data record - \Toa do ")) );if );end error (if (not TD-value) (setq TD-value (list "1" "1" (getvar "textstyle") "2.00" "N" "1" 0))) (setq DCL_CDn (list "Coordinate : dialog { value = \"http://taybac.1talk.net - \<Thong ke Toa do>\"; key = \"err\";" " : column { children_alignment = top;" " : boxed_row { " " : column {" " : toggle { key = \"node\"; label = \"Chen diem\"; height = 1.4;}" " : toggle { key = \"table\"; label = \"Chen bang\"; height = 2.5;}}" " : column {" " : popup_list { key = \"style\"; label = \"Text Style\"; edit_width = 10.1;}" " : edit_box { key = \"height\"; label = \"Height Text\"; height = 1.1; edit_width = 11;}" " : tile { label = \"-\"; alignment = centered;}} " " : column {" " : edit_box { key = \"name\"; label = \" Ten diem\"; height = 1.1; edit_width = 4;}" " : edit_box { key = \"start\"; label = \" So bat dau\"; height = 1.1; edit_width = 4;}" " : tile { label = \"-\"; alignment = centered;}} " " } " " : button { key = \"nova\"; label = \"Export Station coodinates from Road-Plan\";}" " : row {" " : button { key = \"cancel\"; label = \" Thoat \"; is_cancel = true;}" " : button { key = \"accept\"; label = \" Bat dau \"; is_default = true;}}" " }" " }" "helpTLuy : dialog { label = \"Help and Copyright\U+00A9 Information\";" " : column {" " : row { : list_box { key = \"helpList\"; edit_width = 95; width = 98; height = 25;}}" " : row { : button { key = \"okayHelp\"; label = \"Okay\"; is_default = false; is_cancel = true;}}" " }" " }" ) TEMP_CDn (vl-filename-mktemp "CDn.DCL") FILE_DCL (open TEMP_CDn "W")) (foreach LL DCL_CDn (write-line LL FILE_DCL)) (close FILE_DCL) (setq DCL_ID (load_dialog TEMP_CDn)) (new_dialog "Coordinate" DCL_ID) (set_tile "node" (nth 0 TD-value)) (set_tile "table" (nth 1 TD-value)) (set_tile "height" (nth 3 TD-value)) (if (/= (setq htxt (cdr (assoc 40 (tblsearch "style" (nth 2 TD-value))))) 0) (progn (set_tile "height" (rtos htxt 2 2)) (mode_tile "height" 1))) (set_tile "name" (nth 4 TD-value)) (set_tile "start" (nth 5 TD-value)) (start_list "style") (setq Lst-TS (list (nth 2 TD-value) (cdr (assoc 2 (tblnext "Style" T))))) (while (setq TSN (tblnext "Style")) (if (and (/= (cdr (assoc 2 TSN)) (nth 2 TD-value)) (/= (cdr (assoc 2 TSN)) "")) (setq Lst-TS (append Lst-TS (list (cdr (assoc 2 TSN)))))) );while (mapcar 'add_list Lst-TS) (end_list) (action_tile "cancel" "(exit)") (action_tile "accept" "(accept)") (action_tile "nova" "(nova)") (action_tile "node" "(node)") (action_tile "table" "(table)") (action_tile "style" "(style)") (action_tile "height" "(baoloi (get_tile \"height\") \"height\" \"''Cao chu''\")") (action_tile "start" "(baoloi (get_tile \"start\") \"start\" \"''STT''\")") (start_dialog) (unload_dialog DCL_ID) (vl-file-delete TEMP_CDn) (setq H (atof (nth 3 TD-value))) (if (wcmatch (cdr (assoc 3 (tblsearch "style" (nth 2 TD-value)))) "*AVAN*,*ARIAL*,*BLACK*") (setq Wh (* 1.5 H)) (setq Wh 0)) (if (= (nth 6 TD-value) 0) (progn (if (/= (nth 3 TD-value) "") (setq N (nth 3 TD-value))) (command "UCS" "W") (setvar "dimzin" 0) (command "undo" "begin") (if (= (nth 5 TD-value) "") (setq k 0) (setq k (- (atof (nth 5 TD-value)) 1))) (if (= (nth 1 TD-value) "1") ; BEGIN TABLE (progn (prompt "Chon diem dat bang toa do...") (while (if (= (car (setq GR (grread 't 15 0))) 5) (progn (if (or (not COL) (= 249 COL)) (setq COL 1) (setq COL (1+ COL))) (redraw) (setq BTR (cadr GR) BTL (polar BTR 0 (* H -26)) BT1 (polar BTR 0 (* H -21)) BT2 (polar BTR 0 (* H -10.5)) BBR (polar BTR (* 0.5 pi) (* H -11)) BBL (polar BTL (* 0.5 pi) (* H -11)) BB1 (polar BT1 (* 0.5 pi) (* H -11)) BB2 (polar BT2 (* 0.5 pi) (* H -11)) BR (polar BTR (* 0.5 pi) (* H -2.4)) BL (polar BTL (* 0.5 pi) (* H -2.4)) OV (* H 0.3) VTR (polar BTR (* 0.25 pi) OV) VTL (polar BTL (* 0.75 pi) OV) VBR (polar BR (* 1.75 pi) OV) VBL (polar BL (* 1.25 pi) OV)) (grdraw BTL BTR COL 1) (grdraw BTL BBL COL 1) (grdraw BTR BBR COL 1) (grdraw BT1 BB1 COL 1) (grdraw BT2 BB2 COL 1) (grdraw BR BL COL 1) (repeat 3 (setq BR (polar BR (* 0.5 pi) (* H -2.0)) BL (polar BL (* 0.5 pi) (* H -2.0)) BB1 (polar BT1 (* 0.5 pi) (* H -2.4)) BB2 (polar BT2 (* 0.5 pi) (* H -2.4))) (grdraw BR BL COL 1)) T) (progn (setq PTitle (list (- (car BTR) (* 13 H)) (+ (cadr BTR) (* 1.8 H))) BTX (list (- (car BTR) (* 15.75 H)) (+ (cadr BTR) (* -1.2 H))) BTY (list (- (car BTR) (* 5.25 H)) (+ (cadr BTR) (* -1.2 H))) BTT (list (- (car BTR) (* 23.5 H)) (+ (cadr BTR) (* -1.2 H))) BR (polar BTR (* 0.5 pi) (* H -2.4)) BL (polar BTL (* 0.5 pi) (* H -2.4))) (setq VK (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(62 . 8) '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) (cons 10 VBR) (cons 10 VTR) (cons 10 VTL) (cons 10 VBL)))) (setq BK (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) (cons 10 BR) (cons 10 BTR) (cons 10 BTL) (cons 10 BL)))) (setq B1 (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2) (cons 10 BB1) (cons 10 BT1)))) (setq B2 (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2) (cons 10 BB2) (cons 10 BT2)))) (entmake (list '(0 . "TEXT") (cons 10 PTitle) (cons 11 PTitle) (cons 40 (* 1.2 H)) (cons 1 "%¶ng Täa ®é ®iÓm") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2))) (entmake (list '(0 . "TEXT") (cons 10 BTT) (cons 11 BTT) (cons 40 (* 1 H)) (cons 1 "§iÓm") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2))) (entmake (list '(0 . "TEXT") (cons 10 BTX) (cons 11 BTX) (cons 40 (* 1 H)) (cons 1 "X") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2))) (entmake (list '(0 . "TEXT") (cons 10 BTY) (cons 11 BTY) (cons 40 (* 1 H)) (cons 1 "Y") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2))) (setq BTX (polar BTX (* -0.5 pi) (* 2.2 H)) BTY (polar BTY (* -0.5 pi) (* 2.2 H)) BTT (polar BTT (* -0.5 pi) (* 2.2 H))) (prompt " OK Man!"))))));if END TABLE (while (progn (initget 128 "u") (setq TD0 (getpoint (strcat "\n Pick diem thu "(rtos (setq k (1+ k)) 2 0) " : "))) (if (= TD0 "u") (vl-cmdf "undo" "Back") TD0)) (if (/= TD0 "u") (progn (vl-cmdf "undo" "mark") (princ TD0) (setq X (rtos (car TD0) 2 3) Y (rtos (cadr TD0) 2 3)) (if (= (nth 1 TD-value) "1") (progn ;put into table (setq STTBTD (strcat (nth 4 TD-value) (rtos k 2 0))) (entmake (list '(0 . "TEXT") (cons 10 BTT) (cons 11 BTT) (cons 40 (* 1 H)) (cons 1 STTBTD) (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2))) (entmake (list '(0 . "TEXT") (cons 10 BTX) (cons 11 BTX) (cons 40 (* 1 H)) (cons 1 X) (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2))) (entmake (list '(0 . "TEXT") (cons 10 BTY) (cons 11 BTY) (cons 40 (* 1 H)) (cons 1 Y) (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2))) (setq BTX (polar BTX (* -0.5 pi) (* 2 H)) BTY (polar BTY (* -0.5 pi) (* 2 H)) BTT (polar BTT (* -0.5 pi) (* 2 H))) (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2) (cons 10 BR) (cons 10 BL))) (setq EB1 (entget B1) EB1 (subst (cons 10 (setq BB1 (polar BB1 (* -0.5 pi) (* 2 H)))) (assoc 10 EB1) EB1)) (entmod EB1) (entupd B1) (setq EB2 (entget B2) EB2 (subst (cons 10 (setq BB2 (polar BB2 (* -0.5 pi) (* 2 H)))) (assoc 10 EB2) EB2)) (entmod EB2) (entupd B2) (setq EBK (entget BK) BRi (polar BR (* -0.5 pi) (* 2 H)) BLi (polar BL (* -0.5 pi) (* 2 H)) EBK (reverse (subst (cons 10 BRi) (assoc 10 EBK) EBK)) EBK (reverse (subst (cons 10 BLi) (assoc 10 EBK) EBK)) BR Bri BL BLi) (entmod EBK) (entupd BK) (setq EVK (entget VK) VRi (polar VBR (* -0.5 pi) (* 2 H)) VLi (polar VBL (* -0.5 pi) (* 2 H)) EVK (reverse (subst (cons 10 VRi) (assoc 10 EVK) EVK)) EVK (reverse (subst (cons 10 VLi) (assoc 10 EVK) EVK)) VBR Vri VBL VLi) (entmod EVK) (entupd VK) );progn );if END put into table (if (= (nth 0 TD-value) "1") (progn (setq SSnode (ssadd)) (setq PTX (polar TD0 0 (* H 0.7)) PTY (polar PTX (* pi -0.5) (* H 1.35))) (entmake (list '(0 . "TEXT") (cons 10 PTX) (cons 11 PTX) (cons 40 H) (cons 1 (strcat "X:"X)) (cons 7 (nth 2 TD-value)) '(72 . 0) '(73 . 1))) (setq TB (textbox (entget(entlast))) DIX (distance (car TB) (cadr TB)) PTL (polar PTX 0 (+ DIX (* 0.12 H)))) (setq SSnode (ssadd (entlast) SSnode)) (entmake (list '(0 . "TEXT") (cons 10 PTY) (cons 40 H) (cons 1 (strcat "Y:"Y)) (cons 7 (nth 2 TD-value)) '(72 . 0))) (setq TB (textbox (entget(entlast)))) (if (< DIX (setq DIY (distance (car TB) (cadr TB)))) (setq PTL (polar PTX 0 (+ DIY (* 0.12 H))))) (setq SSnode (ssadd (entlast) SSnode)) (setq EPL (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 3) (cons 10 TD0) (cons 10 (polar TD0 0 (* 0.000000001 H))) (cons 10 PTL)))) (setq SSnode (ssadd EPL SSnode)) (if (/= (strcat (nth 4 TD-value) (nth 5 TD-value)) "") (progn (setq name (strcat (nth 4 TD-value) (rtos k 2 0))) (entmake (list '(0 . "TEXT") (cons 10 PTL) (cons 11 (list (+ (car PTL) 0.65) (cadr PTL))) (cons 40 H) (cons 1 name) (cons 7 (nth 2 TD-value)) '(72 . 0) '(73 . 2))) (setq etext (entlast)) (setq len (abs (- (caar (textbox (list (assoc 1 (entget etext)) (assoc 40 (entget etext)) (assoc 50 (entget etext))))) (caadr (textbox (list (assoc 1 (entget etext)) (assoc 40 (entget etext)) (assoc 50 (entget etext)))))))) (setq PTE (polar PTL 0 (/ len 1.7))) (setq SSnode (ssadd (entlast) SSnode)) (entmake (list '(0 . "ELLIPSE") '(100 . "AcDbEntity") '(100 . "AcDbEllipse") (cons 10 PTE) (cons 11 (list (/ len 1.7) 0 0)) (cons 40 0.75))) (setq SSnode (ssadd (entlast) SSnode)) (entmake (list '(0 . "ELLIPSE") '(100 . "AcDbEntity") '(100 . "AcDbEllipse") '(62 . 8) (cons 10 PTE) (cons 11 (list (/ len 1.8) 0 0)) (cons 40 0.75))) (setq SSnode (ssadd (entlast) SSnode)))) (ACET-SS-REDRAW SSnode 2) (if (not (setq PT1 (ACET-SS-DRAG-MOVE SSnode TD0 "" nil 0))) (Setq PT1 TD0) (setq del (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 3) (cons 10 TD0) (cons 10 PT1))))) (vl-cmdf "move" SSnode "" TD0 PT1) (ACET-SS-REDRAW SSnode 2) (if (not (setq ANG (ACET-SS-DRAG-ROTATE SSnode PT1 "" nil 0))) (if (< (* 0.5 pi) (angle PT1 (cadr (grread 't 15 0))) (* 1.5 pi)) (setq ANG pi) (setq ANG 0))) (vl-cmdf "erase" del "") (vl-cmdf "rotate" SSnode "" PT1 (rtos (angle-r2d ANG) 2 2)) (setq SSnode (acet-ss-to-list SSnode)) (if (< (* 0.5 pi) ANG (* 1.5 pi)) (foreach SSn SSnode (if (= (DXF 0 SSn) "TEXT") (rotate-text SSn pi)))) (setq EgPL (entget EPL) EgPL (subst (cons 10 TD0) (assoc 10 EgPL) EgPL)) (entmod EgPL) (entupd EPL) );progn (progn (if (or (not COL) (= 249 COL)) (setq COL 1) (setq COL (1+ COL))) (progn (grnode TD0 (/ (ACET-GEOM-PIXEL-UNIT) 0.09) COL 90 T nil 0) (grnode TD0 (/ (ACET-GEOM-PIXEL-UNIT) 0.2) COL 45 T nil 0))) )) (progn (setq k (- k 2) BTX (polar BTX (* 0.5 pi) (* 2 H)) BTY (polar BTY (* 0.5 pi) (* 2 H)) BTT (polar BTT (* 0.5 pi) (* 2 H)) BB1 (polar BB1 (* 0.5 pi) (* 2 H)) BB2 (polar BB2 (* 0.5 pi) (* 2 H)) BR (polar BR (* 0.5 pi) (* 2 H)) BL (polar BL (* 0.5 pi) (* 2 H)) VBR (polar VBR (* 0.5 pi) (* 2 H)) VBL (polar VBL (* 0.5 pi) (* 2 H)))) );if );while (prompt "Done\n \U+2022 Statistical coordinates data record - Copyright\U+00A9 2010 Thaistreetz") (setq TD-value (ACET-LIST-PUT-NTH (rtos k 2 0) TD-value 5))) ;=== Xuat bang toa do coc tu binh do tuyen (progn (if (setq SSC (acet-ss-to-list (ssget '((0 . "LINE") (8 . "ENTCOC"))))) (progn (setq BTR (cadr (grread 't 15 0)) BTL (polar BTR 0 (- (* H -26) Wh)) BT1 (polar BTR 0 (* H -21)) BT2 (polar BTR 0 (* H -10.5)) BB1 (polar BT1 (* 0.5 pi) (* H -2.4)) BB2 (polar BT2 (* 0.5 pi) (* H -2.4)) BR (polar BTR (* 0.5 pi) (* H -2.4)) BL (polar BTL (* 0.5 pi) (* H -2.4)) PTitle (list (- (car BTR) (+ (* 0.5 Wh) (* 13 H))) (+ (cadr BTR) (* 1.8 H))) BTX (list (- (car BTR) (* 15.75 H)) (+ (cadr BTR) (* -1.2 H))) BTY (list (- (car BTR) (* 5.25 H)) (+ (cadr BTR) (* -1.2 H))) BTT (list (- (car BTR) (+ (* 0.5 Wh) (* 23.5 H))) (+ (cadr BTR) (* -1.2 H))) OV (* H 0.3) VTR (polar BTR (* 0.25 pi) OV) VTL (polar BTL (* 0.75 pi) OV) VBR (polar BR (* 1.75 pi) OV) VBL (polar BL (* 1.25 pi) OV)) (setq SSnode (ssadd)) (setq VK (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(62 . 8) '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) (cons 10 VBR) (cons 10 VTR) (cons 10 VTL) (cons 10 VBL))) SSnode (ssadd (entlast) SSnode)) (setq BK (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) (cons 10 BR) (cons 10 BTR) (cons 10 BTL) (cons 10 BL))) SSnode (ssadd (entlast) SSnode)) (setq B1 (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2) (cons 10 BB1) (cons 10 BT1))) SSnode (ssadd (entlast) SSnode)) (setq B2 (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2) (cons 10 BB2) (cons 10 BT2))) SSnode (ssadd (entlast) SSnode)) (entmake (list '(0 . "TEXT") (cons 10 PTitle) (cons 11 PTitle) (cons 40 (* 1.2 H)) (cons 1 "%¶ng Täa ®é cäc") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2))) (setq SSnode (ssadd (entlast) SSnode)) (entmake (list '(0 . "TEXT") (cons 10 BTT) (cons 11 BTT) (cons 40 (* 1 H)) (cons 1 "Tªn cäc") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2))) (setq SSnode (ssadd (entlast) SSnode)) (entmake (list '(0 . "TEXT") (cons 10 BTX) (cons 11 BTX) (cons 40 (* 1 H)) (cons 1 "Täa §é X") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2))) (setq SSnode (ssadd (entlast) SSnode)) (entmake (list '(0 . "TEXT") (cons 10 BTY) (cons 11 BTY) (cons 40 (* 1 H)) (cons 1 "Täa §é Y") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2))) (setq SSnode (ssadd (entlast) SSnode)) (setq BTX (polar BTX (* -0.5 pi) (* 2.2 H)) BTY (polar BTY (* -0.5 pi) (* 2.2 H)) BTT (polar BTT (* -0.5 pi) (* 2.2 H))) (prompt "OK Man! ") (setq SSC (vl-sort SSC '(lambda (EN1 EN2) (< (atof (lytrinh EN1)) (atof (lytrinh EN2)))))) (foreach SSn SSC (setq TD0 (acet-geom-midpoint (DXF 10 SSn) (DXF 11 SSn)) X (rtos (car TD0) 2 3) Y (rtos (cadr TD0) 2 3) STTBTD (tencoc SSn)) (entmake (list '(0 . "TEXT") (cons 10 BTT) (cons 11 BTT) (cons 40 (* 1 H)) (cons 1 STTBTD) (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2))) (setq SSnode (ssadd (entlast) SSnode)) (entmake (list '(0 . "TEXT") (cons 10 BTX) (cons 11 BTX) (cons 40 (* 1 H)) (cons 1 X) (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2))) (setq SSnode (ssadd (entlast) SSnode)) (entmake (list '(0 . "TEXT") (cons 10 BTY) (cons 11 BTY) (cons 40 (* 1 H)) (cons 1 Y) (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2))) (setq SSnode (ssadd (entlast) SSnode)) (setq BTX (polar BTX (* -0.5 pi) (* 2 H)) BTY (polar BTY (* -0.5 pi) (* 2 H)) BTT (polar BTT (* -0.5 pi) (* 2 H))) (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2) (cons 10 BR) (cons 10 BL))) (setq SSnode (ssadd (entlast) SSnode)) (setq EB1 (entget B1) EB1 (subst (cons 10 (setq BB1 (polar BB1 (* -0.5 pi) (* 2 H)))) (assoc 10 EB1) EB1)) (entmod EB1) (entupd B1) (setq EB2 (entget B2) EB2 (subst (cons 10 (setq BB2 (polar BB2 (* -0.5 pi) (* 2 H)))) (assoc 10 EB2) EB2)) (entmod EB2) (entupd B2) (setq EBK (entget BK) BRi (polar BR (* -0.5 pi) (* 2 H)) BLi (polar BL (* -0.5 pi) (* 2 H)) EBK (reverse (subst (cons 10 BRi) (assoc 10 EBK) EBK)) EBK (reverse (subst (cons 10 BLi) (assoc 10 EBK) EBK)) BR Bri BL BLi) (entmod EBK) (entupd BK) (setq EVK (entget VK) VRi (polar VBR (* -0.5 pi) (* 2 H)) VLi (polar VBL (* -0.5 pi) (* 2 H)) EVK (reverse (subst (cons 10 VRi) (assoc 10 EVK) EVK)) EVK (reverse (subst (cons 10 VLi) (assoc 10 EVK) EVK)) VBR Vri VBL VLi) (entmod EVK) (entupd VK)) (acet-ss-redraw SSnode 2) (setq OTHLAST (getvar "orthomode")) (setvar "orthomode" 0) (if (setq PT1 (acet-ss-drag-move SSnode BTR "Chon diem dat bang toa do...")) (vl-cmdf "move" SSnode "" BTR PT1) (vl-cmdf "erase" SSnode "")) (setvar "orthomode" OTHLAST) );progn ));if End Xuat bang toa do coc tu binh do );if (command "UCS" "P") (command "undo" "end") (princ) );end ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 

Ps: 1 lần nữa thanks anh Bình rất nhiều đã tận tình với nhoc, còn 1 cái nữa là nếu lên tới Nut 100000 thì nhìn nó ko còn cân so với elip nữa, nhưng nhoc hết sức sức rùi ^^ ko còn biết cân sao rứa, thò đc cái đầu qua thiên đường xem thế lào thui cũng mừng ^^

Hề hề hề,

Vậy là ngon rồi. Việc elip nó bao được text là Ok, còn cái vụ nó mập mạp, ấy là do cái tỷ lệ 0.75 đó mà thôi. Cùng chiều cao text nhưng khi text đủ dài thì bán trục dài đủ lớn khiến cho bán trục ngắn đủ bự. Nếu muốn ngon hơn thì đơn giản là bạn chọn tỷ lệ này phụ thuộc vào chiếu dài text. Tỷ như:

(setq TLBT (cond ((< len 10) 0.75) ((and (> len 10) (< len 20)) 0.70) ((and (> len 20) (< len 30)) 0.65)))

Nhưng như vậy thì khá lôi thôi vì chả ai biết được cái chiều dài text bao nhiêu là đủ cả.

Mặt khác cứ có elip đi rồi người dùng nếu thấy chưa vừa ý co thể tự điều chỉnh elip sao cho phù hôp là được chứ khó mà biết ý người dùng thế nào là đẹp nhóc ạ.

Cái cách của nhóc làm cho text không thật sụ nằn chính tâm elip vì :

(

 

entmake (list '(0 . "TEXT") (cons 10 PTL) (cons 11 (list (+ (car PTL) 0.65) (cadr PTL))) (cons 40 H) (cons 1 name) (cons 7 (nth 2 TD-value)) '(72 . 0) '(73 . 2)))

tức là tạo text cách dầu mút line một khoảng (+ (car PTL) 0.65)

Trong khi tâm của elip là

(

 

setq PTE (polar PTL 0 (/ len 1.7)))

Như vậy làm sao đảm bảo được tâm elip trùng với tâm text.

Đúng ra tâm text sẽ cách điểm PTL một đoạn là (+ (/ len 2) 0.65) chứ không phải là (/ len 1.7) và nhóc nên lấy tâm text làm tâm elip thì hình vẽ ra trong sẽ ngon mắt hơn.

 

Hề hề hề, góp ý một chút để nhóc tập suy luận khi làm lisp, nếu không hài lòng chớ có giận nghen. Làm được như vậy là quá tốt rồi, ráng chút xíu sẽ làm được những điều mình khoái nhóc ạ.

 

@ Chủ thớt: Lỗi font không phải do lisp đâu mà là do code box của diễn đàn. Chủ thớt chịu khó down file về chứ đừng copy code trong box. Cái elip bị nhỏ là do chủ thớt đang dùng textstyle khác với textstyle được chọn trong lisp đó. Hãy cẩn thận check lại text style của bản vẽ trước khi dùng lisp sao cho nó phù hợp với style được quy định trong lisp.

<<

bạn dùng lệnh pgp2lsp sau đây để convert file pgp hiện hành của bạn thành 1 file lisp. Sau đó copy file lisp này sang máy khác rồi appload lên rồi dùng.

>>

bạn dùng lệnh pgp2lsp sau đây để convert file pgp hiện hành của bạn thành 1 file lisp. Sau đó copy file lisp này sang máy khác rồi appload lên rồi dùng.

(defun c:pgp2lsp( / )
 (setq    
   flsp (open (getfiled "PGP to lisp - free lisp from CADViet.com" "cadviet_key" "lsp" 1) "w")
   fpgp (open (findfile "acad.pgp") "r")
 )
 (while (setq curstr (read-line fpgp))
   (if (and (/= (substr curstr 1 1) ";") (setq vt (vl-string-position (ascii ",") curstr)) (> vt 0))
     (progn
(setq lenhtat (vl-string-trim " " (substr curstr 1 vt))
      lenhdu  (vl-string-trim "*" (vl-string-trim " " (substr curstr (+ vt 2))))
      lenhlsp (strcat "(defun c:" lenhtat "()(command \"" lenhdu "\"))")
       )
(if (not (vl-string-position (ascii " ") lenhdu))
(write-line lenhlsp flsp)
  )
     )
   )
 )
 (close flsp)
 (close fpgp)
 (princ)
)

Vậy bây giờ em muốn lưu file fisp này ở 1 thư mục cố định và 1 tên cố định thì làm thế nào vậy anh ?

<<

 

Chào các bạn.

Các bạn cho mình hỏi có lệnh hoặc "set" biến hệ thống nào để các Polylines được tạo ra sau khi dùng...

>>

 

Chào các bạn.

Các bạn cho mình hỏi có lệnh hoặc "set" biến hệ thống nào để các Polylines được tạo ra sau khi dùng lệnh "Boundary"

luôn nằm trên cùng (nhìn thấy được theo màu của layer hiện hành).

mình đang dùng CAD-2010.

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/12432-da-xong-nho-giup-lisp-tinh-dien-tich-va-lap-bang/page-2


(defun c:bdt()

(setvar "cmdecho" 0)

(command "undo" "begin")

(setq lacol (getvar "CEColor"))

(setq ladin (getvar "dimzin"))

(setq laos (getvar "osmode"))  

(if (not tl) (setq tl 1))

(if (not h) (setq h 1))

(setq tl1 (getreal (strcat "\nty le ban ve < 1/" (rtos tl 2 0) " >: 1/"))

    caot1 (getreal (strcat "\nCao text < " (rtos h 2 2) " >: ")))

(if tl1 (setq tl tl1))

(if caot1 (setq h caot1))

(setq k 0 tdt 0)



(setvar "dimzin" 0)

(setvar "OSMODE" 0)

(setq PT (getpoint "\nChon diem xuat bang thong ke dien tich (mep trai):"))

(setq     P1 (list (+ (car PT)(* 6 h)) (cadr PT))

    P2 (list (+ (car PT)(* 22 h)) (cadr PT))

    P3 (list (car PT) (- (cadr PT)(* 3 h)))

    P4 (list (car P1) (cadr P3))

    P5 (list (car P2) (cadr P3))

    P6 (list (+ (car PT)(* 11 h)) (+ (cadr PT)(* 2 h)))

    P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))

    P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))

);setq

(command "pline" PT P2 P5 P3 "C"

        "pline" P1 P4 ""

        "text" "m" P6 (* 1.2 h) 0 "%¶ng thèng kª diÖn tÝch"

        "text" "m" P7 h 0 "STT"

        "text" "m" P8 h 0 "DiÖn tÝch (m2)"

);command



(setq pt1 (getpoint "\n Chon mien tinh dien tich : "))

(while (/= pt1 nil)

(command "erase" ss "")

(setq k (+ 1 k))

(command "TEXT" "m" pt1 (* 3 h) 0 (rtos k 2 0))

(setq PT (list (car P3) (cadr P3))

    P1 (list (+ (car PT)(* 6 h)) (cadr PT))

    P2 (list (+ (car PT)(* 22 h)) (cadr PT))

    P3 (list (car PT) (- (cadr PT)(* 3 h)))

    P4 (list (car P1) (cadr P3))

    P5 (list (car P2) (cadr P3))

    P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))

    P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))

    P9 (list (car PT) (- (cadr P3)(* 3 h)))

    P10 (list (car P1) (cadr P9))

    P11 (list (car P2) (cadr P9))

    P12 (list (car P7) (- (cadr P3)(* 1.5 h)))

    P13 (list (car P8) (cadr P12))

    );setq

(setq frome (entlast));; chon doi tuong cuoi cung truoc khi boundary

(command "cecolor"4 "-boundary" pt1 "");; boundary

(setq toe (entlast));; chon doi tuong cuoi cung sau khi boundary

(setq cur frome	ss (ssadd) S 0)

(while 	(not (eq cur toe));; chon cac doi tuong tu frome den toe

	(setq cur (entnext cur) ss (ssadd cur ss))

	(command "area" "S" "O" ss "" "")

	(setq dt (getvar "area") S (+ S dt))

);while

(command "area" "A" "O" "L" "" "")

(setq dt (getvar "area"))

(setq S (* (+ S (* dt 2)) tl tl) tdt (+ s tdt))  

(setvar "CEColor" lacol)

(command "pline" PT P2 P5 P3 "C"

	 "pline" P1 P4 ""

	 "text" "m" P7 h 0 (rtos k 2 0)

	 "text" "m" P8 h 0 (rtos s 2 2))

(setq pt1 (getpoint (strcat "\nTong dien tich = " (rtos tdt 2 3) "m2. chon mien do tiep theo...")))

);while

(command "erase" ss "")

(setq ss nil)

(setvar "DIMZIN" ladin)

(command     "pline" P3 P9 P11 P5 "C"

        "pline" P10 P4 ""

        "text" "m" P12 h 0 "Tæng"

        "text" "m" P13 h 0 (rtos tdt 2 2)

);command

(setvar "OSMODE" laos)

(command "undo" "end")

(setvar "cmdecho" 1)

)

Hề hề hề,

Đó là do các dòng lệnh sau đây gấy ra.

(while     (not (eq cur toe));; chon cac doi tuong tu frome den toe

 

    (setq cur (entnext cur) ss (ssadd cur ss))

 

    (command "area" "S" "O" ss "" "")

 

    (setq dt (getvar "area") S (+ S dt))

 

);while

 

Và

(command "erase" ss "")

 

Bạn hãy chịu khó đọc kỹ một chút sẽ vỡ ra là do khi bạn sử dụng bản vẽ củ thì thằng cur khác với thẳng toe và thế là nó bị nhét vào tập chọn ss và sau đó bị xóa mất tiêu. Còn khi bạn mới tạo một polyline kín thì thằng cur sẽ eq với thằng toe và nó không được nhét vào tập ss và vì thế nó tồn tại cho bạn nhòm thấy.

<<

(defun c:HO ()
(vl-load-com)
(prompt "pick diem")  
 (COMMAND "-LAYER" "m" "Ho" "color" "5" "" "") ;;; "lw" "1" 
(command "boundary" pause "") (princ))

Bạn test thử nhá!

Mình ghi ra kết quả theo: 180o12'34"

(defun c:ssdd(/ t1 t2 ls1 ls2 pt1 nd1 nd2 l1 l2 d1 d2 p1 p2 s1 s2...
>>

Bạn test thử nhá!

Mình ghi ra kết quả theo: 180o12'34"

(defun c:ssdd(/ t1 t2 ls1 ls2 pt1 nd1 nd2 l1 l2 d1 d2 p1 p2 s1 s2 ts tp td th olay font lay tong cao)
 (setq t1 (entsel "\nChon text 1: ")
t2 (entsel "\nChon text 2: ")
ls1 (entget (car t1))
ls2 (entget (car t2))
pt1 (getpoint "\nChon diem dat ket qua: ")
nd1 (cdr (assoc 1 ls1))
l1 (strlen nd1)
nd2 (cdr(assoc 1 ls2))
l2 (strlen nd2)
d1 (substr nd1 1 (- l1 7))
p1 (substr nd1 (- l1 5) 2)
s1 (substr nd1 (- l1 2) 2)
d2 (substr nd2 1 (- l2 7))
p2 (substr nd2 (- l2 5) 2)
s2 (substr nd2 (- l2 2) 2)
ts (+ (atoi s1) (atoi s2))
tp (+ (atoi p1) (atoi p2))
td (+ (atoi d1) (atoi d2))
)
 (if (>= ts 60)  
(setq tp (+ tp 1)
  ts (- ts 60)
  )
)

 (if (>= tp 60)  
(setq td (+ td 1)
  tp (- tp 60)
  )
)
 (cond ((and (< ts 10) (< tp 10))
 (setq tong (strcat (rtos td) "o0" (rtos tp) "'0" (rtos ts) "\""))
 )
)
 (cond ((and (< ts 10) (>= tp 10))
 (setq tong (strcat (rtos td) "o" (rtos tp) "'0" (rtos ts) "\""))
 )
)
 (cond ((and (>= ts 10) (< tp 10))
 (setq tong (strcat (rtos td) "o0" (rtos tp) "'" (rtos ts) "\""))
 )
)
 (cond ((and (>= ts 10) (>= tp 10))
 (setq tong (strcat (rtos td) "o" (rtos tp) "'" (rtos ts) "\""))
 )
)
 (setq th (getvar "textsize"))
 (setq olay (getvar "clayer"))
 (setq cao (cdr(assoc 40 ls1)))
 (setq font (cdr(assoc 7 ls1)))
 (setq lay (cdr(assoc 8 ls1)))
 (setvar "clayer" lay)
 (command "text" "s" font "m" pt1 cao "0" tong "")
 (setvar "textsize" th)
 (setvar "clayer" olay)
 (princ)
 )

 

ở Lsp này chỉ có + các text độ phút giây. bạn có thể bổ sung bước: (chọn text 1 ==> cộng hoặc trừ ==>chọn text 2==> kết quả) có được không ạ?

Thanks

<<

15 giờ trước, hung1608 đã nói:

Bạn nào sửa giúp mình lisp này...

>>

15 giờ trước, hung1608 đã nói:

Bạn nào sửa giúp mình lisp này thành : Chọn đối tượng bất kỳ thì đối tượng đó sẽ có linestype Scale = 0

Bạn thử cái này xem

(defun c:tt () (ssget) (setq tle 0) (command "change" "p" "" "p" "ltscale" tle ""))

 

<<

20 phút trước, hung1608 đã nói:

Bạn ơi. Lisp của bạn cần chọn...

>>

20 phút trước, hung1608 đã nói:

Bạn ơi. Lisp của bạn cần chọn tỷ lệ Linestyle Scale. Mình muôn khi dùng lisp thì đối tượng nào mình chọn thì Linestyle Scale = 0 luôn

Bạn giúp mình sửa lại lisp nhé

Sr bạn, do bạn nói bằng 0 nên mình để số 0 luôn, sửa lại thành 1 là được 

(defun c:tt () (ssget) (setq tle 1) (command "change" "p" "" "p" "ltscale" tle ""))

 

<<

9 phút trước, hung1608 đã nói:

Sory lại làm phiên bạn 1 chút. Mình...

>>

9 phút trước, hung1608 đã nói:

Sory lại làm phiên bạn 1 chút. Mình test thì nó chỉ bằng 1 được thôi

ở Layout khi Linestylen Scale = 1 thì nhiều lúc nó vẫn hiện nét đứt bạn ah. Bạn giúp mình nó =0 nhé

(defun c:tt ()
  (vl-load-com)
  (setq ss (acet-ss-to-list (ssget)))
(foreach ent ss
  (vla-put-linetypescale (vlax-ename->vla-object ent) 0)))

Bạn thử xem đã đúng chưa

<<

1 giờ} trướ}c, vtthanyeu đã nói:

Chỗ Fomular, chuột phải chọn...

>>

1 giờ} trướ}c, vtthanyeu đã nói:

Chỗ Fomular, chuột phải chọn insertField, chọn tiếp cái nào để ra được tag L và a vậy ạ?

Ps: em tìm được rồi. Bây giờ em muốn hỏi là nếu mình nhập trực tiếp vào chỗ tag SL thì sau đó khi sửa lại tag L hoặc tag KC nó ko tự động nhảy lại. Có cách nào để nhập tay cũng được và sau đó thay đổi tag L, tag a nó vẫn ra kết quả đúng không ạ?

(defun C:doan ()
 (setq ent (car (nentsel "\nPick tag SL: ")))
  (setq entn (dxf 330 ent)
	tag (dxf 2 ent))
  (setq blname (dxf 2 entn))	
 (setq tagL (cdr (assoc 2 (entget (car (nentsel "\nPick tag L: "))))))
   (setq taga (cdr (assoc 2  (entget (car (nentsel "\nPick tag a: "))))))
    (setq elst (acet-ss-to-list (ssget (list (cons 0 "INSERT")(cons 2 blname)))))
	(foreach entt elst
	  (setq L (atoi (cdr (assoc tagl (att_get entt))))
		a (atoi (cdr (assoc taga (att_get entt)))))
	  (setq SL (/ L a))
    (setq str (itoa SL))
	      (att_set entt tag str)
	  )
  (princ)
  ) ;END DEFUN
;***********************************
(defun dxf(id ent) (cdr (assoc id (entget ent))))
;THONG KE ATT
;(att_get (car (entsel)))
(defun att_get (ent)
  (if ent
    (mapcar '(lambda (att) (cons (vla-get-tagstring att) (vla-get-textstring att)))
	    (vlax-invoke (vlax-ename->vla-object ent) 'getattributes)
	    )
    )
  )

;SUA ATT THEO TAG
(defun att_set (ent tag val)
  (setq tag (strcase tag))
  (vl-some
    '(lambda (att)
       (if (= tag (strcase (vla-get-tagstring att)))
	 (progn (vla-put-textstring att val) val)
	 )
       )
    (vlax-invoke (vlax-ename->vla-object ent) 'getattributes)
    )
  )

Nếu bạn sửa như vậy thì Field bị mất đi rồi, Regen lại cũng không được. Mình viết cho bạn lisp này, sửa xong toàn bộ các vị trí đó rồi load lisp, làm theo hướng dẫn sẽ sửa được hàng loạt, những block nào sửa tay thì nhớ bỏ qua đừng chọn nhé 

<<

6 giờ trước, ngothanhduy đã nói:

HÌNH NHƯ LIPS NÀY CỦA BRO...

>>

6 giờ trước, ngothanhduy đã nói:

HÌNH NHƯ LIPS NÀY CỦA BRO GIỐNG NHƯ LÀ ĐO CHIỀU DÀI, CHỨ KHÔNG PHẢI GÁN TRƯỜNG TEXT THEO LINE, POLYLINE,... VÌ KHI MÌNH THAY ĐỔI CHIỀU DÀI, THÌ TEXT KHÔNG TỰ BIẾN THIÊN THEO SAU KHI NHẤN LỆNH "REGEN"

BRO XEM LẠI VIDEO CỦA MÌNH ĐỂ HIỂU ĐƯỢC PHẦN NÀO Ạ.

 

 

 

Bạn nên nói rõ là gán Field vào Text thì đỡ phải sửa nhiều 

Đã sửa và thêm Field chiều dài  của Pline vào text

Chọn pline - nhập NUMBER - chon text gán giá trị. 

Khi pline thay đổi thì Regen để thấy giá trị mới. (Lưu ý, số chữ số thập phân của kết quả sau cùng theo UNIT của bản vẽ) 

(defun c:xx ()
(vl-load-com)
(while (setq e (car (entsel "\n Chon pline can ghi chieu dai ")))
 (Setq dot (getint "\nNhap NUMBER de chuyen vi tri dau phay:")
       a "1")
  (repeat dot
    (setq a (strcat "0" a)))
       (setq txt1 (substr a 1 1)
	     txt2 (substr a 2)
	     txt3 (strcat txt1 "." txt2))
      (setq txtt (strcat "%<\\AcObjProp Object(%<\\_ObjId "
              (itoa (vla-get-ObjectID (vlax-ename->vla-object e))) 	 
              ">%).Length \\f \"%lu6%ct8\">%"))
      (setq txt (car (entsel "\n Chon text can ghi bo xung gia tri chieu dai polyline"))
	      noidung (strcat " L= " txtt ))
	(vla-put-textstring (vlax-ename->vla-object txt) noidung)
))

 

<<

Các bác ơi sữa giùm mình đoạn lisp sau này nhé.

 

(defun C:cg()
 (setvar "CMDECHO" 0)
 (setq pre (getint "\nSo chu so sau dau phay?"))
 (command "luprec" pre)
 (setq...
>>

Các bác ơi sữa giùm mình đoạn lisp sau này nhé.

 

(defun C:cg()
 (setvar "CMDECHO" 0)
 (setq pre (getint "\nSo chu so sau dau phay?"))
 (command "luprec" pre)
 (setq tong 0)
 (SETQ TH (SSGET))
(SETQ QUANT (SSLENGTH TH))
(SETQ INDEX 0)
(WHILE (  (IF 
  (AND(= "TEXT" (CDR (ASSOC 0 (SETQ A (ENTGET (SSNAME TH INDEX)))))))      
    (PROGN
	 (setq s (entget (SSNAME TH INDEX)))
	   (setq otext (assoc 1 s))
	   (setq ot (cdr otext))
	   (setq ot (read (substr ot 1 )))
	   (setq tong (+ ot tong))
      )
 	)
 (setq index (+ index 1))
)
(prompt "\n Chon gia tri can thay the")
(SETQ TT (SSGET))
(SETQ QUAN (SSLENGTH TT))
(SETQ INDE 0)
(WHILE (  (IF 
  (AND(= "TEXT" (CDR (ASSOC 0 (SETQ A (ENTGET (SSNAME TT INDE)))))))      
    (PROGN
	 (setq s (entget (SSNAME TT INDE)))
	   (setq otext (assoc 1 s))
	   (setq ot (cdr otext))
	   (setq ot (read (substr ot 1 )))
                  (setq nt (cons 1 (rtos Tong 2)))  
	   (setq s (subst nt otext s))
	   (entmod s)
    )
 	)
 (setq inde (+ inde 1))
)
 )

với đoạn lisp này khi cộng các giá trị mà có tổng của chúng nhỏ hơn 1 thì nó không xuất ra kết quả 0.3 (giả sử kết quả là 0.3), mà kết quả xuất ra là ".3" ; nếu để thế rồi tiền hành phép toán khác thí nó lại không nhận gía trị .3 mà phải sửa lai 0.3 rồi mới thực hiện được.

 

các bác có thể giúp mình khác phục tình trạng trên không, làm sao để có đươc kết quả là "0.3"

 

Đoạn lisp trên của bạn chẳng có vấn đề gì cả.

Vấn đề nằm ở biến hệ thống DIMZIN của AutoCAD. Bạn gõ DIMZIN tại dòng lệnh, rồi đặt về giá trị 0 là được (Hiện nay chắc chắn nó đang là 4).

<<