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

danhgapro

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

  • Số lượng nội dung

    39

  • Đã tham gia

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

  • Ngày trúng

    1

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

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

     

    Cái lisp này viết lâu rồi, chắc vẫn còn xài được. Cad phải có cài Express.

    (defun c:dtc (/ v0 el en l tong oe nd)
  (setq oe (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (command "undo" "be")
  
  (setq v0 (car (entsel "\nChon text de tinh dien tich:"))
nd (cdr (assoc 1 (entget v0))))
  (command "copy" v0 "" "" "")  
  (setq el (entlast)
l nil)
  (sssetfirst nil (ssadd v0 (ssadd)))
  (C:Txtexp)
  
  (setq tong 0)
  (while (setq en (entnext el)) (setq l (cons en l) el en))
  (foreach v (vl-remove-if-not '(lambda(x) (= "POLYLINE" (cdr (assoc 0 (entget x))))) l)
    (setq tong (+ tong (vla-get-Area (vlax-ename->vla-object v))))
    (entdel v))
  
  (command "undo" "e")  
  (setvar 'cmdecho oe)
  (princ (strcat "\nDien tich cua chu \"" nd "\" la: " (rtos tong))) (textscr) (princ)
)

    Bạn kiểm tra lại giúp mình, mình dùng lisp tính thử với bo nét chữ không đúng. (đã cài Express).

    Bài toán là: mình cần tính diện tích sơn, in chữ biển báo, VD "ĐI CHẬM", mình tính diện tích chữ Đ, I, C.....

    Cảm ơn bạn. 

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

    Chào anh em cadviet. Mình có 2 vấn đề sau nhờ anh em  giúp.

     

    1)  Mình có 1 text / mtext là số  "1052.85"; "45.8" ..... Mình cần chèn trước hoặc sau: "233+1052.85"; "45.8 mét"... nhờ các bạn viết dùm mình lisp chèn "233+", "mét" ... với.

     

    2) Mình có lisp "++", "--" thay thế này nhưng lisp "--" có thể thao tác liên tục được, nhưng lisp "++" mỗi lần dùng lại phải gõ lại lệnh "++" rất phiền. Nhờ các bạn chỉnh dùm mình.

     

    http://www.cadviet.com/upfiles/3/86607_list_.lsp

     

    Năm mới chúc toàn thể anh em cadviet sức khỏe, thành công trong sự nghiệp.

     

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

    Do tính chất công việc cũng như muốn cài đặt lại mà khi không có phần mềm cũng như không mất thời gian ....(khi bị chỉnh sữa lung tung; không phải cài lại máy ...)

    Các bác, các anh, các chị cho mình hỏi muốn khôi phục mặc định như lúc mới cài các phần mềm như:

     

    Cad

    Excel

    Word

     

    thì làm như thế nào, cảm ơn anh em nhiều.

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

    Hề hề hề,

    Phải chăng bạn ấy muốn cái như thế này:

    ;; free lisp from cadviet.com : ketxu update from @Tue_NV
(defun c:shbv(/ dau tong po po1 ent i pre sotong en en1)
(command "undo" "be")
(prompt "\n Danh so hieu ban ve dang n/m ")
(setvar "cmdecho" 0)
(setq pre "< KC, CN KT>: ")
(wtxt pre '(0 0 0))
(command "ddedit" (entlast) "") 
(setq pre (cdr(assoc 1 (entget(entlast)))))
;(setq pre (strcat pre ": "))
(entdel (entlast))
(setq dau (getint "\n Danh so bat dau (n):"))
(setq tong (getint "\n Danh so tong (m):") i 1)
(if (< tong 10) (setq sotong (strcat "0" (itoa tong))) (setq sotong (itoa tong))) 
(setq po (cdr (assoc 11 (entget (car (setq en (entsel 
        (strcat "\n Hay chon text can thay the boi " pre (if (< dau 10) (strcat "0" (itoa dau)) (itoa dau)) "/" sotong))))))))
;;;;(getpoint (strcat "\n Cho diem chen cua so: " (if (< dau 10) (strcat pre "0" (itoa dau)) (itoa dau)) "/" sotong)))
(command "erase" en "")
(wtxt (strcat pre (if (< dau 10) (strcat "0" (itoa dau)) (itoa dau)) "/" sotong) po)

(Repeat (- tong dau)
(setq po1 (cdr (assoc 11 (entget (car (setq en1 (entsel 
          (strcat "\n Hay chon text can thay the boi " pre (if (< (+ dau i) 10) (strcat "0" (itoa (+ dau i))) (itoa (+ dau i))) "/" sotong))))))))
;;;(getpoint po (strcat "\n Cho diem chen cua so: " (if (< (+ dau i) 10) (strcat pre "0" (itoa (+ dau i))) (itoa (+ dau i))) "/" sotong)))
(command "erase" en1 "")
(command "copy" "L" "" po po1) 
(setq ent (entget(entlast)))
(setq ent 
(subst 
(cons 1 (strcat pre (if (< (+ dau i) 10) (strcat "0" (itoa (+ dau i))) (itoa (+ dau i))) "/" sotong)) (assoc 1 ent) ent))
(entmod ent)
(setq i (1+ i))
(setq po po1)
)
(command "undo" "e")
(princ)
)
;
(defun wtxt(txt p / sty d h1 h2 wf h) ;;;Write txt on graphic screen at p
(setq    sty (getvar "textstyle")    
d (tblsearch "style" sty)    
h1 (cdr (assoc 40 d))    
h2 (cdr (assoc 42 d))    
wf (cdr (assoc 41 d)))
(if (> h1 0) (setq h h1) (setq h h2))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 40 h) (cons 41 wf)(cons 72 4)(cons 11 p) (cons 1 txt) (cons 10 p))))

     

    @Bác Tue_NV và Ketxu: Mạn phép sửa lại tí chút cái lisp của các bác cái chổ :

    (wtxt (strcat (if (< dau 10) (strcat pre "0" (itoa dau)) (itoa dau)) "/" sotong) po)

    Có nhẽ phải là:

    (wtxt (strcat pre (if (< dau 10) (strcat "0" (itoa dau)) (itoa dau)) "/" sotong) po)

    mới đúng ạ.

     

     

    Rất cảm ơn 2 bạn đã hiểu đúng ý mình :D.

    Không biết có phải tại máy mình không???, khi kick vào text có sẵn thì text mới bị nhảy lung tung và dồn lại 1 cục...

    Nhờ bạn kiểm tra lại dùm.

    Cảm ơn nhiều nhiều.

×