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.
Đăng nhập để thực hiện theo  
martin

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

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

martin    4
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?

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
phongtran86    21

(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

  • Vote tăng 1

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

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
tien2005    97

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

  • Vote tăng 1

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

Đăng nhập để thực hiện theo  

×