Đến nội dung


Hình ảnh
* * * - - 1 Bình chọn

[Đã xong] Tính tổng diện tích các hình trên bản vẽ, "Ed" vào text sẵn có


  • Please log in to reply
100 replies to this topic

#81 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 30 October 2012 - 10:16 AM

Với lisp này thì sao mà em load thì máy đã tính đc diện tích nhưng khi điền diện tích thì "Chon text de ghi ket qua:; error: no function definition:
VLAX-ENAME->VLAX-OBJECT"

Hề hề hề,
Nếu vợ dữ bạn sẽ thành người hay nói ..... điêu.
VLAX-ENAME->VLAX-OBJECT ????
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#82 hiepttr

hiepttr

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1298 Bài viết
Điểm đánh giá: 518 (tốt)

Đã gửi 30 October 2012 - 11:32 AM

Hề hề hề,
Nếu vợ dữ bạn sẽ thành người hay nói ..... điêu.
VLAX-ENAME->VLAX-OBJECT ????

Bác nhìn kĩ thật đó!
mình down về, chạy thấy lỗi VLAX-ENAME->VLA-OBJECT , điếc ko sợ súng nên mình mở lisp ra thấy 2 chữ (vlax... và vla) ko giống nhau. mình tự sửa lại (thêm chữ X) thế là nó ra dòng chữ đó thôi !
Ai ngờ nó càng sai, đang định theo bác Ketxu để tu luyện 1 khóa đây !
Hẹn 1 ngày đẹp trời mình sẽ bái sư để nhập môn ! OK!
  • 0

Có vợ dù dữ dù hiền , bạn đều có lợi
_ Nếu vợ hiền, bạn sẽ là người đàn ông sung sướng
_ Nếu vợ dữ, bạn sẽ thành ... triết gia !

Bergson


#83 kuongkurt

kuongkurt

    biết zoom

  • Members
  • Pip
  • 10 Bài viết
Điểm đánh giá: 3 (bình thường)

Đã gửi 29 November 2012 - 11:24 AM

Em chào các cao thủ tính diện tích.
Em muốn nhờ các bác viết giúp lisp có 2 bước:
1 - Tính diện tích các vùng (tự cộng các vùng đó).
2- Sau khi có kết quả thì lấy kết quả đó cộng vào một text sẵn có giá trị hiển thị trên bản vẽ.
Cảm ơn các bạn rất nhiều!
  • 0

#84 kuongkurt

kuongkurt

    biết zoom

  • Members
  • Pip
  • 10 Bài viết
Điểm đánh giá: 3 (bình thường)

Đã gửi 30 November 2012 - 10:30 AM

