Chuyển đến nội dung
Diễn đàn CADViet
khoind

đo SPL nhanh nhất _ HTR

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

các bác cho em hỏi

các bác cho em hỏi em có 1 đo9ạn SPL , giao của spl với các đoạn thẳng là A,B,C,D,E,Flàm sao để đo chiều dài các đoạn AB,CB,CD, EFcủa nó 1 các nhanh nhất hoặc các bác có lisp cho em cũng ddược .Thank các bác

hoicadviet.jpg

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
các bác cho em hỏi

các bác cho em hỏi em có 1 đo9ạn SPL , giao của spl với các đoạn thẳng là A,B,C,D,E,Flàm sao để đo chiều dài các đoạn AB,CB,CD, EFcủa nó 1 các nhanh nhất hoặc các bác có lisp cho em cũng ddược .Thank các bác

hoicadviet.jpg

Bạn sài thử LISP này :

Chấp nhận các đối tuợng : LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE

(defun c:len (/ *error* vl ov ob p1 p2 pa1 pa2 len)
 (defun *error* (msg)
   (if ov (mapcar 'setvar vl ov))
   (redraw ob 4)
   (if (not(wcmatch (strcase msg) "*BREAK,*EXIT*,*CANCEL*"))
     (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (vl-load-com)
 (setq vl '("CMDECHO" "OSMODE" "orthomode")
       ov (mapcar 'getvar vl))
 (mapcar 'setvar vl '(0 33 0))
 (while
   (not
     (and
(setq ob (car(entsel "\nChon doi tuong can do (LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE) : ")))
(if ob (wcmatch (cdr (assoc 0 (entget ob))) "*LINE,ARC,CIRCLE,ELLIPSE") )
)
     )
   (alert "\nDoi tuong da chon khong phu hop.
           \nChap nhan cac doi tuong : LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE
    \nChon lai :")
   )
 (redraw ob 3)
 (while (and
   (setq p1 (getpoint "\nTu diem :"))
   (setq p2 (getpoint "\nDem diem :"))
   )
   (if (and
  (setq pa1 (vlax-curve-getParamAtPoint ob p1))
  (setq pa2 (vlax-curve-getParamAtPoint ob p2))
  )
     (progn
(setq len (abs (- (vlax-curve-getdistatparam ob pa1)
		  (vlax-curve-getdistatparam ob pa2))) )
(princ (strcat "\nChieu dai la : " (rtos len) "\n-------------------"))
)
     (alert "\nDiem chon khong thuoc doi tuong can do ! \nChon lai :" )
     )
   )
 (redraw ob 4)
 (mapcar 'setvar vl ov)
 (princ)
)

  • 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
Bạn sài thử LISP này :

Chấp nhận các đối tuợng : LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE

(defun c:len (/ *error* vl ov ob p1 p2 pa1 pa2 len)
 (defun *error* (msg)
   (if ov (mapcar 'setvar vl ov))
   (redraw ob 4)
   (if (not(wcmatch (strcase msg) "*BREAK,*EXIT*,*CANCEL*"))
     (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (vl-load-com)
 (setq vl '("CMDECHO" "OSMODE" "orthomode")
       ov (mapcar 'getvar vl))
 (mapcar 'setvar vl '(0 33 0))
 (while
   (not
     (and
(setq ob (car(entsel "\nChon doi tuong can do (LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE) : ")))
(if ob (wcmatch (cdr (assoc 0 (entget ob))) "*LINE,ARC,CIRCLE") )
)
     )
   (alert "\nDoi tuong da chon khong phu hop.
           \nChap nhan cac doi tuong : LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE
    \nChon lai :")
   )
 (redraw ob 3)
 (while (and
   (setq p1 (getpoint "\nTu diem :"))
   (setq p2 (getpoint "\nDem diem :"))
   )
   (if (and
  (setq pa1 (vlax-curve-getParamAtPoint ob p1))
  (setq pa2 (vlax-curve-getParamAtPoint ob p2))
  )
     (progn
(setq len (abs (- (vlax-curve-getdistatparam ob pa1)
		  (vlax-curve-getdistatparam ob pa2))) )
(princ (strcat "\nChieu dai la : " (rtos len) "\n-------------------"))
)
     (alert "\nDiem chon khong thuoc doi tuong can do ! \nChon lai :" )
     )
   )
 (redraw ob 4)
 (mapcar 'setvar vl ov)
 (princ)
)

Lisp sử dụng tốt rồi, nhưng có thể linh hoạt hơn tý nữa thì tốt quá

Cụ thể như: gia_bach thêm vào như sau

- Đo tổng chiều dài của các đoạn thẳng khi kết thúc đo từng đoạn (có thể ghi chiều dài ra màn hình luôn thì OK)

VD: Đoạn AB=5, CD=10, DE=15 => Tổng = 30 và ghi ra màn hình Tổng = 30

(lưu ý thêm: khi chỉ có 1 đoạn thẳng thì tổng chiều dài bằng chiều dài của đoạn thẳng đó)

Cảm ơn gia_bach

  • 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
Lisp sử dụng tốt rồi, nhưng có thể linh hoạt hơn tý nữa thì tốt quá

Cụ thể như: gia_bach thêm vào như sau

- Đo tổng chiều dài của các đoạn thẳng khi kết thúc đo từng đoạn (có thể ghi chiều dài ra màn hình luôn thì OK)

VD: Đoạn AB=5, CD=10, DE=15 => Tổng = 30 và ghi ra màn hình Tổng = 30

(lưu ý thêm: khi chỉ có 1 đoạn thẳng thì tổng chiều dài bằng chiều dài của đoạn thẳng đó)

Cảm ơn gia_bach

Bổ sung tùy chọn xuất Text : ghi Text cho từng đoạn - Chỉ ghi Text tổng - Không ghi Text .

(defun c:len (/ *error* vl ov ob p1 p2 pa1 pa2 len txt_opt total_len)
 (defun *error* (msg)
   (if ov (mapcar 'setvar vl ov))
   (if ob (redraw ob 4))
   (if (not(wcmatch (strcase msg) "*BREAK,*EXIT*,*CANCEL*"))
     (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (defun put_txt (txt / pt)
   (if (setq pt (getpoint "\nDiem dat Text..."))
     (entmake (list '(0 . "TEXT")
                (cons 10 pt)
                (cons 40 (* (getvar "dimtxt")(getvar "dimscale")))
                (cons 1 txt)
                (cons 7 (getvar "TEXTSTYLE"))
                '(71 . 0)
                (cons 72 0)
                '(73 . 1)
                (cons 11 pt))))
   )

 (vl-load-com)
 (setq vl '("CMDECHO" "OSMODE" "orthomode")
       ov (mapcar 'getvar vl))
 (mapcar 'setvar vl '(0 33 0))    
 (while
   (not
     (and
(setq ob (car(entsel "\nChon doi tuong can do (LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE) : ")))
(if ob (wcmatch (cdr (assoc 0 (entget ob))) "*LINE,ARC,CIRCLE,ELLIPSE") )
)
     )
   (alert "\nDoi tuong da chon khong phu hop.
           \nChap nhan cac doi tuong : LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE
    \nChon lai :")
   )
 (redraw ob 3)
 (or *txt_opt* (setq *txt_opt* "None"))
 (initget "Each Total None" )
 (setq txt_opt (getkword (strcat "\nCach ghi Text : [Each/Total/None]. <" *txt_opt* ">"))
total_len 0)
 (if (= txt_opt "")(setq txt_opt *txt_opt*)(setq *txt_opt* txt_opt))
 (while (and
   (setq p1 (getpoint "\nTu diem :"))
   (setq p2 (getpoint "\nDem diem :"))
   )
   (if (and
  (setq pa1 (vlax-curve-getParamAtPoint ob p1))
  (setq pa2 (vlax-curve-getParamAtPoint ob p2))
  )
     (progn
(setq len (abs (- (vlax-curve-getdistatparam ob pa1)
		  (vlax-curve-getdistatparam ob pa2))) )
(setq total_len (+ len total_len))
(princ (strcat "\nChieu dai = " (rtos len) "  Tong chieu dai = " (rtos total_len)))
(if (= txt_opt "Each")
  (put_txt (rtos len)) )
)
     (alert "\nDiem chon khong thuoc doi tuong can do ! \nChon lai :" )
     )
   )
 (if (member txt_opt '("Each" "Total"))
   (put_txt (strcat "Tong = " (rtos total_len))) )
 (redraw ob 4)
 (mapcar 'setvar vl ov)
 (princ)
)

  • Vote tăng 4

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

thanhk 2 pro giabach ,hoangson614 để em thử xem thế nào đã . Em còn1 câu hỏi nũa mong pro gíp em : em đang ghi text thì font chữ bị đảo lung tung Vd : em viết vntime.shx khi viết được 1 đoạn thì nó nhaỷ sang font khác

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

×