Jump to content
InfoFile
Tác giả: 790312
Bài viết gốc: 114614
Tên lệnh: od oc oca
có list nào copy tăng dần với block ATT ko?

Bạn dùng thử lisp này. Ssg đã post lên diễn đàn lâu lắm rồi. Riêng phần Att mới bổ sung theo gợi ý của bạn:

 

>>
Bạn dùng thử lisp này. Ssg đã post lên diễn đàn lâu lắm rồi. Riêng phần Att mới bổ sung theo gợi ý của bạn:

 

;;;**********************************************
;;;CHUONG TRINH DANH SO THU TU VA COPY TANG DAN
;;;1. Lenh OD: danh so thu tu, tuy chon so bat dau (begin) va so gia (increment) tuy y
;;;2. Lenh OC: copy tang dan tu mot so thu tu co san
;;;3. Lenh OCA: copy tang dan voi doi tuong Attribute Block
;;;Chuong trinh chap nhan cac dinh dang bang so, chu, so va chu ket hop:
;;;1, 2... A, B..., A1, A2..., AB-01, AB-02..., AB-01-C1, AB-01-C2...
;;;Cac chu gioi han trong khoang tu A den Z. Cac so khong han che
;;;Copyright by ssg - www.cadviet.com - December 2008
;;;**********************************************
;;;-------------------------------------------------
(defun etype (e) ;;;Entity Type
(cdr (assoc 0 (entget e)))
)
;;;-------------------------------------------------
(defun wtxt (txt p / sty d h) ;;;Write txt on graphic screen, defaul setting
(setq
   sty (getvar "textstyle")
   d (tblsearch "style" sty)
   h (cdr (assoc 40 d))
)
(if (= h 0) (setq h (cdr (assoc 42 d))))
(entmake
   (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 40 h) (assoc 41 d))
)
)
;;;-------------------------------------------------
(defun incN (n dn / n2 i n1) ;;;Increase number n
(setq
   n2 (itoa (+ dn (atoi n)))
   i (- (strlen n) (strlen n2))
)
(if (> i 0) (setq n1 (substr n 1 i)) (setq n1 ""))
(strcat n1 n2)
)
;;;-------------------------------------------------
(defun incC (c / i c1 c2) ;;;Increase character c
(setq
   i (strlen c)
   c1 (substr c 1 (- i 1))
   c2 (chr (1+ (ascii (substr c i 1))))
)
(if (or (= c2 "{") (= c2 "["))
   (progn (command "erase" (entlast) "") (alert "Over character!") (exit))
   (strcat c1 c2)
)
)
;;;============================
(defun C:OD( / cn dn c n p) ;;;Make OrDinal number with any format
(setq
   cn (getstring "\nBegin at <1>: " T)
   dn (getint "\nIncrement <1>: ")
)
(if (not dn) (setq dn 1))
(if (= cn "") (setq cn "1"))
(setq c (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" cn))
(setq n (vl-string-subst "" c cn))
(if (/= n "") (setq mode 1) (setq mode 0))
(while (setq p (getpoint "\nBase point : "))
   (wtxt cn p)
   (if (= n "") 
       (setq cn (incC cn))
       (setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))        
   )
)
(princ)
)
;;;============================
(defun C:OC( / e dn p1 cn c n p2 dat) ;;;Make Ordinal number. Copy from template
(setq
   e (car (entsel "\nSelect template text:"))
   dn (getint "\nIncrement <1>: ")
   p1 (getpoint "\nBase point:")
   cn (cdr (assoc 1 (entget e)))
)
(if (not dn) (setq dn 1))
(if (= cn "") (setq cn "1"))
(setq
   c (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" cn)
   n (vl-string-subst "" c cn)
)
(while (setq p2 (getpoint p1 "\nNew point : "))
   (command "copy" e "" p1 p2)
   (if (= n "") 
       (setq cn (incC cn))
       (setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))        
   )
   (setq
       dat (entget (entlast))
       dat (subst (cons 1 cn) (assoc 1 dat) dat)
   )
   (entmod dat)    
)
(princ)
)
;;;============================
(defun C:OCA( / e e0 dn p1 cn c n p2 dat) ;;;Make Ordinal number. Copy from Atttribute block
(setq
   e0 (car (entsel "\nSelect attribute block:"))
   e (entnext e0)
)
(if (/= (etype e) "ATTRIB") (progn (alert "Object is not a Attribute Block!") (exit)))
(setq
   dn (getint "\nIncrement <1>: ")
   p1 (getpoint "\nBase point:")
   cn (cdr (assoc 1 (entget e)))
)
(if (not dn) (setq dn 1))
(if (= cn "") (setq cn "1"))
(setq
   c (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" cn)
   n (vl-string-subst "" c cn)
)
(while (setq p2 (getpoint p1 "\nNew point : "))
   (command "copy" e0 "" p1 p2)
   (if (= n "") 
       (setq cn (incC cn))
       (setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))        
   )
   (setq
       dat (entget (entnext (entlast)))
       dat (subst (cons 1 cn) (assoc 1 dat) dat)
   )
   (entmod dat)
   (command "regen")
)
(princ)
)
;;;============================

Sao khi mình sử dụng lệnh OD thì đôi khi bị báo lỗi :Base point : ; error: too few arguments Mong bạn xe lại giúp.Thanks


<<

Filename: 114614_od_oc_oca.lsp
Tác giả: thanhduan2407
Bài viết gốc: 102656
Tên lệnh: rft
lisp Phun tọa độ các điểm từ file txt vào CAD
Cập nhật theo yêu cầu :

Lisp tạo ra 1 đ/tuợng POINT và 3 đ/tuợng TEXT như sau :

1. Lớp Point có kí hiệu điểm...

>>
Cập nhật theo yêu cầu :

Lisp tạo ra 1 đ/tuợng POINT và 3 đ/tuợng TEXT như sau :

1. Lớp Point có kí hiệu điểm (cột 2-3)

2. Lớp Sothutu : TEXT Số thứ tự (cột 1)

3. Lớp Caodo : TEXT Cao độ (cột 4)

4. Lớp Code : TEXT Code (cột 5)

 

với định dạng của file điểm đo : STT X Y Z Code ,

chấp nhận kí tự phân biệt giữa các giá trị trong file điểm đo : dấu cách, dấu Tab, dấu phẩy.

(defun c:RFT(/ code data f h line pt pxy spc txt stt ten);Read File Txt
 ;|  By : Gia Bach, gia_bach @  www.CadViet.com             |;    
 (vl-load-com)
(defun Split(str / i kitu line lst txtPhanbiet)
 (setq i 1 txtPhanbiet (strcat(chr 9)(chr 32)(chr 44)))
 (while (< i (strlen str))
   (setq kitu (substr str i 1))
   (if (vl-string-search kitu  txtPhanbiet)
     (progn
(if (null Lst)
  (setq Lst (list (substr Str 1 (- i 1))))
  (setq Lst (append Lst (list (read (substr Str 1 (- i 1)))))))
(setq Str (substr Str (+ i 1)) i 1))
     (setq i (1+ i)) )   )
 (setq Lst (append Lst (list Str)))  )
 (or *h* (setq *h* 2 ))
 (initget 6)
 (setq h (getdist (strcat "\nNhap chieu cao Text <" (rtos *h*) "> :")) )
 (if h (setq *h* h) (setq h *h*))
 (if (setq ten (getfiled "Chon File txt" (getvar "dwgprefix") "txt" 8))
   (progn
     (or (tblsearch "layer" "Point") (command "-layer" "n" "Point" "") )
     (or (tblsearch "layer" "Sothutu") (command "-layer" "n" "Sothutu" "c" 3 "Sothutu" "") )
     (or (tblsearch "layer" "Caodo") (command "-layer" "n" "Caodo" "c" 4 "Caodo" "") )
     (or (tblsearch "layer" "Code") (command "-layer" "n" "Code" "c" 2 "Code" "") )
     (setq spc (vla-get-ModelSpace (vla-get-ActiveDocument(vlax-get-Acad-Object))))
     (setq f (open (findfile ten) "r"))
     (while (setq Line (read-line f))
(if (wcmatch Line (strcat "*"(chr 9)"*,*"(chr 32)"*,*`"(chr 44)"*"))
  (progn
    (setq data (split Line) code (last data))
    (if (and
	  (= (vl-list-length data)5)
	  (setq pt (vl-remove code (cdr data)))
	  (not(vl-catch-all-error-p (vl-catch-all-apply 'vlax-3d-point pt))) )
      (progn
	(setq stt (car data) pXY (list (car pt)(cadr pt)))
	(vla-put-Layer (vla-addpoint spc (vlax-3d-point pXY)) "Point")
	(vla-put-Layer (setq txt (vla-addtext spc stt (vlax-3d-point (list 0 0 0)) h)) "Sothutu")
	(vla-put-Alignment txt 8)
	(vla-put-TextAlignmentPoint txt (vlax-3d-point pXY))
	(vla-put-Layer (setq txt (vla-addtext spc code (vlax-3d-point (list 0 0 0)) h)) "Code")
	(vla-put-Alignment txt 6)
	(vla-put-TextAlignmentPoint txt (vlax-3d-point (polar pXY 0 (* 0.2 h))))
	(vla-put-Layer (vla-addtext spc (caddr pt) (vlax-3d-point pXY) h) "Caodo")	))))) ) )
 (princ))

to : thanhduan2407

- Bạn tham khảo cách sử dụng hàm Split ở trên, chỉ đơn giản thay dòng (split Line "\t") bằng (split Line)

và dòng (vl-string-search "\t" Line) bằng (wcmatch Line (strcat "*"(chr 9)"*,*"(chr 32)"*,*`"(chr 44)"*"))

- Nếu bạn đã biết VB thì việc học LISP rất đơn giản (Ngôn ngữ chỉ là cách thể hiện, thuật toán mới là vấn đề)

- Bạn có thể tham khảo bài Hướng dẫn lập trình Lisp, Hãy tự mình khám phá... của bác SSG.

Bác Gia_bach à!

Có sử dụng thì mới biết là có nhiều vấn đề nhỏ trong một vấn đề lớn.

Cháu đã sử dụng được hàm của bác nhưng có một vấn đề là: Mã Code của cháu chỉ sử dụng được từ viết liền nhau, nếu có dấu cách hoặc dấu tab hoặc dấu phẩy trong mã Code thì sẽ báo lỗi. Cháu hiểu lỗi này vì nó sẽ tách tất cả các kí tự trong một dòng. Lại mong bác chỉnh sửa giúp cháu. (cháu rất ngại vì là 1 người lắm chuyện, không chịu suy nghĩ) cháu sẽ cố gắng để sau này được như bác. Thà nhận là không biết gì còn hơn là giấu dốt ko chịu tìm hiểu. Kính mong thư bác hồi âm


<<

Filename: 102656_rft.lsp
Tác giả: xdman
Bài viết gốc: 418541
Tên lệnh: ha1
Lisp lấy giá trị của dimenson, text và xuất ra file text

 

Xem phim hợp đồng hôn nhân xong thấy hài hài, code cho bạn nhé.

 

Đã chỉnh sửa chút xíu. CAD thế nào nó copy y nguyên,...

>>

 

Xem phim hợp đồng hôn nhân xong thấy hài hài, code cho bạn nhé.

 

Đã chỉnh sửa chút xíu. CAD thế nào nó copy y nguyên, sang excel phải format cho đúng font nhé. ^_^

(defun C:HA1 (/ lst str txt 2ClipB)

  (vl-load-com)

  (princ "\nChon cac Text/Mtext/Dimension can copy..."
  )

  (setq lst (acet-ss-to-list (ssget '((0 . "*TEXT,DIMENSION")))))

  (setq str "")

  (foreach n lst

    (cond

      ((= (cdr (assoc 0 (entget n))) "TEXT")
       (setq txt (cdr (assoc 1 (entget n))))
      )

      ((= (cdr (assoc 0 (entget n))) "MTEXT")
       (setq txt (cdr (assoc 1 (entget n))))
      )

      ((= (cdr (assoc 0 (entget n))) "DIMENSION")

       (if (= (cdr (assoc 1 (entget n))) "")

	 (setq txt (rtos (cdr (assoc 42 (entget n)))))

	 (setq txt (cdr (assoc 1 (entget n))))
       )
      )
    )

    (setq str (strcat str txt "\n"))
  )
  
  (vlax-invoke
    (vlax-get
      (vlax-get	(setq 2ClipB (vlax-create-object "htmlfile"))
		'ParentWindow
      )
      'ClipBoardData
    )
    'SetData
    "Text"
    str
  )
  (vlax-release-object 2ClipB)
)

Lisp của bạn hay quá, nhưng mình có mong muốn cao hơn chút nữa, mong bạn giúp cho, vẫn dựa vào lisp trên, cụ thể như này:

- sau khi paste vào excel thì không còn ô trống cuối cùng nữa. cụ thể khi chọn n giá trị trong cad thì copy vào excel chỉ có n dòng thôi, theo mình hiểu trong lisp trên, ký tự "\n" được gán vào đến tận giá trị cuối cùng, làm sao giá trị cuối cùng ko còn bị Enter xuống dòng nữa thì tuyệt.

- các con số sau khi copy của dimension hay bị lẻ, làm sao làm tròn các con số này không còn số sau dấu phẩy nữa.

Vì mình làm bóc khối lượng trên excel nên lisp của bạn được cải biên thêm theo 2 ý kiến trên đây thì tiện lợi cho những bạn làm bóc tách khối lượng như mình rất nhiều.

Cảm ơn bạn rất nhiều!


<<

Filename: 418541_ha1.lsp
Tác giả: MTRUNGTDH
Bài viết gốc: 77638
Tên lệnh: tru
From: Lisp công trừ trong text

bạn dùng thử lisp này

(defun C:TRU (/ OLDDIMZIN SS SOTRU DSSBT SBT)
 (vl-load-com)
 (setq OLDIMZIN (getvar "DIMZIN"))
 (setvar "DIMZIN" 0)
 (princ "\nChon cac so bi...
>>
bạn dùng thử lisp này

(defun C:TRU (/ OLDDIMZIN SS SOTRU DSSBT SBT)
 (vl-load-com)
 (setq OLDIMZIN (getvar "DIMZIN"))
 (setvar "DIMZIN" 0)
 (princ "\nChon cac so bi tru")
 (setq SS (ssget '((0 . "TEXT"))))
 (if _SOTRU
(progn
  (initget 4)
  (if (null (setq SOTRU (getreal (strcat "\nNhap so tru: <" (rtos _SOTRU) "> "))))
(setq SOTRU _SOTRU)
  ) 
) 
(progn
  (initget (+ 1 4))
  (setq SOTRU (getreal "\nNhap so tru: "))
) 
 ) 
 (setq DSSBT (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))))
 (foreach SBT DSSBT (vla-put-textstring SBT (rtos (- (atof (vla-get-textstring SBT)) SOTRU))))
 (setq _SOTRU SOTRU)
 (setvar "DIMZIN" OLDIMZIN)
 (princ)
)

 

 

Nhờ bạn xem giúp mình khi dùng lisp trên thì bị báo lỗi (; error: bad argument type: lselsetp nil) khi nhập số trừ. Thanks!


<<

Filename: 77638_tru.lsp
Tác giả: quocmanh04tt
Bài viết gốc: 423902
Tên lệnh: tt
File cad bị lỗi Viewport che hết các đối tượng khác trong layout

Thử chạy lisp này (Lệnh TT):

(defun c:tt  (/ ss)
  (vla-put-PlotViewportsFirst
    (vla-item (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
              (getvar "ctab"))
    :vlax-true)
  (if (setq ss (ssget "_X" '((0 . "VIEWPORT"))))
    ((lambda (i / ent obj)
       (while (setq ent (ssname ss (setq i (1+ i))))
         (setq obj (vlax-ename->vla-object ent))
        ...
>>

Thử chạy lisp này (Lệnh TT):

(defun c:tt  (/ ss)
  (vla-put-PlotViewportsFirst
    (vla-item (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
              (getvar "ctab"))
    :vlax-true)
  (if (setq ss (ssget "_X" '((0 . "VIEWPORT"))))
    ((lambda (i / ent obj)
       (while (setq ent (ssname ss (setq i (1+ i))))
         (setq obj (vlax-ename->vla-object ent))
         (vla-put-ViewportOn obj 0)
         (vla-put-ViewportOn obj -1)))
      -1))
  (princ))

 


<<

Filename: 423902_tt.lsp
Tác giả: Hoangvulandscape
Bài viết gốc: 152487
Tên lệnh: tkh
Lisp thống kê diện tích Hatch theo Layer

Yêu cầu đã được chấp thuận ^^. Nếu có Express Tool trong CAD bạn có thể dùng bản này, trau chuốt hơn 1 tí ^^ Cho phép đặt kết quả tại...

>>

Yêu cầu đã được chấp thuận ^^. Nếu có Express Tool trong CAD bạn có thể dùng bản này, trau chuốt hơn 1 tí ^^ Cho phép đặt kết quả tại chỗ tùy ý để bạn tiện ghi chú

 

(defun c:tkh (/ lst msp pt ss lay ar txtsiz pt)
 (if (> (atof (substr (getvar "ACADVER") 1 4)) 16.1)
 (progn  
 (vl-load-com)
 (acet-sysvar-set (list "cmdecho" 0))
 (grtext -1 "S\U+01A1n T\U+00F9ng' Lisp")
 (Princ "\nCh\U+1ECDn c\U+00E1c \U+0111\U+1ED1i t\U+01B0\U+1EE3ng Hatch \U+0111\U+1EC3 t\U+00EDnh di\U+1EC7n t\U+00EDch :  ")
 (if (setq ss (ssget(list (cons 0 "HATCH"))))
   (progn
     (foreach e (mapcar 'vlax-ename->vla-object (st-ss->ent ss))
	(setq lay (vlax-get-property e 'Layer))	
       (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-get-area (list e))))
		(setq ar (*  0.000001 (vlax-get-property e 'Area)))
		(progn
			(setq ar 0)(princ (strcat "\nC\U+00F3 Hatch thu\U+1ED9c layer " lay " kh\U+00F4ng t\U+00EDnh \U+0111\U+01B0\U+1EE3c di\U+1EC7n t\U+00EDch.\n\U+0110\U+00E3 highlight v\U+00E0 t\U+00EDnh di\U+1EC7n t\U+00EDch b\U+1EB1ng 0"))
			(redraw (vlax-vla-object->ename e) 3)
		)
	)			
       (if (not (assoc lay lst))
         (setq lst (cons (cons lay ar) lst))
         (setq lst (subst (cons lay (+ ar (cdr (assoc lay lst))))
                          (assoc lay lst) lst))))
     (setq lst (vl-sort lst '(lambda (x y) (< (car x) (car y))))            
           txtsiz (* (getvar "dimtxt")(getvar "dimscale"))
           msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) i -1)
     (while (setq e (nth (setq i (1+ i)) lst))		
       (vla-addtext msp (strcat (car e) " : " (rtos (cdr e) 2 2) "m2") (vlax-3d-point '(0 0 0)) txtsiz)
	(setq pt (ACET-SS-DRAG-MOVE (ssadd (entlast)) '(0 0 0) (strcat "\n\U+0110i\U+1EC3m \U+0111\U+1EB7t ghi ch\U+00FA t\U+1ED5ng di\U+1EC7n t\U+00EDch Hatch thu\U+1ED9c layer " (car e))))
	(command ".move" (entlast) "" '(0 0 0) pt)
	)
		(princ "\n\U+0110\U+00E3 th\U+1EF1c hi\U+1EC7n xong !")
)
   (alert "Kh\U+00F4ng c\U+00F3 Hatch n\U+00E0o \U+0111\U+01B0\U+1EE3c ch\U+1ECDn !"))
)
(alert "Phi\U+00EAn b\U+1EA3n CAD c\U+1EE7a b\U+1EA1n kh\U+00F4ng h\U+1ED7 tr\U+1EE3 t\U+00EDnh di\U+1EC7n t\U+00EDch Hatch !")
)
 (acet-sysvar-restore)(princ))
 (defun st-ss->ent	(ss / n e l)
 (setq n -1)
 (while (setq e (ssname ss (setq n (1+ n))))
   (setq l (cons e l))
 )
)

 

Chào bạn, lại làm phiền bạn nữa rồi. Không hiểu sao có một số file cad ko sử dụng dc lisp này: nó chỉ load tới lệnh bảo chọn Hatch rồi im luôn không chạy nữa. Mình gởi kèm file cho bạn kiểm giùm. Cảm ơn bạn!

link bản vẽ: http://www.mediafire.com/?j2xlcl9tzev6jma

Cảm ơn!


<<

Filename: 152487_tkh.lsp
Tác giả: engineer0405
Bài viết gốc: 195872
Tên lệnh: dmla
Lisp chuyển Layer về thành Bylayer

Mình không rành nhiều về lisp nên chỉ biết viết cho bạn cái lệnh này,bạn dùng thử xem có được không

(defun...
>>

Mình không rành nhiều về lisp nên chỉ biết viết cho bạn cái lệnh này,bạn dùng thử xem có được không

(defun c:dmla ()
(command "undo" "begin")
(command "change" "all" "" "p" "c" "bylayer" "LT" "bylayer" "LW" "bylayer" "" "")
(command "undo" "end")
(princ)
)

em chào anh ạ

anh cho em nhờ tý ạ

với lisp trên nhưng mình chỉ chọn một vùng nào đó thôi thì thêm thế nào ạ

chứ không phải hết bản vẽ

em cảm ơn ạ


<<

Filename: 195872_dmla.lsp
Tác giả: trieubb
Bài viết gốc: 75287
Tên lệnh: ft df dfx
lisp đẩy các đối tượng cách nhau 1 khoảng cách đều nhau?
Với text thì bạn có thể sử dụng lisp này của mình.

Thực ra là gồm 3 lisp.

- Lệnh FT: căn lề text, lisp này mình đã post

>>
Với text thì bạn có thể sử dụng lisp này của mình.

Thực ra là gồm 3 lisp.

- Lệnh FT: căn lề text, lisp này mình đã post tại đây

- Lệnh DF: dãn dòng các text cho đều nhau.

- Lệnh DFX: dàn đều các text theo hàng ngang với khoảng cách đều nhau (khoảng cách từ điểm đầu text này đến điểm cuối của text kia)

Kết hợp 3 lệnh này trong quá trình sử dụng sẽ được cái bạn cần.

(defun c:ft()
(setq txt (ssget '((0 . "*TEXT"))))
(setq mau (entget (car (entsel "\nChon text chuan"))))
(command "undo" "begin")
(setq oldos (getvar "osmode"))
(setq olcol (getvar "CEColor"))
(setq ollay (getvar "Clayer"))
(setq olstyle (getvar "textstyle"))
(setq TB  (textbox mau) LC  (car TB) RC (cadr TB) di (distance LC RC) i 0)
(setq h (cdr(assoc 40 mau)))
(setq x1 (cdr(assoc 10 mau)))
(setq x2 (list (+ (car x1) (* di 0.5) (* -0.03 h)) (cadr x1)))
(setq x3 (list (+ (car x1) di (* -0.06 h)) (cadr x1)))
(setq canle (cond (canle) ("Left")))
(initget "Left Center Right Fit")
(setq canle (cond ((getkword (strcat "\Vi tri can le <" canle ">"))) (canle)))
(repeat (sslength txt)
(setq txt_ent (entget (ssname txt i)))
(setq txt_val (cdr(assoc 1 txt_ent)))
(setq txt_st (cdr(assoc 7 txt_ent)))
(setq txt_lay (cdr(assoc 8 txt_ent)))
(setq txt_h (cdr(assoc 40 txt_ent)))
(setq txt_fctr (cdr(assoc 41 txt_ent)))
(setq txt_clr (cdr(assoc 62 txt_ent)))
(setq y1 (cdr(assoc 10 txt_ent)))
(if (cdr(assoc 43 txt_ent)) (setq txt_fctr 1 y1 (list (car y1) (- (cadr y1) txt_h))))
(setq pt1 (list (car x1) (cadr y1)))
(setq pt2 (list (car x2) (cadr y1)))
(setq pt3 (list (car x3) (cadr y1)))
(command "-style" txt_st "" "" txt_fctr "" "" "" "" "clayer" txt_lay "color" txt_clr "osmode" 0)
(if (eq canle "Left") (command "text" pt1 txt_h 0 txt_val))
(if (eq canle "Center") (command "text" "C" pt2 txt_h 0 txt_val))
(if (eq canle "Right") (command "text" "R" pt3 txt_h 0 txt_val))
(if (eq canle "Fit") (command "text" "F" pt1 pt3 txt_h txt_val))
(setq i (+ i 1))
(command "color" "bylayer")
);repeat
(setvar "textstyle" olstyle)
(setvar "Clayer" ollay)
(setvar "CECOLOR" olcol)
(setvar "osmode" oldos)
(command "erase" txt "")
(prompt"\n by Thaistreetz - huuthais@yahoo.com\n")
(command "undo" "end")
);end
;=====================================================================
;dan deu khoang cach cac hang text theo phuong Y
;=====================================================================
(defun ss2ent (ss / sodt index lstent)
(setq 	sodt (if ss (sslength ss) 0)
index 0)
(repeat sodt
(setq 	ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
);setq
);repeat
(reverse lstent)
)
(defun c:df()
(setq oldos (getvar "osmode"))
(setq 	ss (ssget '((0 . "*TEXT")))
lst (ss2ent ss)
lst (vl-sort lst '(lambda (e1 e2) (< (cadr (assoc 10 (entget e1))) (cadr (assoc 10 (entget e2))))))
lst (vl-sort lst '(lambda (e1 e2) (> (caddr (assoc 10 (entget e1))) (caddr (assoc 10 (entget e2))))))
);setq
(command "undo" "begin")
(setvar "osmode" 15359)
(setq kc (getdist "\n Nhap khoang cach giua cac text"))
(setq ddau (cdr(assoc 10 (entget(car lst)))) i 0 a2 (ssadd))
(setq mau (entget (car (entsel "\nChon text chuan"))))
(setq ptmau (cdr(assoc 10 mau)))
(setq ym (cadr ptmau))
(foreach e lst
(setq ent (entget e))
(setq dcuoi (cdr(assoc 10 ent)))
(setq yi (cadr dcuoi))
(setq ddauu (list (car dcuoi) (- (cadr ddau) (* i kc))))
(if (= yi ym) (setq ptgoc (list (car dcuoi) (- (cadr ddau) (* i kc)))))
(setvar "osmode" 0)
(command "move" e "" dcuoi ddauu)
(setq 	a2 (ssadd e a2))
(setq i (1+ i))
);foreach
(command "move" a2 "" ptgoc ptmau)
(setvar "osmode" oldos)
(prompt"\n by Thaistreetz - huuthais@yahoo.com\n")
(command "undo" "end")
(Princ)
);end
;=====================================================================
;dan deu khoang cach cac text theo phuong X
;=====================================================================
(defun c:dfx()
(setq oldos (getvar "osmode"))
(setq 	ss (ssget '((0 . "*TEXT")))
lst (ss2ent ss)
lst (vl-sort lst '(lambda (e1 e2) (< (cadr (assoc 10 (entget e1))) (cadr (assoc 10 (entget e2))))))
lst (vl-sort lst '(lambda (e1 e2) (> (caddr (assoc 10 (entget e1))) (caddr (assoc 10 (entget e2))))))
);setq
(command "undo" "begin")
(setvar "osmode" 15359)
(setq kc (getdist "\n Nhap khoang cach giua cac text"))

(setq ddau (cdr(assoc 10 (entget(car lst)))) i 0 di 0 a2 (ssadd))
(setq mau (entget (car (entsel "\nChon text chuan"))))
(setq ptmau (cdr(assoc 10 mau)))
(setq xm (car ptmau))
(foreach e lst
(setq ent (entget e))
(setq pti (cdr(assoc 10 ent)))
(setq xi (car pti))
(setq ddauu (list (+ (car ddau) di (* i kc)) (cadr ddau)))
(if (= xi xm) (setq ptgoc (list (+ (car ddau) di (* i kc)) (cadr ddau))))
(setq TBi  (textbox ent) LCi  (car TBi) RCi (cadr TBi) dii (distance LCi RCi) di (+ di dii))
(setvar "osmode" 0)
(command "move" e "" pti ddauu)
(setq 	a2 (ssadd e a2))
(setq i (1+ i))
);foreach
(command "move" a2 "" ptgoc ptmau)
(setvar "osmode" oldos)
(prompt"\n by Thaistreetz - huuthais@yahoo.com\n")
(command "undo" "end")
(Princ)
);end

với yêu cầu như trong hình của bạn thì chỉ cần dùng 2 lệnh FT và DF là đủ.

 

Bác bảo là các đối tượng cơ mà

thế mà làm được với mỗi TEXT

còn các đối tượng khác như LINE, PLINE, POLYLINE.... thì sao bác????


<<

Filename: 75287_ft_df_dfx.lsp
Tác giả: vantuan18nd
Bài viết gốc: 187407
Tên lệnh: tl3
Đo khoảng cách hai điểm và ghi kết quả ra nơi minh chọn

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

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(entsel"\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ái của bác Tuệ ấy

- Khi nhấn T thì nó báo Invalid Point , không được rùi.

-còn cái chọn điểm pick ấy. sao Bác không làm thế này:

+chọn điểm cần ghi

+Kết quả : Chọn cái text để mình "ma" cho nó giống, thay vì phải nhập chiều cao chữ, mà chiều cao chữ thì lại phải đi tìm. hơn nữa Text của bác lại không giống bản vẽ em đang dùng


<<

Filename: 187407_tl3.lsp
Tác giả: nhatminhrd
Bài viết gốc: 176491
Tên lệnh: chlw
Lisp thay đổi giá trị Lineweight trong Layer Properties Manage

 

Hề hề hề,

Bạn dùng thử cái này coi đã ưng ý chưa nhé.

Mình không làm đúng yêu cầu của bạn, nếu bạn...

>>

 

Hề hề hề,

Bạn dùng thử cái này coi đã ưng ý chưa nhé.

Mình không làm đúng yêu cầu của bạn, nếu bạn muốn co thể tự chỉnh sửa lại các nội dung thông báo trên màn hình cho phù hợp, Mình vốn hơi lười sửa, mong bạn thông cảm.


(defun c:chlw (/ lalst la lw )
(command "undo" "be")
(setq lalst (list)
       la (tblnext "layer" T)
       lalst (cons (cdr (assoc 2 la)) lalst)
)
(while (setq la (tblnext "layer"))
   (setq lalst (cons (cdr (assoc 2 la)) lalst))
)
(setq la (getstring t "\n Nhap ten layer chuan: ")
       lw (getreal "\n Nhap gia tri lineweight chuan: ")
)
(foreach x lalst
   (if (/= (strcase x) (strcase la))
       (command "layer" "lw" 0.05 x "")
       (command "layer" "lw" lw x "")
   )
)
(command "undo" "e")
(princ)
)

 

Chúc bạn vui.

 

-----------------

thanh bạn nhiều, nghiên cứu và chỉnh sửa theo fiel bạn gửi đã, lúc nào OK mình thông báo lại nha.


<<

Filename: 176491_chlw.lsp
Tác giả: vanhoa20052
Bài viết gốc: 418697
Tên lệnh: ha2
Lisp đổi tên hàng loạt Layouts!

 

Lisp đổi tên tất cả layout thành các số nguyên từ 1...

>>

 

Lisp đổi tên tất cả layout thành các số nguyên từ 1 đến n và thêm tiền tố chung.

;Doan Van Ha - CADViet.com - Ngay 04/12/2014
;Chuc nang: Thay doi ten tat ca layouts va them tien to, tu: HA-1->HA--2->HA-3...HA-n
(defun C:HA2(/ acdoc aclay actab i)
 (vl-load-com)
 (setq tto (getstring "\nTien to chung cua cac layouts: ")) 
 (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))
       actab (strcase (getvar 'CTAB)))
 (vlax-for l (vla-get-layouts acdoc)
  (if (not (eq actab (strcase (vla-get-name l))))
   (setq aclay (cons (cons (vla-get-name l) l) aclay))))
 (setq aclay (vl-sort aclay '(lambda(a b) (< (vla-get-taborder (cdr a)) (vla-get-taborder (cdr b))))))
 (setq i 100000000)
 (foreach n aclay
  (vla-put-name (cdr n) (itoa (setq i (1+ i))))
  (vlax-release-object (cdr n)))
 (setq aclay nil)
 (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))
       actab (strcase (getvar 'CTAB)))
 (vlax-for l (vla-get-layouts acdoc)
  (if (not (eq actab (strcase (vla-get-name l))))
   (setq aclay (cons (cons (vla-get-name l) l) aclay))))
 (setq aclay (vl-sort aclay '(lambda(a b) (< (vla-get-taborder (cdr a)) (vla-get-taborder (cdr b))))))
 (setq i 0)
 (foreach n aclay
  (vla-put-name (cdr n) (strcat tto (itoa (setq i (1+ i)))))
  (vlax-release-object (cdr n)))
 (princ))
 
 

Lisp của Doanvanha (HA2) rất ok...nhưng nhờ pac sửa or cho thêm 1 tùy chọn nữa

 

VD:mình muốn đổi tên Layout SR-307A thành SR-308 đến vô cùng nhưng khi dùng lisp HA2 thì gõ SR-308 thì nó lại cộng 1 tăng dần ==> SR-3081, SR-3082,...

 

Trong khi mình muốn gõ SR-308 thì nó sẽ tăng dần là SR-309, SR-310,...

 

cảm ơn các pac nhìu


<<

Filename: 418697_ha2.lsp
Tác giả: tambat
Bài viết gốc: 3820
Tên lệnh: dsa sa
Lisp tính diện tích và chèn giá trị vào vòng tròn ký hiệu
>>
http://www.cadviet.com/upfiles/Dientich.zip

 

Tặng các bác làm quy họach cái này dùng chơi

Lệnh là DSA hoặc SA

Vợ về bên ngọai nên rãnh rỗi viết cái này tặng anh em bên Quy họach dùng chơi

 

"Mình ơi, anh nhớ mình quá"

 

Còn đây là Code

 

DIENTICH.LSP

;Chuong trinh tinh va ghi dien tich
;Author Vo Kien Cuong

(DEFUN DIENTICH(/ DCL_ID_DIENTICH dt)  
 (setq DCL_ID_DIENTICH (load_dialog "DIENTICH.DCL"))
 (if (not(new_dialog "DIENTICH" DCL_ID_DIENTICH)) (exit))  
 (action_tile "BACK_key" "(CHANGE_SLIDE 0)")
 (action_tile "NEXT_key" "(CHANGE_SLIDE 1)")
 (action_tile "OPT_key" "(OPTION)")
 (action_tile "info" "(ABOUT)")
 (action_tile "accept" "(GETVALUE_DT) (done_dialog 1)")
 (action_tile "TK_key" "(GETVALUE_DT) (done_dialog 2)")  
 (SETVALUE_DT)
 (setq RES_DT (start_dialog))
 (if (= RES_DT 1)
(progn
  (if (= Is_Obj "1")
	(setq dt (GETOBJECT))
(setq dt (GETPOINTS))
  )
  (WRITEDIENTICH dt)
  (DIENTICH) 
)
 )
 (if (= RES_DT 2)
(progn
  (KHOILUONG) 
  (DIENTICH) 
)
 )
 (unload_dialog DCL_ID_DIENTICH) 
)

(DEFUN TINHDIENTICH(dt / s)
 (Command "AREA" "O" dt)
 (setq s (getvar "AREA"))
 (If (= DVDT "1")
(setq s (/ s 10000))
 )
 s
)

(DEFUN WRITEDIENTICH(dt / s Pnt blkName)
 (setq Pnt Nil)
 (setq s (TINHDIENTICH dt))
 (setq ds (Fix (* s (atof MDDS))))
 (if (= DVDS "1")
(setq ds (/ ds 1000))
 )  
 (while (Null Pnt)
(setq Pnt (Getpoint "Chon diem chen Block "))
 )  
 (setq kh (getString "\nNhap ky hieu: "))  
 (setq blkName (nth (- i_sld 1) Li_sld))  
 (command "-INSERT" blkName "S" TLSC Pnt "0" kh (rtos s 2 2) (itoa ds))
)

(DEFUN IMAGE_SLIDE(/ sld_name)
 (setq sld_name (nth (- i_sld 1) Li_sld))
 (start_image "IMAGE_key")
 (fill_image 0 0 (dimx_tile "IMAGE_key") (dimy_tile "IMAGE_key") -15)
 (slide_image 5 0 (dimx_tile "IMAGE_key") (dimy_tile "IMAGE_key") sld_name)
 (end_image)
)

(DEFUN C:DSA()
 (setvar "CMDECHO" 0)
 (terpri)  
 (DT_INIT)  
 (DIENTICH)
 (setvar "CMDECHO" 1)
)

(DEFUN C:SA()
 (setvar "CMDECHO" 0)
 (terpri)  
 (DT_INIT)  
 (if (= Is_Obj "1")
 (setq dt (GETOBJECT))
 (setq dt (GETPOINTS))
 )  
 (WRITEDIENTICH dt)	   
 (setvar "CMDECHO" 1)
)

(DEFUN DT_INIT()
 (setq Li_sld (List "Blk001" "Blk002" "Blk003" "Blk004"))
 (if (Null i_sld)
(setq i_sld 1)
 )
 (CREALILA)  
 (if (Null Is_Obj)
(setq Is_Obj "1")
 )
 (if (Null Is_Pnt)
(setq Is_Pnt "0")
 )
 (if (Null IsCuLa_DT)
(setq IsCuLa_DT "1")
 )  
 (if (Null IsSetLa_DT)
(setq IsSetLa_DT "0")
 )
 (if (Null la_DT)
(setq la_DT "0")
 )
 (if (Null Is_DVDT)
(setq Is_DVDT "0")
 )
 (if (Null Is_DVDS)
(setq Is_DVDS "0")
 )
 (setq Li_DT (List "m2" "ha"))
 (If (Null DVDT)
(setq DVDT "1")
 )  
 (setq Li_DS (List "1" "1000"))
 (If (Null DVDS)
(setq DVDS "1")
 )
 (If (Null MDDS)
(setq MDDS "100")
 )
 (If (Null TLSC)
(setq TLSC "1")		
 )  
)

(DEFUN CHANGE_SLIDE(n)
 (if (= n 0)
(progn
  (if (= i_sld 1)
(setq i_sld 4)
(setq i_sld (- i_sld 1))
  )
)
 )
 (if (= n 1)
(progn
  (if (= i_sld 4)
(setq i_sld 1)
(setq i_sld (+ i_sld 1))
  )
)
 )
 (IMAGE_SLIDE)
)

(DEFUN OPTION (/ DCL_ID_DIENTICH_OPT)  
 (setq DCL_ID_DIENTICH_OPT (load_dialog "DIENTICH.DCL"))
 (if (not (new_dialog "OPTION" DCL_ID_DIENTICH_OPT))(exit))
 (action_tile "IsCuLA_DT" "(Is_Chk_La)")
 (action_tile "IsSetLA_DT" "(Is_Chk_La)")
 (action_tile "MD_DS" "(CHECKVALUE_MDDS)")
 (action_tile "TL_DT" "(CHECKVALUE_TLSC)")  
 (action_tile "accept" "(GETOPTVALUE_DT) (done_dialog 1)")
 (if (= IsSetLa_DT "1")
(mode_tile "La_DT" 0)
(mode_tile "La_DT" 1)
 )
 (start_list "La_DT")  
 (mapcar 'add_list LiLa)
 (end_list)
 (start_list "DV_DT")  
 (mapcar 'add_list Li_DT)
 (end_list)
 (start_list "DV_DS")  
 (mapcar 'add_list Li_DS)
 (end_list)
 (SETOPTVALUE_DT)	 
 (start_dialog)
 (unload_dialog DCL_ID_DIENTICH_OPT)  
)

(DEFUN SETVALUE_DT()
 (IMAGE_SLIDE)
 (set_tile "DT_OBJ" Is_Obj)
 (set_tile "DT_PNT" Is_Pnt)  
)

(DEFUN GETVALUE_DT()
 (setq Is_Obj (get_tile "DT_OBJ"))
 (setq Is_Pnt (get_tile "DT_PNT"))  
)

(DEFUN SETOPTVALUE_DT()  
 (set_tile  "IsCuLA_DT" IsCuLa_DT)  
 (set_tile "IsSetLA_DT" IsSetLa_DT)	
 (set_tile "La_DT" la_DT)
 (set_tile "Is_DVDT" Is_DVDT)
 (set_tile "Is_DVDS" Is_DVDS)
 (set_tile "DV_DT" DVDT)
 (set_tile "DV_DS" DVDS)
 (set_tile "MD_DS" MDDS)
 (set_tile "TL_DT" TLSC)
)

(DEFUN GETOPTVALUE_DT()
 (setq IsCuLa_DT (get_tile "IsCuLA_DT"))
 (setq IsSetLa_DT (get_tile "IsSetLA_DT"))  
 (setq la_DT (get_tile "La_DT"))
 (setq Is_DVDT (get_tile "Is_DVDT"))
 (setq Is_DVDS (get_tile "Is_DVDS"))
 (setq DVDT (get_tile "DV_DT"))
 (setq DVDS (get_tile "DV_DS"))
 (setq MDDS (get_tile "MD_DS"))
 (setq TLSC (get_tile "TL_DT"))
)

(DEFUN CREALILA (/ NL)
 (setq LiLa (List))
 (setq NL (tblnext "LAYER" T))  
 (while NL	
(setq LiLa (append LiLa (list (cdr (assoc 2 NL)))))
(setq NL (tblnext "LAYER"))
 )
 (setq LiLa (Acad_strlsort LiLa))
)

(DEFUN Is_Chk_La ()
 (if (= (get_tile "IsSetLA_DT") "1")
(mode_tile "La_DT" 0)
(mode_tile "La_DT" 1)
 )
)

(DEFUN CHECKVALUE_MDDS()
 (setq temp (get_tile "MD_DS"))
 (If (Not (IsNumeric temp))
(progn
  (alert "Gia tri nhap vao khong hop le")
  (set_tile "MD_DS" MDDS)
)
 )  
)

(DEFUN CHECKVALUE_TLSC()
 (setq temp (get_tile "TL_DT"))
 (If (Not (IsNumeric temp))
(progn
  (alert "Gia tri nhap vao khong hop le")
  (set_tile "TL_DT" TLSC)
)
 )  
)

(DEFUN GETOBJECT(/ ss dt)
 (setq ss Nil)
 (while (Null ss)
(princ "Chon doi tuong can tinh dien tich")
(setq ss (ssget))	
 )
 (setq dt (ssname ss 0))
 dt
)

(DEFUN GETPOINTS(/ ssLine Pnt1 Pnt2 dt)
 (setq ssLine (ssAdd))  
 (setvar "CMDECHO" 0)
 (princ "\nChon diem tren man hinh de tinh dien tich")
 (setq Pnt1 (Getpoint "\nChon diem dau tien:"))  
 (while (Not (Null Pnt1))
(setq Pnt2 (Getpoint Pnt1 "\nChon diem tiep theo"))
(if (AND (Not (NUll Pnt1)) (Not (NUll Pnt2)))
  (command "LINE" Pnt1 Pnt2 "")
)	
(setq dt (entlast))
(setq ssLine (ssAdd dt ssLine))	
(setq Pnt1 Pnt2)	
 )  
 (setq dt (ssname ssLine 0))  
 (command "PEDIT" dt "Y" "J" ssLine "" "")  
 (setvar "CMDECHO" 1)
 (setq dt (entlast))
 dt
)

(DEFUN ABOUT(/ DCL_ID_ABOUT)
 (setq DCL_ID_ABOUT (load_dialog "DIENTICH.DCL"))
 (if (not(new_dialog "ABOUT" DCL_ID_ABOUT))(exit))  
 (start_list "aboutme")
 (add_list " ")  
 (add_list "  VO KIEN CUONG - Bachelor of IT")
 (add_list "  =====================================================")
 (add_list "  Email : vkcuong_23@yahoo.com")
 (add_list "  Mobile: 0983616182 - 0977352125")
 (add_list "  CAD developer (LISP, DCL, VBA for AutoCad, ObjectARX...)")  
 (add_list "  ")
 (end_list)
 (start_dialog)
 (unload_dialog DCL_ID_ABOUT)
)

(DEFUN KHOILUONG( / ss LiKH LiDT LiDS n i chuoi ss)
 (setq LiKH Nil)
 (setq LiDT Nil)
 (setq LiDS Nil)
 (setq ss Nil)
 (princ "Chon nhom Block muon thong ke khoi luong")
 (setq ss (ssget))
 (setq n (sslength ss))
 (if (> n 0)
(progn
  (setq i 0)
  (while (< i n)
(setq dt (ssname ss i))
(if (OR (= (TENDOITUONG dt) "Blk001") (= (TENDOITUONG dt) "Blk002") (= (TENDOITUONG dt) "Blk003") (= (TENDOITUONG dt) "Blk004"))
  (progn
	(setq LiKH (Append LiKH (List (GetStringTag dt "KH"))))
	(setq LiDT (Append LiDT (List (GetStringTag dt "DT"))))
	(setq LiDS (Append LiDS (List (GetStringTag dt "DS"))))
  )
)
(setq i (1+ i))
  )
)  
 )
 (setq n (length LiKH))
 (If (> n 0)
(progn
  (setq i 0)
  (setq DCL_ID_KHOILUONG (load_dialog "DIENTICH.DCL"))
  (if (not(new_dialog "KHOILUONG" DCL_ID_KHOILUONG)) (exit))
  (start_list "li_KL")	  
  (add_list (strcat "  So Block: " (itoa n)))	  
  (add_list "  BANG KHOI LUONG")
  (add_list "  -------------------------------------------------------")
  (while (< i n)
(setq chuoi (strcat "  " (FIXLENGTH (nth i liKH) 15) (FIXLENGTH (nth i liDT) 15) (FIXLENGTH (nth i liDS) 15)))	
(add_list chuoi)
(setq i (1+ i))
  )
  (add_list "  -------------------------------------------------------")	  
  (end_list)
  (start_dialog)
  (unload_dialog DCL_ID_ABOUT)
)	
 )	
)

(DEFUN GetTag (objblock tag / temp1 att_list old)
 (setq temp1	objblock)
 (setq att_list (ENTGET temp1))
 (WHILE (NOT (= (CDR (ASSOC 2 att_list))tag))
(setq temp1	(ENTNEXT temp1))
(setq att_list (ENTGET temp1))
 )
 (setq old (CDR (ASSOC 1 att_list)))
)

(DEFUN GetStringTag (objblock tag / thtin)
 (setq thtin (GetTag objblock tag))
 thtin
)

(DEFUN IsNumeric (str / kq n1 n2 l)
 (setq kq Nil)
 (setq n1 0)
 (setq n2 0)
 (if (= (substr str 1 1)"-")
(setq str (substr str 2 (- (strlen str) 1)))
 )  
 (setq l (strlen str))
 (if (= (substr str 1 1)".")
(setq kq Nil)
(progn
  (setq i 1)
  (while (<= i l)
(setq a (substr str i 1))
(if (and (> (ascii a) 47) (< (ascii a) 58))
  (setq n1 (+ n1 1))
)
(if (= a ".")
  (setq n2 (+ n2 1))
)
(setq i (+ i 1))
  )
  (if (and (<= n2 1) (= (+ n2 n1)l))
(setq kq T)	
  )
)
 )
 kq
)

(DEFUN TENDOITUONG (obj / name)
 (if (/= (cdr (assoc 0 (entget obj))) "INSERT")
(setq name (cdr (assoc 0 (entget obj))))
(setq name (cdr (assoc 2 (entget obj))))
 )
 name  
)

(DEFUN FIXLENGTH(chuoi l / l1 chuoi1)  
 (setq chuoi1 chuoi)
 (setq l1 (strlen chuoi))
 (if (< l1 l)
(progn
  (while (< l1 l)
(setq chuoi1 (strcat chuoi1 " "))
(setq l1 (1+ l1))
  )	
)
(progn
  (setq chuoi1 (substr chuoi 1 l))
)
 )
 chuoi1  
)

 
DIENTICH.DCL
//Form chuong trinh tinh Dien tich
//Author Vo Kien Cuong
DIENTICH:dialog	{
spacer_1;
label="CHUONG TRINH TINH DIEN TICH";	
:boxed_column	{
	label="Chon hinh anh block muon hien thi";
	:row	{
		:button	{
			label="<<";
			key="BACK_key";
			}
		:image_button	{
			key="IMAGE_key";
			width=14;
			height=7;				
			color=dialog_background;
			}
		:button	{
			label=">>";
			key="NEXT_key";
			}
		}		
	}
:row	{
	:boxed_column	{
		label="Cach tinh dien tich";
		:radio_button	{
			label="Chon doi tuong";
			key="DT_OBJ";
			}
		:radio_button	{
			label="Chon diem";
			key="DT_PNT";
			}		
		}
	:column	{
		spacer_1;
		spacer_1;
		:button	{
			label="Cai dat";
			key="OPT_key";
			}
		:button	{
			label="Khoi luong";
			key="TK_key";
			}			
		}
	}	
	spacer_0;
	:row	{
	ok_cancel;
	spacer_1;
	spacer_1;
	spacer_1;
	:button	{
		label="Author";
		key="info";
		}
	}
	}
OPTION:dialog	{
	spacer_1;
	label="Cac thong so cho block dien tich";
	:boxed_radio_column{
		label="Cai dat Layer";
		:radio_button{
			label="Su dung Layer hien huu";
			key="IsCuLA_DT"; 			
			}
		:radio_button{
			label="Cai dat Layer";
			key="IsSetLA_DT";
			}
		:popup_list{			
		key="La_DT";			
		}		
		}
	:boxed_column	{
		label="Hien thi"; 			
		:popup_list{
			label="Don vi dien tich";
			key="DV_DT";
			edit_width=8;
			}
		:toggle	{
			label="Hien thi don vi dien tich";
			key="Is_DVDT";
			is_enabled=false;
			}
		:popup_list{
			label="Don vi dan so";
			key="DV_DS";
			edit_width=8;
			}
		:toggle	{
			label="Hien thi don vi dan so";
			key="Is_DVDS";
			is_enabled=false;
			}
		:edit_box{
			label="Mat do dan so (N/DVDT):";
			key="MD_DS";
			edit_width=9;
			}
		:edit_box{
			label="He so Scale Block:";
			key="TL_DT";
			edit_width=9;
			} 	
		}
	spacer_1;
ok_cancel;
	}
ABOUT:dialog{
label="About me...";
spacer_1;
:list_box{				
	key="aboutme";
	width=55;
	height=9;
	}
ok_only;
}
KHOILUONG :dialog{
spacer_1;
label = "THONG KE KHOI LUONG";	
:list_box{
	key="li_KL";
	label="Thong ke khoi luong";
	height=15;
	width=45;
	}
spacer_1;
ok_only;
	}

 

sao không chạy được Bác ơi !

Bác có thể hướng dẫn thêm được không.


<<

Filename: 3820_dsa_sa.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 135374
Tên lệnh: ct
lisp tính tổng các số (VERY EASY)

Lisp đầu :

;free lisp from CadViet.com @ketxu
(defun dxf (dxf ent) (cdr (assoc dxf (entget ent))))
(defun wtxt_l(txt p / sty d h1 h2 wf...
>>

Lisp đầu :

;free lisp from CadViet.com @ketxu
(defun dxf (dxf ent) (cdr (assoc dxf (entget ent))))
(defun wtxt_l(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 1)(cons 11 p) (cons 1 txt) (cons 10 p))))
(defun c:ct(/ sum ssc sst)
(setq ssc (acet-ss-to-list (ssget '((0 . "*TEXT"))))
	sst (acet-ss-to-list (ssget '((0 . "*TEXT"))))
	sum 0)
(foreach x ssc
(setq sum (+ sum (atof (dxf 1 x))))
)
(foreach x sst
(setq sum (- sum (atof (dxf 1 x))))
)
(wtxt_l (rtos sum 2 2) (getpoint "\n Diem chen ket qua"))	
)

Biến và hàm trung tên liệu có sao không hè (cùng dxf)?


<<

Filename: 135374_ct.lsp
Tác giả: quickandfine
Bài viết gốc: 206012
Tên lệnh: ckt
Lisp cắt đường gióng của dim theo một đường thẳng cho trước

Đây là Lisp mình sưu tập được bạn dùng thử, mình dùng thì thấy rất đúng yêu cầu của bài rùi


(defun c:ckt...
>>

Đây là Lisp mình sưu tập được bạn dùng thử, mình dùng thì thấy rất đúng yêu cầu của bài rùi


(defun c:ckt ()
(princ "\n Chon duong giong:")
(princ "\n Chon cac duong kich thuoc:")
(setq chon2  (ssget))
(setq ktra1 (getstring "n\Lua chon: giong Duoi (D), giong Tren (T), theo duong thang (V):"))


(if  (OR (= ktra1 "G") (= ktra1 "g"))
(progn
(setq chon1 (entsel  "\n Chon duong giong:"))
(setq chon1 (car chon1))
(setq ktra (cdr(assoc 0(entget chon1)))) 
(if (= ktra "LINE")

  (progn

 (setq DAU (cdr(assoc 10(entget chon1))))
 (setq CUOI (cdr(assoc 11(entget chon1))))
 (giong)
     )
)   ;-----------ket thuc if 1
;  (if (= ktra "LWPOLYLINE")
 ;(progn
 ;   (setq danhsach nil)
 ;   (setq j 1)
 ;   (setq eg (entget chon1))
 ;  (setq DAU (cdr(assoc 10(entget chon1))))
 ;   (while (/= DAU nil)
 ;  (setq danhsach (append danhsach DAU))
 ;  (setq j (+ j 1))
 ;;  (setq cu (list 10 (car DAU) (cadr DAU) 0))
  ;  (setq moi (list 11 (car DAU) (cadr DAU) 0))
 ; (setq eg (subst moi cu eg))
  ;  )

 ;(setq i 1)
 ;(setq DAU (nth i danhsach))
 ;(setq CUOI (nth (+ i 1) danhsach))
 ;(giong)
 ;)  

  ;)

 )
) ;--------ket thuc if2

(if  (OR (= ktra1 "D") (= ktra1 "d"))
(progn
 (setq DAU (getpoint  "\n Chon diem lam moc :"))
 (setq CUOI (polar DAU 0 10))
 (giong)  
)
);-------Dong if
(if  (OR (= ktra1 "V") (= ktra1 "v"))
(progn
 (setq DAU (getpoint  "\n Chon diem dau :"))
 (setq CUOI (getpoint  "\n Chon diem thu hai :"))
 (giong)  
)
);-------Dong if
(if  (OR (= ktra1 "T") (= ktra1 "t"))
(progn
 (setq DAU (getpoint  "\n Chon diem lam moc :"))
 (setq CUOI (polar DAU 0 1))
 (setq x1 (car DAU))
 (setq y1 (cadr DAU))
 (setq x2( car CUOI))
 (setq y2 (cadr CUOI))
 (setq kq1 (/ (- y1 y2) (- x1 x2)))

 (setq k 0)
 (while (setq ENT (ssname chon2 k))  ;--------> duyet tung thang 1
(setq p1 (cdr(assoc 11(entget ENT))))
(setq p2 (cdr(assoc 10(entget ENT))))
(setq p3 (cdr(assoc 14(entget ENT))))
(setq p4 (cdr(assoc 13(entget ENT))))
(setq xd (car p1))
(setq yd (+ (* (- xd x1) kq1) y1))
(setq xc (car p2))
(setq yc (+ (* (- xc x1) kq1) y1))
;--------------------------giong duoi---------------------------------------------
 (setq eg2 (entget ENT))
 (setq tdcud (list 11 (car p1) (cadr p1) 0))
 (setq tdcuc (list 10 (car p2) (cadr p2) 0))
 (setq tdmoid (list 11 xd yd 0))
 (setq tdmoic (list 10 xc yc 0))

 ; (setq caodo (rtos caodo))
 ;(setq ten (cons 1  caodo))
 (setq eg2 (subst tdmoid tdcud eg2))
 (setq eg2 (subst tdmoic tdcuc eg2))
 (entmod eg2)
 (SETQ K (+ K 1))
 )
 )
);dong if
)   
)
(defun giong ()
 (setq x1 (car DAU))
 (setq y1 (cadr DAU))
 (setq x2( car CUOI))
 (setq y2 (cadr CUOI))
 (setq kq1 (/ (- y1 y2) (- x1 x2)))

 (setq k 0)
 (while (setq ENT (ssname chon2 k))  ;--------> duyet tung thang 1
(setq p1 (cdr(assoc 11(entget ENT))))
(setq p2 (cdr(assoc 10(entget ENT))))
(setq p3 (cdr(assoc 14(entget ENT))))
(setq p4 (cdr(assoc 13(entget ENT))))
(setq xd (car p3))
(setq yd (+ (* (- xd x1) kq1) y1))
(setq xc (car p4))
(setq yc (+ (* (- xc x1) kq1) y1))
;--------------------------giong duoi---------------------------------------------
 (setq eg2 (entget ENT))
 (setq tdcud (list 14 (car p3) (cadr p3) 0))
 (setq tdcuc (list 13 (car p4) (cadr p4) 0))
 (setq tdmoid (list 14 xd yd 0))
 (setq tdmoic (list 13 xc yc 0))

 ; (setq caodo (rtos caodo))
 ;(setq ten (cons 1  caodo))
 (setq eg2 (subst tdmoid tdcud eg2))
 (setq eg2 (subst tdmoic tdcuc eg2))
 (entmod eg2)
 (SETQ K (+ K 1))
 )
)

Em down về dùng thấy đoạn lisp trên chỉ cho dùng 4 lần. Em đã thử xóa các thứ liên quan đến biến "thu" và thấy dùng được nhiều lần hơn mà không bị hỏi "liên hệ với sdt..." nữa (Đoạn lisp phía trên em đã sửa ạ). Nhưng em cũng không sửa được để lisp có thể cắt được dim ngang theo ý của tqcuongutc (em chỉ mày mò tự sửa thôi chứ giờ em mới bắt đầu học lisp (hì). Có bác nào giúp chúng em với ạ.


<<

Filename: 206012_ckt.lsp
Tác giả: lanvientkh
Bài viết gốc: 411873
Tên lệnh: test
Lisp xuất chiều dài Line ra Text có sẵn và có tiền tố, hậu tố

 

Đã fix nhé ^_^

;;Lenh TEST

(defun c:test (/ ss n _length pt1 pt2 pt3 pt4 ss1 )
  (vl-load-com)
  (setvar "CMDECHO" 0)
 ...
>>

 

Đã fix nhé ^_^

;;Lenh TEST

(defun c:test (/ ss n _length pt1 pt2 pt3 pt4 ss1 )
  (vl-load-com)
  (setvar "CMDECHO" 0)
  (princ "\nChon LINE: ")
  (if (setq ss (ssget '((0 . "LINE"))))
    (progn
      (command "zoom" "ob" ss "")
      (setq n 0)
      (repeat (sslength ss)
	(setq _length (/ (vlax-get (vlax-ename->vla-object (ssname ss n)) 'Length) 1000.))
	(setq pt1 (polar (cdr (assoc 10 (entget (ssname ss n)))) (+ (angle (cdr (assoc 10 (entget (ssname ss n))))
									   (cdr (assoc 11 (entget (ssname ss n))))
									   )
								      (/ pi 2)
								    )
			 100.)
	      )
	(setq pt2 (polar (cdr (assoc 11 (entget (ssname ss n)))) (- (angle (cdr (assoc 10 (entget (ssname ss n))))
									   (cdr (assoc 11 (entget (ssname ss n))))
									   )
								      (/ pi 2)
								    )
			 100.)
	      )
	(setq pt3 (polar (cdr (assoc 10 (entget (ssname ss n)))) (- (angle (cdr (assoc 10 (entget (ssname ss n))))
									   (cdr (assoc 11 (entget (ssname ss n))))
									   )
								      (/ pi 2)
								    )
			 100.)
	      )
	(setq pt4 (polar (cdr (assoc 11 (entget (ssname ss n)))) (+ (angle (cdr (assoc 10 (entget (ssname ss n))))
									   (cdr (assoc 11 (entget (ssname ss n))))
									   )
								      (/ pi 2)
								    )
			 100.)
	      )

	(setq ss1 (ssget "CP" (list pt1 pt4 pt2 pt3) '((0 . "TEXT"))))
	(if ss1
	  (if (> (sslength ss1) 1)
	    (progn
	      (princ "\nCo >1 TEXT tai vi tri vung chon xung quanh LINE.")
	      (redraw (ssname ss n) 3)
	      )
	    (entmod (subst (cons 1 (strcat "L= " (rtos _length 2 1) " m"))
			   (assoc 1 (entget (ssname ss1 0)))
			   (entget (ssname ss1 0)))
		    )
	    )
	  )
	(setq n (1+ n))
	);repeat
      );progn
    (princ "\nBan da khong chon LINE.")
    );if
  (command "zoom" "P")
  (princ)
  )

lisp quá tốt, thanks bạn hí


<<

Filename: 411873_test.lsp
Tác giả: Danh Cong
Bài viết gốc: 423983
Tên lệnh: test
Góc Nhờ Viết Lisp ( chọn dim có giá trị giống nhau trong vùng chọn)

Code tham khảo: 


(defun c:test ( / DOITUONGI GIATRI I OBJECT TAPCHON THAPPHAN)

(setq     thapphan (getvar "dimdec")
     giatri (getreal "\nValue:")
      object (ssget '(( 0 . "DIMENSION")))
    i 0
    tapchon (ssadd))
(repeat (sslength object)
      (progn
        (setq doituongi (ssname object i))
          (if    (= (atof (rtos (cdr (assoc 42 (entget doituongi))) 2 thapphan)) giatri)
            ...
>>

Code tham khảo: 


(defun c:test ( / DOITUONGI GIATRI I OBJECT TAPCHON THAPPHAN)

(setq     thapphan (getvar "dimdec")
     giatri (getreal "\nValue:")
      object (ssget '(( 0 . "DIMENSION")))
    i 0
    tapchon (ssadd))
(repeat (sslength object)
      (progn
        (setq doituongi (ssname object i))
          (if    (= (atof (rtos (cdr (assoc 42 (entget doituongi))) 2 thapphan)) giatri)
              (ssadd doituongi tapchon))
          (setq i (+ i 1))
     )
  ); end repeat
  (sssetfirst nil tapchon))


<<

Filename: 423983_test.lsp
Tác giả: Danh Cong
Bài viết gốc: 424020
Tên lệnh: test
Nhờ lisp chế độ bắt điểm hatch

Code tham khảo: 

(defun c:test ()
  (if     (= (getvar "osoptions") 0)
        (setvar "osoptions" 1)
        (setvar "osoptions" 0))
  (princ))


Filename: 424020_test.lsp
Tác giả: Phiphi-
Bài viết gốc: 143719
Tên lệnh: dc
lisp đổi màu tất cả các đường DIM ?

Bạn sửa lại như ày :

(defun C:dc()
(vl-load-com)
(foreach ent (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr...
>>

Bạn sửa lại như ày :

(defun C:dc()
(vl-load-com)
(foreach ent (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X" '((0 . "DIMENSION,LEADER")))))))
(if (vlax-property-available-p ent 'TextColor)
(vla-put-Textcolor ent "2")
)
(if (vlax-property-available-p ent 'DimensionLinecolor)
(vla-put-DimensionLinecolor ent "30")
)
(if (vlax-property-available-p ent 'ExtensionLinecolor)
(vla-put-ExtensionLinecolor ent "30")
)
)
)

Xin Bác Ketxu viêt thêm multilearder vào Lisp trên. Thanks


<<

Filename: 143719_dc.lsp
Tác giả: ketxu
Bài viết gốc: 424037
Tên lệnh: oh
Nhờ lisp chế độ bắt điểm hatch
(defun c:oh ()(setvar 'osnaphatch (- 1 (getvar 'osnaphatch))))

 


Filename: 424037_oh.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 344382
Tên lệnh: atc
Cộng trừ nhân chia các số trong block att

 

>>

 

 

Hề hề hề,

Không biết cái này có đúng ý bạn chưa???

 

http://www.cadviet.com/upfiles/4/5194_attcalculation_1.lsp

(defun c:atc (/ goc cal e1 en ph)
(setq goc (atof (cdr (assoc 1 (entget (car (nentsel "\n Chon text goc tinh toan")))))))
(setq cal (getstring "\n Chon phep tinh toan <+ - * /> : "))
(while (setq e1 (nentsel "\n Chon text can tinh toan"))
     (setq ph (atof (cdr (assoc 1 (entget (car e1 ))))))
     (cond 
        ((= cal "+") (setq goc (+ goc ph)))
        (( = cal "-") (setq goc (- goc ph)))
        ((= cal "*") (setq goc (* goc ph)))
        ((= cal "/") (setq goc (/ goc ph)))
        (T nil)
     )
   goc
)
(setq en (car (nentsel "\n Chon text can thay the")))
(entmod (subst (cons 1 (rtos goc 2 2)) (assoc 1 (entget en)) (entget en)))
(entupd en)
)

Cảm ơn bạn nhiều nhé nhưng mình test lisp không tính toán được. Ý mình là thế này: đánh lệnh atc -> chọn phép tính, ví dụ chọn phép + (cộng) thì mình chọn các số cần cộng -> enter -> chọn att hoặc DText hoặc Mtext để gán kết quả. Các bạn tham khảo lisp sau: của bác q288:

http://www.cadviet.com/forum/topic/4077-yeu-cau-lisp-cong-tru-nhan-chia-text/

lisp này: http://www.cadviet.com/upfiles/4/136880_tinh_1.lsp

nhưng mình muốn áp dụng với block ATT

 

Hề hề hề,

Không hiểu bạn đã test thế nào mà nói lisp này không dùng được???

Cách sủ dụng của lisp này khác với cái lisp của bác q288. Bạn cần làm đúng như những  yêu cầu của lisp mới được.

Đầu tiên bạn phải chọn một text thuộc tính để làm giá trị đầu tiên của phép tính bạn sẽ chọn.

Tiếp theo là nhập ký tự của phép tính.

Tiếp theo bạn sẽ phải lần lượt chọn các text thuộc tinh tiếp theo và mỗi lần chọn một text thì tùy theo phép tính bạn chọn giá trị của nó sẽ được cộng trừ hoặc nhân chia thêm vào giá trị đã có trước đó. Nếu bạn không muốn chọn tiếp thì nhấn enter khi lisp yêu cầu chọn text can tinh toán.

Cuối cùng bạn chọn một text mà bạn muốn thay thế két quả của phép tinh toán vào đó.

Lisp này mình đã test trên bản vẽ bạn gửi và chưa phát hiện ra sai sót gì.

Bạn hãy test lại theo đúng hướng dẫn trên nhé. Hy vọng bạn làm được.


<<

Filename: 344382_atc.lsp

Trang 250/315

250