Không có Pro nào ra tay giúp em với ạ? :(
  • 0

#85 truyencd1

truyencd1

    Chưa sử dụng CAD

  • Members
  • Pip
  • 2 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 04 July 2014 - 09:32 PM

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.c...t-san-co/page-3
(defun c:udt(/ ss tong ham tmp tt hstl oldim toe frome cur dt)
(prompt "\n Kich thuoc cua chuong trinh tinh theo don vi mm ")
(if (not hstlo) (setq hstlo 0.001))
(setq hstl (getreal (strcat "\n Nhap ti le chuyen doi don vi <" (rtos hstlo 2 3) "> :")))
(if (not hstl) (setq hstl hstlo) (setq hstlo hstl))
(if (not tpo) (setq tpo 2))
(setq tp (getint (strcat "\n Nhap So chu so thap phan <" (itoa tpo) "> :")))
(if (not tp) (setq tp tpo) (setq tpo tp))
(setq oldim (getvar "Dimzin"))
(setvar "Dimzin" 0) 
(prompt "\n Chon doi tuong de tinh dien tich hay Enter de tinh dien tich theo Pick diem ")
(setq
ss (ssget '((-4 . "<OR")(0 . "LWPOLYLINE")(0 . "REGION")(0 . "CIRCLE")(0 . "ARC")(-4 . "OR>"))) 
tong 0.0
ham (lambda (x) (command ".area" "o" x) (setq tong (+ tong (getvar "area"))))
tmp (mapcar 'ham (ss2ent ss)) 
)

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

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


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

(setvar "Dimzin" oldim)


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

 

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

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

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


  • 0

#86 oldman8x

oldman8x

    Chưa sử dụng CAD

  • Members
  • Pip
  • 2 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 27 August 2014 - 02:29 PM

sao mình tính toàn ra 0.00 nhỉ?là sao vậy bạn?

Bởi vì lisp UDT trên chỉ nhận đối tượng là polyline còn đối tượng là 2D polyline thì nó không nhận nên cho KQ=0.00. Liên quan đến biến plinetype, bạn nào sửa giúp để nó nhận được cả poly và 2D poly được không? mình không muốn sửa mặc định biến plinetype


  • 0

#87 thanhmom2009

thanhmom2009

    biết zoom

  • Members
  • Pip
  • 12 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 01 December 2014 - 12:44 PM

Xin chào các sư huynh! Em đang tính diện tích mcn, sử dụng lisp tính diện tích này (http://www.cadviet.c...h_dien_tich.lsp), 

(defun C:DT (/ pc dt tyle fo)
  (setvar "CMDECHO" 0)
  (if (= fname nil)
    (setq fname (getfiled "Chon tap tin luu so lieu" "//" "txt" 1))
  )
  (setq fo (open fname "a"))
  (princ "Cac dien tich da chon:" fo)
  (princ "\n" fo)
  (if (= tylen nil)
    (progn
      (setq tylen (getreal "\nTy le ban ve 1/<1000>:"))
      (if (= tylen nil)
	(setq tylen 1000.0)
      )
    )
  )
  (setq tyle (/ (* tylen tylen) 1000000.0))
  (setq pc (getpoint "\nChon diem giua:"))
  (while (/= pc nil)
    (command "layer" "n" "dientich" "c" "white" "dientich" "")
    (command "bpoly" pc "")
    (command "Area" "O" "L")
    (command "erase" "L" "")
    (setq dt (getvar "AREA"))
    (setq dt (* dt tyle))
    (setq dt (rtos dt 2 2))
    (command "layer" "s" "dientich" "")
    (setq dt (strcat dt " m2"))
    (command "text" "c" pc 2.3 0.0 dt)
    (princ dt fo)
    (princ " m2")
    (princ "\n" fo)
    (setq pc (getpoint "\nChon diem giua:"))
  )
  (close fo)
  (princ)
 (setvar "CMDECHO" 1)
) 

 

nhưng có nhiều điểm bất tiện em xin nhờ các sư huynh bổ sung giúp em :

A. Lisp trên sử dụng như sau:

1. Load lisp, nhập lệnh "dt"

2. Chọn tập tin lưu số liệu

3. Nhập tỷ lệ

4. Chọn điểm giữa (vùng cần tính diện tích) -> xuất text diện tích 

5. Tính diện tích các vùng khác chỉ cần chọn điểm giữa (bước4 mà không cần nhập lại bước 1,2,3)!

B. Cái em cần bổ sung như sau:

1. Chọn được style text diện tích: font, height (em chưa thấy lisp tính diện tích nào chọn được cái này)

2. Khi tính diện tích đồng thời bo luôn vùng chọn cho mình (em thấy có lisp bo được nhưng lại không tính nhiều diện tích 1 lần nhập lệnh được)

Em xin cảm ơn các sư huynh trước.


  • 0

#88 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 01 December 2014 - 04:30 PM

- y/c của bạn cũng ngộ ngộ, nhoc thử viết như vậy bạn test thử hen ^^

;========================================================================================
(defun ReplaceString (old_str new_str str / m n) (vl-load-com)
(setq m 0 n (strlen new_str))
(while (setq m (vl-string-search old_str str m))
(setq str (vl-string-subst new_str old_str str m))
(setq m (+ n m))
)
str
)
;========================================================================================
(defun tachsym(str sym / datach kytu dem lstdatach)
  (setq dem 1)
  (while (<= dem (strlen str))
    (setq datach "")
    (setq kytu (substr str dem 1))
    (while (and (/= kytu sym) (<= dem (strlen str)))
      (setq datach (strcat datach kytu))
      (setq dem (+ dem 1))
      (setq kytu (substr str dem 1))
    ); end while con
    (setq dem (+ dem 1))
    (setq lstdatach (append lstdatach (list datach)))
  ) ;end while me
  datach
)
;=============================================================
;======================================================================================================================
(defun K:dsbg (table / lst phu)
(tblnext table t)
(while (setq phu (tblnext table nil))
(setq lst (cons (cdr (assoc 2 phu)) lst))
)
)
;================================
(defun c:dt(/ tl ntl tl2 h k tdt pt pt1 pt5 ss  frome toe cur dt S laos K:text getvalueK lacol ladin dt ss1 ten K:layer K:style ds_style e1 e1 chon)
(vl-load-com)
;=====================================================================
 ;==================================================
;;ham tao text 2
(defun K:text(pt height string justify layer textstyle mau ang / lst)
(setq lst (list '(0 . "TEXT")
                              (cons 10 pt)
							  (cons 40 height)
							  (cons 1 string)
							  (cons 50 (if ang ang 0))
							  (cons 8 layer)
							  (cons 7 textstyle)
							  (cons 62 (if mau mau 256))
							  
			)
			justify (strcase justify))
		(cond   ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 11 pt)))))
		        ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 pt)))))
				((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 pt)))))
				((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 pt)))))
				)
	(entmakex Lst)
  )	;end K:text
