Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Người theo dõi 0
nguyenvinh5779

Xin chỉ giúp tử mm ra meter !

Bởi nguyenvinh5779 , trong AutoLisp

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

nguyenvinh5779    7

nguyenvinh5779
Đã đăng

Xin chào cả nhà  !

Trên diễn đàn minh thay có lisp này . nhưng do nhu cầu công việc mình làm trên hệ meter

Xin chỉ giúp chổ nào chia 1000  de ra meter !

xin cám on !

;; free lisp from cadviet.com
;;; this lisp was downloaded from https://www.cadviet.com/forum/topic/60478-nhờ-chỉnh-sửađo-chiều-dài-và-ghi-ra-text/
(defun C:TLu( / ss L e #h)
(vl-load-com)
(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
(or ans (setq ans 1))
(setq
   #h 200
   L (strcat "L : "
   (vl-princ-to-string (* (getvar "dimlfac") (apply '+
       (mapcar 'Length1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))))))
   ))) "m"
   )
   ans (cond ((getint (strcat "\nPhuong an nhap ket qua < " (itoa ans) " > :")))(ans))
   txtObj (cond     ((= ans 1) (vlax-ename->vla-object (car (entsel "\nChon text ghi ket qua :"))))
                   (T (vla-addtext (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) L (vlax-3d-point (getpoint "\n Chon diem nhap ket qua" )) #h ))
           )
)
(vla-put-TextString txtObj L)
(vla-put-Height txtObj #h)
(princ)
)

  • Vote giảm 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

Doan Van Ha    3.191

Doan Van Ha
Đã đăng

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

>>

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

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

nguyenvinh5779    7

nguyenvinh5779
Đã đăng

Xin cám on bạn !

nhưng mà bị báo lỗi bạn oi !

;; free lisp from cadviet.com
;;; this lisp was downloaded from https://www.cadviet.com/forum/topic/60478-nh%E1%BB%9D-ch%E1%BB%89nh-s%E1%BB%ADa%C4%91o-chi%E1%BB%81u-d%C3%A0i-v%C3%A0-ghi-ra-text/
(defun C:fd( / ss L e #h)
(vl-load-com)
(defun Length1(e) (/ (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)) 1000))
(or ans (setq ans 1))
(setq
   #h 200
   L (strcat "L : "
   (vl-princ-to-string (* (getvar "dimlfac") (apply '+
       (mapcar 'Length1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))))))
   ))) "m"
   )
   ans (cond ((getint (strcat "\nPhuong an nhap ket qua < " (itoa ans) " > :")))(ans))
   txtObj (cond     ((= ans 1) (vlax-ename->vla-object (car (entsel "\nChon text ghi ket qua :"))))
                   (T (vla-addtext (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) L (vlax-3d-point (getpoint "\n Chon diem nhap ket qua" )) #h ))
           )
)
(vla-put-TextString txtObj L)
(vla-put-Height txtObj #h)
(princ)
)

  • Vote giảm 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

Doan Van Ha    3.191

Doan Van Ha
Đã đăng

Lỗi là do lisp bạn copy sai (thiếu con số 0). Sửa giùm bạn 


(defun C:fd( / ss L e #h)
(vl-load-com)
(defun Length1(e) (/ (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)) 1000))
(or ans (setq ans 1))
(setq
   #h 200
   L (strcat "L : "
   (vl-princ-to-string (* (getvar "dimlfac") (apply '+
       (mapcar 'Length1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))))))))) "m"))
   (setq
   ans (cond ((getint (strcat "\nPhuong an nhap ket qua < " (itoa ans) " > :")))(ans))
   txtObj (cond     ((= ans 1) (vlax-ename->vla-object (car (entsel "\nChon text ghi ket qua :"))))
                   (T (vla-addtext (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) L (vlax-3d-point (getpoint "\n Chon diem nhap ket qua" )) #h ))))
(vla-put-TextString txtObj L)
(vla-put-Height txtObj #h)
(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

nguyenvinh5779    7

nguyenvinh5779
Đã đăng

nhờ bạn giúp dùm mình lisp này !

mình muốn chiều cao chữ bang cach chọn trên màn hình !

xin cám on ban !

(defun C:fd( / ss L e #h)
(setvar 'textsize
(cond ((getdist (strcat "\nSpecify Area text height by two points on screen : ")))
((getvar 'textsize))
)
)
(vl-load-com)
(defun Length1(e) (/ (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)) 1000))
(or ans (setq ans 1))
(setq
      L (strcat "L : "
   (vl-princ-to-string (* (getvar "dimlfac") (apply '+
       (mapcar 'Length1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))))))))) "m"))
   (setq
   ans (cond ((getint (strcat "\nPhuong an nhap ket qua < " (itoa ans) " > :")))(ans))
   txtObj (cond     ((= ans 1) (vlax-ename->vla-object (car (entsel "\nChon text ghi ket qua :"))))
                   (T (vla-addtext (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) L (vlax-3d-point (getpoint "\n Chon diem nhap ket qua" )) #h ))))
(vla-put-TextString txtObj L)
(vla-put-Height txtObj #h)
(princ))

  • Vote giảm 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

huunhantvxdts    195

huunhantvxdts
Đã đăng
26 phút trước, nguyenvinh5779 đã nói:

nhờ bạn giúp dùm mình lisp này !

mình muốn chiều cao chữ bang cach chọn trên màn hình !

xin cám on ban !

(defun C:fd( / ss L e #h)
(setvar 'textsize
(cond ((getdist (strcat "\nSpecify Area text height by two points on screen : ")))
((getvar 'textsize))
)
)
(vl-load-com)
(defun Length1(e) (/ (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)) 1000))
(or ans (setq ans 1))
(setq
      L (strcat "L : "
   (vl-princ-to-string (* (getvar "dimlfac") (apply '+
       (mapcar 'Length1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))))))))) "m"))
   (setq
   ans (cond ((getint (strcat "\nPhuong an nhap ket qua < " (itoa ans) " > :")))(ans))
   txtObj (cond     ((= ans 1) (vlax-ename->vla-object (car (entsel "\nChon text ghi ket qua :"))))
                   (T (vla-addtext (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) L (vlax-3d-point (getpoint "\n Chon diem nhap ket qua" )) #h ))))
(vla-put-TextString txtObj L)
(vla-put-Height txtObj #h)
(princ))

thay phần này nhé

(setvar 'textsize
(cond ((getdist (strcat "\nSpecify Area text height by two points on screen : ")))
((getvar 'textsize))
)
)

bằng

(setq ent (car (entsel "\nChon text lay cao do")))
(setq #h (cdr (assoc 40 (entget ent))))

 

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

huunhantvxdts    195

huunhantvxdts
Đã đăng
1 phút trước, huunhantvxdts đã nói:

thay phần này nhé

(setvar 'textsize
(cond ((getdist (strcat "\nSpecify Area text height by two points on screen : ")))
((getvar 'textsize))
)
)

bằng

(setq ent (car (entsel "\nChon text lay chieu cao text")))
(setq #h (cdr (assoc 40 (entget ent))))

 

 

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

nguyenvinh5779    7

nguyenvinh5779
Đã đăng

Xin cám ơn bạn

nhưng sao không dược bạn oi !

nho bạn chỉnh giúp  !

có thể chỉnh chiều cao chữ bằng cách chọn 02 điểm trên màn hình khong ?

xin cám on ban !

(defun C:fd( / ss L e #h)
(vl-load-com)
(setq ent (car (entsel "\nChon text lay chieu cao text")))
(setq #h (cdr (assoc 40 (entget ent))))
(defun Length1(e) (/ (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)) 1000))
(or ans (setq ans 1))
(setq
   #h 200
   L (strcat "L : "
   (vl-princ-to-string (* (getvar "dimlfac") (apply '+
       (mapcar 'Length1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))))))))) "m"))
   (setq
   ans (cond ((getint (strcat "\nPhuong an nhap ket qua < " (itoa ans) " > :")))(ans))
   txtObj (cond     ((= ans 1) (vlax-ename->vla-object (car (entsel "\nChon text ghi ket qua :"))))
                   (T (vla-addtext (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) L (vlax-3d-point (getpoint "\n Chon diem nhap ket qua" )) #h ))))
(vla-put-TextString txtObj L)
(vla-put-Height txtObj #h)
(princ))

  • Vote giảm 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

7o7    79

7o7
Đã đăng

  Thớt có vẻ giả nai hơi bị lâu đó. Rõ ràng thớt biết xoá chỗ cần xoá để lisp bị lỗi, td xoá số 0 hay h# 200, hoặc thêm cái cần thêm như getvar ‘textsize .. rồi giờ lại hỏi chiều cao từ 2 điểm!!. Chắc muốn thử tài các đại cao thủ CV thôi chứ gì.

  Nhân tiện cũng xin đề nghị với admin về việc tạo nick mới. Tôi thấy nó quá dễ dãi, ai muốn tạo bao nhiêu cái cũng được, không có số đt hay email kiểm. Việc đó khiến số lượng thành viên tăng nhưng chất lượng giảm khá nhiều, mong admin xét lại cách tạo nick hiện nay.

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

nguyenvinh5779    7

nguyenvinh5779
Đã đăng

ban oi ! that sự mình khong biết gì về lisp !

Mình chỉ copy những lisp đã có rồi thêm vào thôi !

nho các anh em biet mà chỉnh giúp !

mình làm hoa vien mà  thư tài anh em làm gi

xin cam on ve tat ca anh em da giup !

xin cam on

 

 

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

huunhantvxdts    195

huunhantvxdts
Đã đăng
3 giờ trước, nguyenvinh5779 đã nói:

Xin cám ơn bạn

nhưng sao không dược bạn oi !

nho bạn chỉnh giúp  !

có thể chỉnh chiều cao chữ bằng cách chọn 02 điểm trên màn hình khong ?

xin cám on ban !

(defun C:fd( / ss L e #h)
(vl-load-com)
(setq ent (car (entsel "\nChon text lay chieu cao text")))
(setq #h (cdr (assoc 40 (entget ent))))
(defun Length1(e) (/ (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)) 1000))
(or ans (setq ans 1))
(setq
   #h 200
   L (strcat "L : "
   (vl-princ-to-string (* (getvar "dimlfac") (apply '+
       (mapcar 'Length1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))))))))) "m"))
   (setq
   ans (cond ((getint (strcat "\nPhuong an nhap ket qua < " (itoa ans) " > :")))(ans))
   txtObj (cond     ((= ans 1) (vlax-ename->vla-object (car (entsel "\nChon text ghi ket qua :"))))
                   (T (vla-addtext (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) L (vlax-3d-point (getpoint "\n Chon diem nhap ket qua" )) #h ))))
(vla-put-TextString txtObj L)
(vla-put-Height txtObj #h)
(princ))

mình thấy bạn sửa ở trên là xoa #h rồi nên mình chỉ nói thay phần trên, bạn lại thêm #h phía dưới

Sửa lại cho bạn lấy chiểu cao chữ theo chữ mẫu 

(defun C:fd( / ss L e #h)
(vl-load-com)
(setq ent (car (entsel "\nChon text lay chieu cao text")))
(setq #h (cdr (assoc 40 (entget ent))))
(defun Length1(e) (/ (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)) 1000))
(or ans (setq ans 1))
(setq
   L (strcat "L : "
   (vl-princ-to-string (* (getvar "dimlfac") (apply '+
       (mapcar 'Length1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))))))))) "m"))
   (setq
   ans (cond ((getint (strcat "\nPhuong an nhap ket qua < " (itoa ans) " > :")))(ans))
   txtObj (cond     ((= ans 1) (vlax-ename->vla-object (car (entsel "\nChon text ghi ket qua :"))))
                   (T (vla-addtext (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) L (vlax-3d-point (getpoint "\n Chon diem nhap ket qua" )) #h ))))
(vla-put-TextString txtObj L)
(vla-put-Height txtObj #h)
(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

huunhantvxdts    195

huunhantvxdts
Đã đăng
23 giờ trước, nguyenvinh5779 đã nói:

Xin cám on bạn @huunhantvxdts:

Bạn cho chỉ thêm cho mình : Mình  muốn lấy 2 số thập phân  thì phải chỉnh như thế nào !

Xin cám on ban nhieu .

Gửi bạn 

(defun C:fd( / ss L e #h tongcd ent txtObj)
(vl-load-com)
(setq ent (car (entsel "\nChon text lay chieu cao")))
(setq #h (cdr (assoc 40 (entget ent))))
(defun Length1(e) (/ (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)) 1000))
(or ans (setq ans 1))
(prompt "\nChon cac duong tính chieu dai")
(setq tongcd (apply '+ (mapcar 'Length1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))))))))
;(getvar "dimlfac")
(setq L (strcat "L : " (vl-princ-to-string (rtos (* (getvar "dimlfac") tongcd) 2 2)) "m"))
   (setq
   ans (cond ((getint (strcat "\nPhuong an nhap ket qua < " (itoa ans) " > :")))(ans))
   txtObj (cond     ((= ans 1) (vlax-ename->vla-object (car (entsel "\nChon text ghi ket qua :"))))
                   (T (vla-addtext (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) L (vlax-3d-point (getpoint "\n Chon diem nhap ket qua" )) #h ))))
(vla-put-TextString txtObj L)
(vla-put-Height txtObj #h)
(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

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  
Người theo dõi 0
Về Đầu Trang AutoLisp
×