Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
lamngoctien0810

[Nhờ sửa lisp] Đo tổng chiều dài đối tượng trên Autocad 2015

Các bài được khuyến nghị

nguyentieu    0

Chào cả nhà,

 

Hôm nay search topic này đúng ngay chỗ bữa giờ e lăn tăn. Chẳng là e đang dùng cái lisp TDT TCD, hjx, kể từ khi xài qua thằng Cad 16 thì TDT vẫn ok, trong khi thằng TCD lại "đơ". Bác nào fix giúp em lỗi này với nhé, thanks  :)

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/59317-nho-chi-nh-su-a-lisp-ti-nh-to-ng-die-n-ti-ch-va-chu-vi-ca-c-hi-nh/
(defun c:tdt(/ dt sdt gt tgt id pt1)
  (setq dt (ssget
  	'((-4 . "<OR")
   (0 . "CIRCLE")
   (0 . "*POLYLINE")
   (-4 . "OR>")
     	))
 )
  (setq
 sdt (sslength dt)
 id 0
 tgt 0)
(testcaochu)
  (repeat sdt
	(setq ent (ssname dt id)
   id (1+ id)
   )
	(command "area" "o" ent "")
	(setq gt (getvar "area"))
	(setq tgt (+ tgt gt))
	(princ)
	)
(setq pt1 (getpoint "\nchon diem ghi chu:"))
  (command "text" "j" "mc" pt1 (rtos caochu) "0" (strcat(rtos (/ tgt 1000000) 2 1) "m2"))
  (princ)
  )
;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:tcd(/ DT SDT TCD PT1)
  (setq dt (ssget '((-4 . "<OR")
   (0 . "CIRCLE")
   (0 . "ELLIPSE")
   (0 . "SPLINE")
   (0 . "ARC")
   (0 . "LINE")
   (0 . "*POLYLINE")
   (-4 . "OR>")
		))
)
(testcaochu)
  (setq sdt (sslength dt))
  (setq
  	index 0
  	tcd 0
  	)
  (repeat sdt
	(setq
  	ent (ssname dt index)
  	index (1+ index)    
  	)    
	(command "lengthen" ent "")
	(setq cd (getvar "perimeter"))
	(setq tcd (+ tcd cd))
	)
  (setq pt1 (getpoint "\nchon diem ghi chu:"))
  (command "text" "j" "mc" pt1 (rtos caochu) "0" (strcat(rtos (/ tcd 1000) 2 1) "m"))
  (princ)
  )
;;;;;;;;;;;;;;;;;;
(defun testcaochu()
  (if (not caochu1)
	(setq caochu (getdist "\nchieu cao chu? :"))
	(setq caochu (getdist (strcat "chieu cao chu <" (rtos caochu1) ">:")))
	)
  (if (= caochu nil) (setq caochu caochu1))
  (setq caochu1 caochu)
  )
  

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
pphung183    425

 

Chào cả nhà,

 

Hôm nay search topic này đúng ngay chỗ bữa giờ e lăn tăn. Chẳng là e đang dùng cái lisp TDT TCD, hjx, kể từ khi xài qua thằng Cad 16 thì TDT vẫn ok, trong khi thằng TCD lại "đơ". Bác nào fix giúp em lỗi này với nhé, thanks  :)

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/59317-nho-chi-nh-su-a-lisp-ti-nh-to-ng-die-n-ti-ch-va-chu-vi-ca-c-hi-nh/
(defun c:tdt(/ dt sdt gt tgt id pt1)
  (setq dt (ssget
  	'((-4 . "<OR")
   (0 . "CIRCLE")
   (0 . "*POLYLINE")
   (-4 . "OR>")
     	))
 )
  (setq
 sdt (sslength dt)
 id 0
 tgt 0)
(testcaochu)
  (repeat sdt
	(setq ent (ssname dt id)
   id (1+ id)
   )
	(command "area" "o" ent "")
	(setq gt (getvar "area"))
	(setq tgt (+ tgt gt))
	(princ)
	)
(setq pt1 (getpoint "\nchon diem ghi chu:"))
  (command "text" "j" "mc" pt1 (rtos caochu) "0" (strcat(rtos (/ tgt 1000000) 2 1) "m2"))
  (princ)
  )