;;--------------------------------------
;; ham luu gia tri
(defun getvalueK ( a giatri dongnhac / astr) 
(or a (setq a giatri))
(cond
	((= (type a) 'INT) (setq a (cond ((getint (strcat "\n" dongnhac "(" (itoa a) ") :")))(a))))
	((= (type a) 'REAL) (setq a (cond ((getreal (strcat "\n" dongnhac "(" (rtos a 2 1) ") :")))(a))))
	((= (type a) 'STR) (setq a (cond ((= "" (setq astr (getstring T (strcat "\n" dongnhac " (" a "): ")))) a) (astr))))
))
;;;;
;=================================================================================
(defun K:layer (ten clr)
(if (null (tblsearch "LAYER" ten))
(entmakex (list 
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
			   '(70 . 0)
                (cons 2 ten)
                (cons 62 clr))
)
)
)
;========================================================================================
;hàm tạo textstyle
(defun K:style (MyStyle MyFont)
(entmake (list    (cons 0 "STYLE")    
(cons 100 "AcDbSymbolTableRecord")    
(cons 100 "AcDbTextStyleTableRecord")    
(cons 2 MyStyle)    (cons 3  MyFont)    
(cons 70 0))))
;=====================================================================================
(if (= fname nil)
    (setq fname (getfiled "Chon tap tin luu so lieu" "//" "txt" 1))
  )
  (setq fo (open fname "a"))
  (princ "Cac dien tich da chon:" fo)
  (princ "\n" fo)
;======================================================================================
 (if (null (tblsearch "layer" "ab-dientich")) (K:layer "ab-dientich" 4))
 (if (null (tblsearch "style" "VAVON")) (K:style "VAVON" "VAVON.ttf"))
;===================================================================================
(setvar "cmdecho" 0)
(command "undo" "begin")
(setq lacol (getvar "CEColor"))
(setq ladin (getvar "dimzin"))
(setq laos (getvar "osmode"))
(setq lacl (getvar 'clayer))  
;================================================================
(setq ds_style (vl-princ-to-string (K:dsbg "style")))
(setq e1 (tachsym ds_style "("))
(setq e2 (Xstrcase (tachsym e1 ")")))
(initget 1 e2)
(setq chon (getkword (strcat "Nh\U+1EADp ch\U+1EEF \U+0111\U+1EA7u t\U+00EAn Style m\U+00FAn set: < "  (ReplaceString " " "/" e2)  " >:")))
;========================================================
(setq tl (getvalueK tl 1000.0 "Mau so Ti le ht "))
(setq ntl (/ 1000 tl))
(setq h (getvalueK h 1.8 "Nhap chieu cao text "))
(setq tl2 (* ntl ntl))
;==================================================================
(setq k 0 tdt 0)
(setvar "dimzin" 0)
(setvar "OSMODE" 0)
;======================================
;;===========================================================
(initget 1 "Thoat")
(setq pt1 (getpoint "\n Chon mien tinh dien tich / Thoat : "))
(while (/= pt1 nil)
;(command "erase" ss "")
(setq k (+ 1 k))
(K:text pt1 h (itoa k) "M" "k-dem" "VAVON" 1 nil)
;-----------------------------------------------------------------------------
(setq frome (entlast));; chon doi tuong cuoi cung truoc khi boundary
(command "cecolor"1 "-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") tl2) S (+ S dt))

);while

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

(setq dt (/ (getvar "AREA") tl2))

(setq S (+ S (* dt 2))) 
  (setq  tdt (+ s tdt))  
(princ tdt fo)
(princ " m2")
(princ "\n" fo)
(setvar "CEColor" lacol)
;==========================================
;===================================================================
(setq pt1 (getpoint (strcat "\nTong dien tich = " (rtos tdt 2 1) "m2. chon mien do tiep theo...")))
);while
;=======================================================================
;(command "erase" ss "")
;(setq ss nil)
(setvar "DIMZIN" ladin)
;================================================
;=================================================================================
(initget 1) 
(setq pt5 (getpoint "\nChon diem dat ket qua:"))
(K:text pt5 h (strcat (rtos tdt 2 1) "m%%178") "M" "ab-dientich" chon nil nil)
(setq ss1 (ssget "X" '((0 . "TEXT") (8 . "k-dem"))))
(if ss1
 (progn
   (repeat (sslength ss1)
	 (setq ten (ssname ss1 0))
	 (entdel ten)
	 (ssdel ten ss1)
	 )
  )
 )
;===============
(setvar 'clayer lacl)
;=====================
(vl-cmdf "-purge" "layer" "k-dem" "y" "y")
(setvar "OSMODE" laos)
(command "undo" "end")
(close fo)
(setvar "cmdecho" 1)
(princ "\n")
(princ "xong")
(princ)
)
 


  • 1
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#89 thanhmom2009

thanhmom2009

    biết zoom

  • Members
  • Pip
  • 12 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 01 December 2014 - 07:32 PM

Bạn ơi, cái của bạn mình test thử thế này:http://www.cadviet.c...h_dien_tich.dwg

1.chọn tập tin lưu dữ liệu

2.nhập chữ đầu tên style muốn set? "mình chọn v"

3. mẫu số tỷ lệ!

4. chiều cao chữ

5. chọn miền tính diên tích

Thế là bấm cái đầu tiên ra diện tích là "1", bấm cái thứ 2 hiện lên số "2"...3,4,5,....

Bấm ra ngoài chỗ trống cũng hiện số.

Bạn xem lại giùm nhé. Cám ơn nhé!


  • 0

#90 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 01 December 2014 - 09:47 PM

- ^^ ah quên lsp mình nó tính khác, cái đó chỉ là đánh số vùng đã chọn, diện tích từng hình nó vô file txt chứ ko in ra text ^^, khi nào pick hết enter để chọn điểm ghi ra diện tích tổng các hình đã pick 

- nhoc sữa lại xíu giống với lsp cũ của bạn


 
;========================================================================================
(defun ReplaceString (old_str new_str str / m n) (vl-load-com)
(setq m 0 n (strlen new_str))
(while (setq m (vl-string-search old_str str m))
(setq str (vl-string-subst new_str old_str str m))
(setq m (+ n m))
)
str
)
;========================================================================================
(defun tachsym(str sym / datach kytu dem lstdatach)
  (setq dem 1)
  (while (<= dem (strlen str))
    (setq datach "")
    (setq kytu (substr str dem 1))
    (while (and (/= kytu sym) (<= dem (strlen str)))
      (setq datach (strcat datach kytu))
      (setq dem (+ dem 1))
      (setq kytu (substr str dem 1))
    ); end while con
    (setq dem (+ dem 1))
    (setq lstdatach (append lstdatach (list datach)))
  ) ;end while me
  datach
)
;=============================================================
;======================================================================================================================
(defun K:dsbg (table / lst phu)
(tblnext table t)
(while (setq phu (tblnext table nil))
(setq lst (cons (cdr (assoc 2 phu)) lst))
)
)
;================================
(defun c:dt(/ tl ntl tl2 h k tdt pt pt1 pt5 ss  frome toe cur dt S laos K:text getvalueK lacol ladin dt ss1 ten K:layer K:style ds_style e1 e1 chon)
(vl-load-com)
;=====================================================================
 ;==================================================
;ham tao text 2
(defun K:text(pt height string justify layer textstyle mau ang / lst)
(setq lst (list '(0 . "TEXT")
                              (cons 10 pt)
							  (cons 40 height)
							  (cons 1 string)
							  (cons 50 (if ang ang 0))
							  (cons 8 layer)
							  (cons 7 textstyle)
							  (cons 62 (if mau mau 256))
							  
			)
			justify (strcase justify))
		(cond   ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 11 pt)))))
		        ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 pt)))))
				((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 pt)))))
				((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 pt)))))
				)
	(entmakex Lst)
  );end K:text
