Đến nội dung


Hình ảnh

đo SPL nhanh nhất _ HTR


  • Please log in to reply
4 replies to this topic

#1 khoind

khoind

    biết vẽ line

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

Đã gửi 22 September 2009 - 02:21 PM

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
Hình đã gửi
  • 0

#2 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1435 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 23 September 2009 - 11:22 AM

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
Hình đã gửi

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

  • 1

#3 HoangSon614

HoangSon614

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 254 Bài viết
Điểm đánh giá: 66 (tàm tạm)

Đã gửi 23 September 2009 - 11:52 AM

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
  • 1

#4 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1435 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 23 September 2009 - 04:01 PM

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

  • 4

#5 khoind

khoind

    biết vẽ line

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

Đã gửi 26 September 2009 - 07:23 AM

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
  • 0