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

lephuocly

Thành viên
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    24

  • Đã tham gia

  • Lần ghé thăm cuối

Bài đăng được đăng bởi lephuocly

  2. Đã đăng · Trả lời báo cáo

    Vào lúc 26/12/2011 tại 14:48, Tue_NV đã nói:

    Tue_NV là nick của Võ Quang Tuệ. Võ Quang Tuệ lập ra nick Tue_NV .. hề hề

    Yêu cầu của bạn đây :

      

    


(defun C:TL3( / ss L te p1 p2 hei P)
(while (and (setq p1 (getpoint "\n Chon diem thu nhat :"))
(setq p2 (getpoint p1 "\n Chon diem thu hai :"))
)
(setq L (distance p1 p2))
(initget "T")
(setq p (getpoint "\nPick diem chen hoac go T de chon Text :"))

(if (/= p "T")
 (progn
   (if (not hei) (setq hei (getreal "\nNhap chieu cao Text:")))
   (entmake (list (cons 0 "TEXT") (cons 1 (rtos L 2 2)) (cons 40 hei)
 (cons 10 p) (cons 11 p)))
 )
 (progn
 (setq te (entget(car("\n Chon Text de gan ket qua :")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te)
 )
)
)
)
     

     

    Bạn chú ý : Text trong trường hợp mà bạn pick chọn lấy theo Style hiện hành

    Tue_NV đã lập ra 2 trường hợp :

    Bạn thích pick vào Text thì gõ T

    thích chọn điểm chèn cho Text thì pick chọn điểm chèn cho Text

     

    Đúng ý rồi nhé

    Cảm ơn anh !

    Tôi có việc cần sự giúp đỡ của anh(càng nhanh càng tốt) như sau:

    Tương tự như lisp trên của anh nhưng thỏa mãn thêm điều kiện sau: 

    Khi pick điểm A tới B thì kết quả là số dương, ngược lại pick B tới A thì cho kết quả âm.

  3. Lisp

    trong AutoLisp

    Đã đăng · Trả lời báo cáo

    9 giờ trước, duy782006 đã nói:

    Nét nhỏ thì sửa.          "pline" diem  PT1 PT3 ""

    thành         "pline" diem  "w" "0.00" "0.00" PT1 PT3 ""

    là xong. Vị trí tự chọn là vị trí gì?

    Cảm ơn bạn ! 

    Vị trí tự chọn là vị trí mình xuất giá trị tọa độ ấy.

  12. Lisp

    trong AutoLisp

    Đã đăng · Trả lời báo cáo

    13 phút trước, DuongTrungHuy đã nói:

    Chào!

    Mình có chỉnh sửa 1 chút. Bạn thử xem sao nhé.

     

    (defun C:ae(/ N SS1 NUM EN CO)
      (if (not "acadapp.exp") (xload "acadapp.exp"))
      (setq N 0 co (getvar 'cecolor) SS1 (ssadd))
      (command "layer" "s" DiTi "")
      (setq PT1 (getpoint "\n Chon diem trong vung can tinh dien tich:") inra pt1)
      (command "BPOLY" PT1 "")
      (setq SS1 (ssadd (entlast) SS1) NUM (sslength SS1))
      (command ".area" "a" "e")
      (while (/= NUM N) (setq EN (ssname SS1 N)) (command EN)(setq N (1+ N)))
      (command "" "") (command "redraw")
      (setq SS nil) (prin1)
      (setq val (* 1 (getvar "area")))
      (princ "Gia tri la : ") (princ val)
      (prin1) (setvar 'cecolor "1")
      ;(command "TEXT" (getpoint)  "" "" (rtos val 2 2))
      (command "TEXT" pt1 0.2 (rtos val 2 2))
      (setvar 'cecolor co) (princ)
    )

    Cảm ơn bạn ! Nhưng cái này xử lý sao đây, mình mù về công nghệ. Hay nói khác đi là làm sao chuyển về *.lsp

  14. Lisp

    trong AutoLisp

    Đã đăng · Trả lời báo cáo

    2 giờ trước, duy782006 đã nói:

    Bạn đổi textstyle hiện hành thành cái khác standard (các textstyle có height là 0.00) mà chạy được thì là tôi đoán đúng chỉ cần sửa 1 dòng là xong. Do cad tôi có nhiều lisp chỉnh thông số mặc định nên file cad và lisp của bạn tôi dùng thử vẫn được.

    Đổi textstyle có height =0 thì chạy được Pro ơi !

    Giúp minh với. Mình mù về công nghệ(sinh năm 1967). Cảm ơn nhiều !

  20. Đã đăng · Trả lời báo cáo

    Vào lúc 18/3/2012 tại 10:49, Doan Van Ha đã nói:

    @cocobubu: lần sau post bài nhớ đọc kỹ nội quy kẻo bị đưa qua tạm trú ở thùng rác thì khổ.

    Code nhanh cho bạn đây:

      

    
(defun C:HA( / y0 y1 ent)
(command "ucs" "w")
(setq y0 (cadr (cdr (assoc 10 (entget (car (entsel "\nChon Line de lam duong chuan: ")))))))
(while
 (and
  (setq y1 (cadr (getpoint "\nPick diem de lay cao do: ")))
  (setq ent (car (entsel "\nChon Text de sua cao do: ")))
  (entmod (subst (cons 1 (rtos (- y1 y0) 2 2)) (assoc 1 (entget ent)) (entget ent)))))
(princ))
     

     

     

    Vào lúc 18/3/2012 tại 10:49, Doan Van Ha đã nói:

    @cocobubu: lần sau post bài nhớ đọc kỹ nội quy kẻo bị đưa qua tạm trú ở thùng rác thì khổ.

    Code nhanh cho bạn đây:

      

    
(defun C:HA( / y0 y1 ent)
(command "ucs" "w")
(setq y0 (cadr (cdr (assoc 10 (entget (car (entsel "\nChon Line de lam duong chuan: ")))))))
(while
 (and
  (setq y1 (cadr (getpoint "\nPick diem de lay cao do: ")))
  (setq ent (car (entsel "\nChon Text de sua cao do: ")))
  (entmod (subst (cons 1 (rtos (- y1 y0) 2 2)) (assoc 1 (entget ent)) (entget ent)))))
(princ))
     

     

    Hình như chưa đúng bạn ơi ! Đó là khoảng cách từ điểm chọn tới đường chuẩn. Bạn viết lại giúp đi .

    • Vote giảm 1

  21. Lisp

    trong AutoLisp

    Đã đăng · Trả lời báo cáo

    Mình tìm được cái lisp tính diện tích trên diễn đàn như sau(file đính kèm).

    Mình muốn các Pro sửa dùm một tý cho phù hợp cho phù hợp với ý muốn:

    1. Diện tích xuất ra có MÀU ĐỎ

    2. Vị tri xuất diện tích theo chỉ điểm(pick).

    Cảm ơn các Pro nhiều !

    AREA_ae.LSP

    • Vote giảm 1

  22. Đã đăng · Trả lời báo cáo

    Vào lúc 11/6/2007 tại 12:04, Nguyen Hoanh đã nói:

    Theo đúng yêu cầu, bạn thử xem nhé!

    lệnh là DTM (diện tích miền)

      

    
(defun c:dtm()
 (defun ctext (diem gt / lst)    
   (setq lst
   (list
     (cons 0 "TEXT")
     (cons 1 gt)
     (cons 10 diem)
     (cons 40 (getdist p "\nChieu cao chu: "))
   )
   )
   (entmake lst)
 )
 (defun dtdoituong (entdt /)
   (command ".area" "o" entdt)
   (command ".erase" entdt "")
   (getvar "area")
 )
 (defun getbound(p)
   (setq ent (entlast))
   (command ".boundary" "A" "B" "E" "I" "Y" "" p "")
   (setq ent1 (entlast))
   (cond
     ((eq ent ent1) nil)
     (t ent1)
   )
 )
 (setq
   p (getpoint "\nVao diem can tinh dien tich: ")
   entpl (getbound p)	
 )
 (if entpl
   (ctext p (rtos (dtdoituong entpl)))
   (alert "Diem ban chon khong kin!")
 )
 (princ)
)
     

     

     

    Lisp trên rất cơ bản, chỉ tính đúng với các miền không có "lỗ thủng".

    Không được bác ơi ! nó báo miền không kín, mặc dù tôi vẽ dùng thử co hình tròn. Bác xem lại dùm 

    • Vote giảm 1

  23. Đã đăng · Trả lời báo cáo

    Quick code lại :

    (defun C:TL( / 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 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))))))    )))    )    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))

    Cảm ơn bạn ! Nhưng mà sao xuất ra Text lớn thế, không chỉnh được. Bạn viết dùm hộ đi

    • Vote giảm 1
×