;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:tcd(/ DT SDT TCD PT1)
  (setq dt (ssget '((-4 . "<OR")
   (0 . "CIRCLE")
   (0 . "ELLIPSE")
   (0 . "SPLINE")
   (0 . "ARC")
   (0 . "LINE")
   (0 . "*POLYLINE")
   (-4 . "OR>")
		))
)
(testcaochu)
  (setq sdt (sslength dt))
  (setq
  	index 0
  	tcd 0
  	)
  (repeat sdt
	(setq
  	ent (ssname dt index)
  	index (1+ index)    
  	)    
	(command "lengthen" ent "")
	(setq cd (getvar "perimeter"))
	(setq tcd (+ tcd cd))
	)
  (setq pt1 (getpoint "\nchon diem ghi chu:"))
  (command "text" "j" "mc" pt1 (rtos caochu) "0" (strcat(rtos (/ tcd 1000) 2 1) "m"))
  (princ)
  )
;;;;;;;;;;;;;;;;;;
(defun testcaochu()
  (if (not caochu1)
	(setq caochu (getdist "\nchieu cao chu? :"))
	(setq caochu (getdist (strcat "chieu cao chu <" (rtos caochu1) ">:")))
	)
  (if (= caochu nil) (setq caochu caochu1))
  (setq caochu1 caochu)
  )
  

Xem qua code TDT và TCD là giống nhau nhưng ở Cad2015 thì TCD bị đơ cũng lạ nhỉ? :wub:

Bạn thử thay (command "lengthen" ent "") bằng (command "area" "o" ent) xem sao :)

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
pphung183    425

Nếu đúng thế là do (command "lengthen" ...) cad 2016 thay đổi và bạn phải xem lại  cấu trúc của nó để chạy đúng lisp TCD. Nếu vẫn để

(command "area" "o" ent)  thì phải xét thêm trường hợp của Line vì Line không có diện tích nên (command "area" "o" ent) trả về Nil và khi đó kết quả sẽ sai :)

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
nguyentieu    0

Nếu đúng thế là do (command "lengthen" ...) cad 2016 thay đổi và bạn phải xem lại  cấu trúc của nó để chạy đúng lisp TCD. Nếu vẫn để

(command "area" "o" ent)  thì phải xét thêm trường hợp của Line vì Line không có diện tích nên (command "area" "o" ent) trả về Nil và khi đó kết quả sẽ sai :)

Thanks bác pphung183, để e test lại rồi báo bác. 

Sorry e hơi spam tí nhé

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
nguyentieu    0

Xem qua code TDT và TCD là giống nhau nhưng ở Cad2015 thì TCD bị đơ cũng lạ nhỉ? :wub:

Bạn thử thay (command "lengthen" ent "") bằng (command "area" "o" ent) xem sao :)

 

Tình hình là sau khi thay dòng lệnh như bác pphung183 thì ok rồi. Em cảm ơn bác nhiều nhé.

Em up lại để mọi người dùng

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/120974-nho-sua-lisp-do-tong-chieu-da-i-doi-tuong-tra-n-autocad-2015/page-2
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/59317-nho-chi-nh-su-a-lisp-ti-nh-to-ng-die-n-ti-ch-va-chu-vi-ca-c-hi-nh/
(defun c:tdt(/ dt sdt gt tgt id pt1)
  (setq dt (ssget
  	'((-4 . "<OR")
   (0 . "CIRCLE")
   (0 . "*POLYLINE")
   (-4 . "OR>")
     	))
 )
  (setq
 sdt (sslength dt)
 id 0
 tgt 0)
(testcaochu)
  (repeat sdt
	(setq ent (ssname dt id)
   id (1+ id)
   )
	(command "area" "o" ent "")
	(setq gt (getvar "area"))
	(setq tgt (+ tgt gt))
	(princ)
	)
(setq pt1 (getpoint "\nchon diem ghi chu:"))
  (command "text" "j" "mc" pt1 (rtos caochu) "0" (strcat(rtos (/ tgt 1000000) 2 1) "m2"))
  (princ)
  )
