Mình cần giúp sửa file lisp

[martin 4]

2 file lisp này tìm được từ forum, 

bạn nào giúp mình sửa lại file lisp  khi in ra dữ liệu chính xác đến 8 chữ số thập phân, trong file này chỉ xuất ra số có 4 chữ số thập phân thôi.

Thêm cả tl.lisp cho xuất ra dữ liệu txt được không?

Cảm ơn

 

 

http://www.cadviet.com/upfiles/3/30445_btk_2.lsp

 

http://www.cadviet.com/upfiles/3/30445_tl_1.lsp

 

Similar topics from web:
Bộ lisp autocad đầy đủ cho dân thiết kế mảng xây dựng. Tất cả trong ...
Tạo menu trên AutoCAD bằng VBA + AutoLisp
Chia sẻ Bộ Lisp rất hay: ”Kho báu của Minh” [Lưu Trữ]
Mình có 1 lisp vẽ nút, help cách dùng!
VBA trong Autocad [Lưu Trữ]
Lisp Cad hỗ trợ trong thiết kế | Lisp Cad ho tro trong thiet ke
Nhờ các bạn sửa giúp lisp nội suy cao độ từ 3 điểm [Lưu Trữ]
Tiện ích nhỏ xuất khối lượng trắc ngang từ file trắc ngang của Nova ...
Thư viện Autolisp
Sử dụng AutoLisp trong AutoCad
Kinh ngiệm dùng CAD và LISP
[TC3] Bộ lisp dùng cho Thuỷ lợi
Mẹo vặt trong CAD

[martin 4]

Bác nào giúp mình định nghĩa lại 2 cái lisp trên với. Làm cách nào cho nó xuất ra data chính xác đến 8 chữ số sau dấu phẩy?

[phongtran86 39]

Có vẻ mọi người ngại xem nội dung lisp là gì nên ko giúp :D. Mình cũng ko am hiểu lắm nên ko giúp dc

[phongtran86 39]

(rtos number [mode [precision]])

GIẢI THÍCH:

number : Là một số

mode: Là mã điều khiển dạng xuất ra chuỗi ký tự

Mode nhận các giá trị sau:

1 : Dạng khoa học

2 : Dạng thập phân

3 : Dạng kỹ thuật

4 : Dạng kiến trúc

5 : Dạng hữu tỷ (phân số)

precision : Là độ chính xác (số chữ số sau dấu phảy thập phân)

Bạn tìm dòng 2t (lambda(x)(rtos x 2 4)) chỉnh 4 thành 8 là ok nhé :D

[martin 4]

Sao bài viết nó không hiện code lên tab mà chỉ hiên link thế nhỉ? Kỳ quặc.

[martin 4]

Code đây các bác, làm cách nào cho chính xác đến 8 chữ số sau dấu phẩy và in ra file txt. Cảm ơn.

 

 

;; free lisp from cadviet.com

;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/9681-lisp-ghi-chieu-dai-doan-thang-theo-scale-factor-cua-dimstyle-hien-thoi/

(defun C:TL( / Length1 SSdelete MakePoint GET-M2P MakeText

HT I K LST LST1 LSTL LSTP OSMLAST OTHLAST PT PT0 PT1 SS SSMOVE SSNX SSP TBSS)

(vl-load-com)

(defun MakeText (point string Height Ang justify Style Layer Color xdata / Lst); Ang: Radial

(setq Lst (list '(0 . "TEXT")

(cons 8 (if Layer Layer (getvar "Clayer")))

(cons 62 (if Color Color 256))

(cons 10 point)

(cons 40 Height)

(cons 1 string)

(if Ang (cons 50 Ang))

(cons 7 (if Style Style (getvar "Textstyle")))

(cons -3 (if xdata (list xdata) nil)))

justify (strcase justify))

(cond ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))

((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))

((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))

((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))))

((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))))

((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))))

((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))))

((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))))

((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))))

((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))))

((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))))

((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1))))))

(entmakex Lst))

(defun SSdelete (SS / ) (setq SS (acet-ss-to-list SS))(foreach SSN SS (entdel SSN)))

(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))

(defun GET-M2P (PT1 PT2) (polar PT1 (angle PT1 PT2) (* 0.5 (distance PT1 PT2))));end