;--------------------------------------
; ham luu gia tri
(defun getvalueK ( a giatri dongnhac / astr) 
(or a (setq a giatri))
(cond
	((= (type a) 'INT) (setq a (cond ((getint (strcat "\n" dongnhac "(" (itoa a) ") :")))(a))))
	((= (type a) 'REAL) (setq a (cond ((getreal (strcat "\n" dongnhac "(" (rtos a 2 1) ") :")))(a))))
	((= (type a) 'STR) (setq a (cond ((= "" (setq astr (getstring T (strcat "\n" dongnhac " (" a "): ")))) a) (astr))))
))
;;;;
;=================================================================================
(defun K:layer (ten clr)
(if (null (tblsearch "LAYER" ten))
(entmakex (list 
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
			   '(70 . 0)
                (cons 2 ten)
                (cons 62 clr))
)
)
)
;========================================================================================
;hàm t?o textstyle
(defun K:style (MyStyle MyFont)
(entmake (list    (cons 0 "STYLE")    
(cons 100 "AcDbSymbolTableRecord")    
(cons 100 "AcDbTextStyleTableRecord")    
(cons 2 MyStyle)    (cons 3  MyFont)    
(cons 70 0))))
;=====================================================================================
(if (= fname nil)
    (setq fname (getfiled "Chon tap tin luu so lieu" "//" "txt" 1))
  )
  (setq fo (open fname "a"))
  (princ "Cac dien tich da chon:" fo)
  (princ "\n" fo)
;======================================================================================
 (if (null (tblsearch "layer" "ab-dientich")) (K:layer "ab-dientich" 4))
 (if (null (tblsearch "style" "VAVON")) (K:style "VAVON" "VAVON.ttf"))
;===================================================================================
(setvar "cmdecho" 0)
(command "undo" "begin")
(setq lacol (getvar "CEColor"))
(setq ladin (getvar "dimzin"))
(setq laos (getvar "osmode"))
(setq lacl (getvar 'clayer))  
;================================================================
(setq ds_style (vl-princ-to-string (K:dsbg "style")))
(setq e1 (tachsym ds_style "("))
(setq e2 (Xstrcase (tachsym e1 ")")))
(initget 1 e2)
(setq chon (getkword (strcat "Nh\U+1EADp ch\U+1EEF \U+0111\U+1EA7u t\U+00EAn Style m\U+00FAn set: < "  (ReplaceString " " "/" e2)  " >:")))
;========================================================
(setq tl (getvalueK tl 1000.0 "Mau so Ti le ht "))
(setq ntl (/ 1000 tl))
(setq h (getvalueK h 1.8 "Nhap chieu cao text "))
(setq tl2 (* ntl ntl))
;==================================================================
(setq k 0 tdt 0)
(setvar "dimzin" 0)
(setvar "OSMODE" 0)
;======================================
;===========================================================
(initget 1)
(setq pt1 (getpoint "\n Chon mien tinh dien tich: "))
(while (/= pt1 nil)
(setq k (+ 1 k))
;-----------------------------------------------------------------------------
(setq frome (entlast));; chon doi tuong cuoi cung truoc khi boundary
(command "cecolor"1 "-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") tl2) S (+ S dt))

);while

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

(setq dt (/ (getvar "AREA") tl2))

(setq S (+ S (* dt 2))) 
(K:text pt1 h (strcat (rtos dt 2 1) "m%%178") "M" "ab-dientich" chon nil nil)  
(princ dt fo)
(princ " m2")
(princ "\n" fo)
(setvar "CEColor" lacol)
;==========================================
;===================================================================
(setq pt1 (getpoint (strcat "\nchon mien do tiep theo...")))
);while
;=======================================================================
(setvar "DIMZIN" ladin)
;================================================
;=================================================================================
;===============
(setvar 'clayer lacl)
;=====================
(setvar "OSMODE" laos)
(command "undo" "end")
(close fo)
(setvar "cmdecho" 1)
(princ "\n")
(princ "xong")
(princ)
)
 

 


  • 1
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#91 suslucky

suslucky

    Chưa sử dụng CAD

  • Members
  • Pip
  • 3 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 01 December 2014 - 10:53 PM

Các anh cho em hỏi Pick điểm vào miền kín là thế nào ạ


  • 0

Thi công ép cọc bê tông - ép cừ - thi công văng chống tầng hầm - pha do san lap mat bang

http://epcocbetong.org | http:// epcocbetonghanoi.com.vn


#92 thanhmom2009

thanhmom2009

    biết zoom

  • Members
  • Pip
  • 12 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 02 December 2014 - 08:24 AM

Các anh cho em hỏi Pick điểm vào miền kín là thế nào ạ

Giống như lệnh hatch đó bạn.


  • 0

#93 thanhmom2009

thanhmom2009

    biết zoom

  • Members
  • Pip
  • 12 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 02 December 2014 - 08:32 AM

Cám ơn nhóclangbat!

Lisp của bạn thật hay, đáp ứng gần như đầy đủ các yêu cầu của mình, trừ duy nhất 1 điều là:

- mình muốn tính diện tích từng hình riêng lẻ chứ không cần tính tổng diện tích 

Chắc chắn sau này mình sẽ ứng dụng lisp này để tính tổng diện tích vì ý tưởng của lisp rất thiết thực, còn hiện tại công việc mình là tính diện tích từng hình riêng lẻ

để kiểm tra diện tích thiết kế. Mong nhóc giúp mình nhé! 


  • 0

#94 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 02 December 2014 - 09:22 AM

- hihi nhoc chỉnh nhầm tí, nhoc đã cập nhật lại lisp #90 bạn tải lại chạy thử xem ^^


  • 1
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#95 thanhmom2009

thanhmom2009

    biết zoom

  • Members
  • Pip
  • 12 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 02 December 2014 - 12:34 PM

Ok rồi nhoc ơi!

Mình đang chỉnh cho text xuất ra có 2 chữ số thập phân, không biết lisp nên mò chỗ nào có số 1 đổi thành số 2 thử... hihi

Cảm ơn nhoc nhé.


  • 0

#96 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 02 December 2014 - 01:14 PM

Ok rồi nhoc ơi!

Mình đang chỉnh cho text xuất ra có 2 chữ số thập phân, không biết lisp nên mò chỗ nào có số 1 đổi thành số 2 thử... hihi

Cảm ơn nhoc nhé.

- ek ^^ đổi vậy coi chừng nguy hiểm, trong đó nhiều số 1 lắm ^^, bạn kím ngay dòng này sữa số 1 thành 2 là đc nè

(K:text pt1 h (strcat (rtos dt 2 1) "m%%178") "M" "ab-dientich" chon nil nil) => đổi số 1 màu đỏ thành số 2 là ok


  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#97 thanhmom2009

thanhmom2009

    biết zoom

  • Members
  • Pip
  • 12 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 02 December 2014 - 05:45 PM

Hehe, mình cũng tìm ra chỗ đó rồi, nói thì vậy chứ tìm mò cũng có chiêu chứ, tìm số 1 nào có liên quan đến text mới được chứ. Hehe, thanks nhoc nhé 


  • 0

#98 Thuc Tap Vien

Thuc Tap Vien

    biết zoom

  • Members
  • Pip
  • 14 Bài viết
Điểm đánh giá: -1 (bình thường)

Đã gửi 13 January 2016 - 08:48 PM

Kính nhờ MOD sửa giúp với ạ : Em thấy Lisp "udt" của bác Tue_NV chỉnh lại sử dụng rất tốt. 

MOD Phạm Thanh Bình đã chỉnh sửa theo bạn ( V77 ) rồi nhưng khi sử dụng nó bị thế này ạ : 

 Command: udt

 Kich thuoc cua chuong trinh tinh theo don vi mm
 Nhap ti le chuyen doi don vi <0.001> :
 Nhap So chu so thap phan <2> :
 Chon doi tuong de tinh dien tich hay Enter de tinh dien tich theo Pick diem
Select objects: 1 found
Select objects:
; error: no function definition: SS2ENT
Command:
* Nhờ MOD chỉnh sửa lại giúp với ạ
- Theo ý kiến của em MOD có thể bổ sung thêm là : Sau khi có kết quả thì Pick điểm để ghi kết quả ra. Kết quả ra có thể là Text hiện hành hoặc theo Dim hiện hành hoặc trong ô giống khi sử dụng lênh TOLERANCE.
Em xin chân thành cảm ơn.!!!
P/S: Em gửi kèm theo file của MOD Bình sửa ạ.http://www.cadviet.c.../149353_udt.lsp

  • 0

#99 Thuc Tap Vien

Thuc Tap Vien

    biết zoom

  • Members
  • Pip
  • 14 Bài viết
Điểm đánh giá: -1 (bình thường)

Đã gửi 13 January 2016 - 08:51 PM

Em không hiểu sao trên màn hình hiện không đủ nội dung.

Mong MOD thông cảm !!!


  • 0

#100 Mũn xinh

Mũn xinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 1313 Bài viết
Điểm đánh giá: 633 (tốt)

Đã gửi 10 March 2016 - 11:12 AM

Command: UDT
Command:
Kich thuoc cua chuong trinh tinh theo don vi mm
Nhap ti le chuyen doi don vi <1.000> :
Nhap So chu so thap phan <4> :
Chon doi tuong de tinh dien tich hay Enter de tinh dien tich theo Pick diem
Select objects: 1 found
Select objects: 1 found, 2 total
Select objects: 1 found, 3 total
Select objects: VVC: Internal Error

Hixxx, trước đây em dung lệnh này ok, bây giờ nó cứ báo lỗi như này không hiểu tại sao.
  • 0

...Một chiều ngồi say

Một đời thật nhẹ

Ngày qua...