;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:tcd(/ DT SDT TCD PT1)
  (setq dt (ssget '((-4 . "<OR")
   (0 . "CIRCLE")
   (0 . "ELLIPSE")
   (0 . "SPLINE")
   (0 . "ARC")
   (0 . "LINE")
   (0 . "*POLYLINE")
   (-4 . "OR>")
		))
)
(testcaochu)
  (setq sdt (sslength dt))
  (setq
  	index 0
  	tcd 0
  	)
  (repeat sdt
	(setq
  	ent (ssname dt index)
  	index (1+ index)    
  	)    
	(command "area" "o" ent)
	(setq cd (getvar "perimeter"))
	(setq tcd (+ tcd cd))
	)
  (setq pt1 (getpoint "\nchon diem ghi chu:"))
  (command "text" "j" "mc" pt1 (rtos caochu) "0" (strcat(rtos (/ tcd 1000) 2 1) "m"))
  (princ)
  )
;;;;;;;;;;;;;;;;;;
(defun testcaochu()
  (if (not caochu1)
	(setq caochu (getdist "\nchieu cao chu? :"))
	(setq caochu (getdist (strcat "chieu cao chu <" (rtos caochu1) ">:")))
	)
  (if (= caochu nil) (setq caochu caochu1))
  (setq caochu1 caochu)

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
pphung183    425

 

Tình hình là sau khi thay dòng lệnh như bác pphung183 thì ok rồi. Em cảm ơn bác nhiều nhé.

Em up lại để mọi người dùng

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/120974-nho-sua-lisp-do-tong-chieu-da-i-doi-tuong-tra-n-autocad-2015/page-2
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/59317-nho-chi-nh-su-a-lisp-ti-nh-to-ng-die-n-ti-ch-va-chu-vi-ca-c-hi-nh/
(defun c:tdt(/ dt sdt gt tgt id pt1)
  (setq dt (ssget
  	'((-4 . "<OR")
   (0 . "CIRCLE")
   (0 . "*POLYLINE")
   (-4 . "OR>")
     	))
 )
  (setq
 sdt (sslength dt)
 id 0
 tgt 0)
(testcaochu)
  (repeat sdt
	(setq ent (ssname dt id)
   id (1+ id)
   )
	(command "area" "o" ent "")
	(setq gt (getvar "area"))
	(setq tgt (+ tgt gt))
	(princ)
	)
(setq pt1 (getpoint "\nchon diem ghi chu:"))
  (command "text" "j" "mc" pt1 (rtos caochu) "0" (strcat(rtos (/ tgt 1000000) 2 1) "m2"))
  (princ)
  )
;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:tcd(/ DT SDT TCD PT1)
  (setq dt (ssget '((-4 . "<OR")
   (0 . "CIRCLE")
   (0 . "ELLIPSE")
   (0 . "SPLINE")
   (0 . "ARC")
   (0 . "LINE")
   (0 . "*POLYLINE")
   (-4 . "OR>")
		))
)
(testcaochu)
  (setq sdt (sslength dt))
  (setq
  	index 0
  	tcd 0
  	)
  (repeat sdt
	(setq
  	ent (ssname dt index)
  	index (1+ index)    
  	)    
	(command "area" "o" ent)
	(setq cd (getvar "perimeter"))
	(setq tcd (+ tcd cd))
	)
  (setq pt1 (getpoint "\nchon diem ghi chu:"))
  (command "text" "j" "mc" pt1 (rtos caochu) "0" (strcat(rtos (/ tcd 1000) 2 1) "m"))
  (princ)
  )
;;;;;;;;;;;;;;;;;;
(defun testcaochu()
  (if (not caochu1)
	(setq caochu (getdist "\nchieu cao chu? :"))
	(setq caochu (getdist (strcat "chieu cao chu <" (rtos caochu1) ">:")))
	)
  (if (= caochu nil) (setq caochu caochu1))
  (setq caochu1 caochu)

Trời  :unsure:  !!!! Tôi bảo bạn thay (command "lengthen" ent "") bằng (command "area" "o" ent)  để biết có phải vậy không chứ không phải thay là dùng -_- .

Muốn dùng thì phải xét thêm các trường hợp không có diện tích như Line, arc chẳng hạn ...Because khi đối tượng là Line or arc thì (command "area" "o" ent)

trả về Nil và (getvar "perimeter") trả vể thông số chu vi không phải của Line or arc và kết quả sẽ sai :D

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay


×