(defun MakePoint (point layer color)

(entmakex (list '(0 . "POINT")'(100 . "AcDbEntity")

(cons 8 (if Layer Layer (getvar "Clayer")))

(cons 62 (if Color Color 256))

'(100 . "AcDbPoint")(cons 10 point))))

(setq lst '() lst1 '() lstL '() k (getvar "dimlfac") ssmove (ssadd))

(setq ss (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE"))) i 0)

(repeat (sslength ss)

(if (= 1 (car (setq ssnx (car(ssnamex ss i)))))

(if lst1(progn

(setq ssp (ssadd))

(foreach ssn lst1 (setq ssp(ssadd(MakePoint(get-m2p(car(setq lstp(ACET-GEOM-EXTENTS ssn)))(cadr lstp))nil 250)ssp)))

(setq tbss (ACET-GEOM-SS-EXTENTS-FAST ssp))(ssdelete ssp)

(if (>(abs(-(car(car tbss))(car(cadr tbss))))(abs(-(cadr(car tbss))(cadr(cadr tbss)))))

(setq lst1 (vl-sort lst1 '(lambda (e1 e2)

(< (car (get-m2p(car(setq lstp(ACET-GEOM-EXTENTS e1)))(cadr lstp)))

(car (get-m2p(car(setq lstp(ACET-GEOM-EXTENTS e2)))(cadr lstp))))))) ;;; hang

(setq lst1 (vl-sort lst1 '(lambda (e1 e2)

(> (cadr(get-m2p(car(setq lstp(ACET-GEOM-EXTENTS e1)))(cadr lstp)))

(cadr(get-m2p(car(setq lstp(ACET-GEOM-EXTENTS e2)))(cadr lstp)))))))) ;;; cot

(setq lst (append (list (cadr ssnx)) lst1) lst1 '()))

(setq lst (append (list (cadr ssnx)) lst)))

(setq lst1 (append (list (cadr ssnx)) lst1)))

(setq i (1+ i)))

(if lst1 (progn

(setq ssp (ssadd))

(foreach ssn lst1 (setq ssp(ssadd(MakePoint(get-m2p(car(setq lstp(ACET-GEOM-EXTENTS ssn)))(cadr lstp))nil 250)ssp)))

(setq tbss (ACET-GEOM-SS-EXTENTS-FAST ssp))(ssdelete ssp)

(if (>(abs(-(car(car tbss))(car(cadr tbss))))(abs(-(cadr(car tbss))(cadr(cadr tbss)))))

(setq lst1 (vl-sort lst1 '(lambda (e1 e2)

(> (car (get-m2p(car(setq lstp(ACET-GEOM-EXTENTS e1)))(cadr lstp)))

(car (get-m2p(car(setq lstp(ACET-GEOM-EXTENTS e2)))(cadr lstp))))))) ;;; hang

(setq lst1 (vl-sort lst1 '(lambda (e1 e2)

(< (cadr(get-m2p(car(setq lstp(ACET-GEOM-EXTENTS e1)))(cadr lstp)))

(cadr(get-m2p(car(setq lstp(ACET-GEOM-EXTENTS e2)))(cadr lstp)))))))))) ;;; cot

(if (setq lst(append lst1 lst)) (progn

(setq ht (getreal "nhap chieu cao text: ") pt (cadr (grread 't 15 0)) pt0 pt i 0)

(foreach ll (reverse lst)

(setq ssmove (ssadd (maketext pt (itoa(setq i (1+ i))) ht 0 "C" nil nil nil nil) ssmove)

ssmove (ssadd (maketext (polar pt 0 (* 5 ht)) (rtos (* k(length1 ll)) 2 3) ht 0 "R" nil nil nil nil) ssmove)

pt (list (car pt) (- (cadr pt) (* 1.5 ht)))))

(acet-ss-redraw ssmove 2)

(setq OTHLAST (getvar "orthomode")) (setvar "orthomode" 0)

(if (setq pt1 (acet-ss-drag-move ssmove pt0 "\nChon diem dat bang"))

(progn (vl-cmdf "move" ssmove "" pt0 pt1) (setvar "orthomode" OTHLAST))

(ssdelete ssmove))))

(print "free lisp from cadviet.com") (princ))

[tien2005 242]

mình ko co autocad nen chua thử được

Bạn tìm dòng "(rtos (* k(length1 ll)) 2 3)" rồi thay số 3 (3 số lẻ thập phân) bằng số 8 theo như ý bạn