Đến nội dung


Hình ảnh
- - - - -

[Nhờ Sửa Lisp] Sửa Lisp Để Tương Thích Với Autocad Đời


  • Please log in to reply
2 replies to this topic

#1 thanh_kta

thanh_kta

    biết pan

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

Đã gửi 09 July 2016 - 09:32 PM

Chào các bác!
Em có tải 1 lisp đo khoảng cách của line,pline... sau đó xuất ra text từ diễn đàn mình, nhưng nó chỉ chạy được trên autocad 2007 nên em muốn nhờ mọi người giúp sửa lại để có thể chạy được trên các phiên bản autocad đời cao hơn.
Em xin cảm ơn!
http://www.cadviet.c...lineplinegc.lsp

;; 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 Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
;;;--------------------------------------------------------------------
(defun C:GC( / ss L e)
(setq
ss (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))
L 0.0
k (getvar "dimlfac")
)

(vl-load-com)
(while (setq e (ssname ss 0))
(setq L (* k (length1 e)))
(setq ans (getstring "\n Ban hay chon phuong an nhap ket qua "))
(if (= ans "1")
(progn
(setq te (entget(car(entsel "\n Chon Text de gan ket qua :")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te)
)
(progn
(setq p (getpoint "\n Chon diem nhap ket qua" ))
(setq h (getreal "\n Nhap chieu cao text ket qua "))
(command "text" p h "0" (strcat "D-L" (rtos L 2 1) " "))
)
)
(ssdel e ss)
)
(princ)
)
;;;--------------------------------------------------------------------

  • 0

#2 Tot77

Tot77

    biết lệnh adcenter

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

Đã gửi 10 July 2016 - 10:22 AM

Chạy trên 2014 vẫn tốt, nhưng nếu có sửa thì thêm như sau:

(defun Length1 (e)
(vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))
)
 
(defun C:GC (/ ss L e)
(setq ss (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE" )))
L  0.0
k  (getvar "dimlfac")
)
 
(vl-load-com)
(while (setq e (ssname ss 0))
(setq L (* k (length1 e)))
(setq ans (getstring "\n Ban hay chon phuong an nhap ket qua <1-Text co san / 2-Text moi>: "))
(if (= ans "1")
(progn
(setq te (entget (car (entsel "\n Chon Text de gan ket qua: ")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te)
)
(entmod te)
)
(progn
(setq p (getpoint "\n Chon diem nhap ket qua: "))
(setq h (getreal "\n Nhap chieu cao text ket qua: "))
(entmake (list (cons 0 "TEXT") (cons 10 p) (cons 11 p) (cons 40 h) 
(cons 7 (getvar 'textstyle)) (cons 1 (strcat "D-L" (rtos L 2 1) " "))))
;;; (command "text" p h "0" (strcat "D-L" (rtos L 2 1) " "))
)
)
(ssdel e ss)
)
(princ)
)
 

  • 1

#3 thanh_kta

thanh_kta

    biết pan

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

Đã gửi 10 July 2016 - 11:32 AM

 

Chạy trên 2014 vẫn tốt, nhưng nếu có sửa thì thêm như sau:

(defun Length1 (e)
(vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))
)
 
(defun C:GC (/ ss L e)
(setq ss (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE" )))
L  0.0
k  (getvar "dimlfac")
)
 
(vl-load-com)
(while (setq e (ssname ss 0))
(setq L (* k (length1 e)))
(setq ans (getstring "\n Ban hay chon phuong an nhap ket qua <1-Text co san / 2-Text moi>: "))
(if (= ans "1")
(progn
(setq te (entget (car (entsel "\n Chon Text de gan ket qua: ")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te)
)
(entmod te)
)
(progn
(setq p (getpoint "\n Chon diem nhap ket qua: "))
(setq h (getreal "\n Nhap chieu cao text ket qua: "))
(entmake (list (cons 0 "TEXT") (cons 10 p) (cons 11 p) (cons 40 h) 
(cons 7 (getvar 'textstyle)) (cons 1 (strcat "D-L" (rtos L 2 1) " "))))
;;; (command "text" p h "0" (strcat "D-L" (rtos L 2 1) " "))
)
)
(ssdel e ss)
)
(princ)
)
 

Cảm ơn bác, em thử lại thì đúng là file cũ có chạy được trên cad 2014, trước load vào chạy mà không được. Xin lỗi đã làm phiền mọi người!


  • 0