Jump to content
InfoFile
Tác giả: thiep
Bài viết gốc: 412045
Tên lệnh: mdo
Khi Dùng Layiso Thì Wipeout Lại Hiện Lên ...help!

Dùng lisp này, bạn chỉ cần select một vài đối tượng (contour) muốn "ẩn" dưới Wipeout, thì tất cả các đối tượng cùng lớp với contour này sẽ "ẩn" dưới Wipeout.

Lệnh là MDO

 

;;; Lisp draworder các dôi tuong cùng layer back Wipeout
;;; Update from lisp by RenderMan 2011 (Thank RenderMan AUGI)

(defun DXF (code en) (cdr (assoc code (entget...

>>

Dùng lisp này, bạn chỉ cần select một vài đối tượng (contour) muốn "ẩn" dưới Wipeout, thì tất cả các đối tượng cùng lớp với contour này sẽ "ẩn" dưới Wipeout.

Lệnh là MDO

 

;;; Lisp draworder các dôi tuong cùng layer back Wipeout
;;; Update from lisp by RenderMan 2011 (Thank RenderMan AUGI)

(defun DXF (code en) (cdr (assoc code (entget en))))
;;;------------------------------------------------
(defun c:MDO (/ ss entlist layerList)
(vl-load-com)
(setq ss (ssget))
(setq entlist (acet-ss-to-list ss))
(setq layerList (mapcar '(lambda (x) (dxf 8 x)) entlist))
(setq layerList (ACET-LIST-REMOVE-DUPLICATES layerList nil))
(if ai_draworder
(foreach lay layerList
(if (null (ACET-LAYER-LOCKED lay))
(progn (sssetfirst nil (ssget "_x" (list (cons 8 lay))))
(ai_draworder "_Back") ;"_front"
)
(prompt
(strcat "\n** Layer not found, or locked: \"" lay "\" ** ")
)
)
)
(prompt "\n** \"ai_draworder\" is not defined, reload express tools ** "
)
)
(princ)
)


<<

Filename: 412045_mdo.lsp
Tác giả: quocmanh04tt
Bài viết gốc: 402108
Tên lệnh: qqq%C2%A0
Lisp hatch nhanh.

 

Nhờ các anh sửa giúp em sau khi thực hiện hatch xong muốn chuyển về Layer: 0 và lineweight : Bylayer mà em không chuyển được với!

(defun c:qqq ()
(command "lweight" 0.09)
(command "-layer" "m" "Hatch" "c" "8" ""...
>>

 

Nhờ các anh sửa giúp em sau khi thực hiện hatch xong muốn chuyển về Layer: 0 và lineweight : Bylayer mà em không chuyển được với!

(defun c:qqq ()
(command "lweight" 0.09)
(command "-layer" "m" "Hatch" "c" "8" "" "")
(command "-bhatch" "p" "ansi31" "5" "" ) 
(command "-layer" "s" "0"  "")
(princ))

=>​

(defun c:qqq  ()
 (command "lweight" 0.09)
 (command "-layer" "m" "Hatch" "c" "8" "" "")
 (command "-bhatch" "p" "ansi31" "5" "" pause "")
 (command "lweight" "Bylayer")
 (command "-layer" "s" "0" "")
 (princ))

<<

Filename: 402108_qqq%C2%A0.lsp
Tác giả: Bee
Bài viết gốc: 412366
Tên lệnh: demo
Lisp Tự Động Đánh Số Và Thống Kê Kích Thước Tam Giác (Đa Giác Càng Tốt Ạ)

Như tiêu đề, các bác có thể giúp em làm cái Lisp

 

- Tự đánh số tam giác,

- Xuất bảng thống kê tam giác, ví dụ tam giác "X1" có 3 cạnh A= ??? B=???? C=???.......

 

Em chân thành cảm ơn ạ.

Em không up được file mẫu... có hình đây ạ...

Demo 1 phát. Làm tí cho đỡ buồn ^_^

 

https://youtu.be/iS3042bTAd0

 

Code here:

(defun c:demo  (/ a b c doc osm i lst msp name num p pt row rws TblObj triangle txt)
  (vl-load-com)
  (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))
        msp (vla-get-modelspace doc)
	osm (getvar 'osmode)
        )
  (command "undo" "begin")
  (if (setq p (getpoint "\nVi tri dat bang thong ke: "))
    (progn
      (setvar 'osmode 0)
      (setq TblObj (vla-addtable
                     msp
                     (vlax-3d-point p)
                     2 ;NumRows
                     4 ;NumColumns
                     750 ;RowHeight 15=txt x 3
                     3000 ;ColWidth 100
                     )
            ) ;setq

      (vla-put-vertcellmargin TblObj 200)
      (vla-SetColumnWidth TblObj 0 1000)
      (vla-SetRowHeight TblObj 0 1500)
      (mapcar '(lambda (x) (vla-setTextHeight TblObj x 250))
              (list acTitleRow acHeaderRow acDataRow)
              )
      (mapcar '(lambda (x) (vla-setAlignment TblObj x 5))
              (list acTitleRow acHeaderRow acDataRow)
              )
      
      (vla-setText TblObj 0 0 "B\U+1EA3ng th\U+1ED1ng kê kích thu\U+1EDBc tam giác")
      
      (vla-setText TblObj 1 0 "STT")

      (vla-setText TblObj 1 1 "A")

      (vla-setText TblObj 1 2 "B")

      (vla-setText TblObj 1 3 "C")

      (setq i 1
            row 2)
      (setq num (getint "\nChon so ten diem bat dau: "))
        (if (null num)
          (setq num 1)
          )

      (while (setq pt (getpoint "\nChon diem dat text: "))
        
        (setq name (strcat "X" (rtos num 2 0)))
	
        (setq txt (entmake
                    (list
                      (cons 0 "TEXT")
                      (cons 40 (getvar "textsize"))
                      (cons 50 0.)
                      (cons 10 pt)
                      (cons 1 name)
                      )
                    )
              )
        (command "-boundary" "_none" pt "")
        (setq triangle (entlast))
        (setq lst (mapcar (function cdr)
                                (vl-remove-if-not (function (lambda (a) (= (car a) 10))) (entget triangle))
                                ) ;_  mapcar
                    )
        (setq a (distance (car lst) (cadr lst)))
        (setq b (distance (cadr lst) (caddr lst)))
        (setq c (distance (caddr lst) (car lst)))
        
        (setq rws (vla-Get-Rows TblObj))
        (vla-InsertRows TblObj rws (vla-GetRowHeight TblObj (1- rws)) 1);; 1 number of rows

        
        (vla-setText TblObj row 0 (rtos (1+ i) 2 0))
        (vla-setText TblObj row 1 (rtos a 2 0))
        (vla-setText TblObj row 2 (rtos b 2 0))
        (vla-setText TblObj row 3 (rtos c 2 0))
	(mapcar '(lambda (x) (vla-setTextHeight TblObj x 250))
		(list acTitleRow acHeaderRow acDataRow)
		)
	(mapcar '(lambda (x) (vla-setAlignment TblObj x 5))
		(list acTitleRow acHeaderRow acDataRow)
		)
	(setq i (1+ i)
              row (1+ row)
	      num (1+ num)
              )       
        ) ;while
      ) ;progn
    ) ;if
  (command "undo" "end")
  (setvar 'osmode osm)
  (princ)
  )

<<

Filename: 412366_demo.lsp
Tác giả: conghoa
Bài viết gốc: 412560
Tên lệnh: chl
Xin Lisp Layer, Linestyle, Linestyle Scale

+ Anh này sống ảo thế ^^ . 

Tò mò khi bạn có hơn 100 bài viết, tham gia diễn đàn từ 2008 mà vẫn nhờ viết những lisp ngây ngô thật. 

Click vô trang cá nhân thì...... nản luôn.... Chắc phải tích lũy được cả mấy chục cái dấu "--" mất @@.

 

Xin phép mọi người cho em ghim Lisp bài...

>>

+ Anh này sống ảo thế ^^ . 

Tò mò khi bạn có hơn 100 bài viết, tham gia diễn đàn từ 2008 mà vẫn nhờ viết những lisp ngây ngô thật. 

Click vô trang cá nhân thì...... nản luôn.... Chắc phải tích lũy được cả mấy chục cái dấu "--" mất @@.

 

Xin phép mọi người cho em ghim Lisp bài này. Code em viết xong rồi, có 1 mẩu, nhưng phải tuần sau em mới đăng. ^^ Để ai đó lười thì chịu khó tự học lisp vậy :P

 

Bác cứ nói thế, ai cũng có sở trường sở đoản của riêng mình. khi đã post lên xin thì nghĩa là họ không biết làm, giờ bắt họ ngồi ngâm cứu 1 câu lệnh nhỏ đi chăng nữa thì thà họ ngồi làm theo những gì trước đây họ làm con nhanh hơn :D

 

 

 

Diễn đàn thì nên là hơi giúp đỡ nhau, chứ ko nên theo kiểu đánh đố. Chỉ nên trách bạn hung1608 là bạn ấy chưa chịu tìm kiếm trước khi xin thôi

 

 

@hung1608 đây là lisp theo yêu cầu của bạn mình tìm dc ở trên mạng :)

(defun C:chl (/ e n)
(setq e (car (entsel "Pick an object on the desired Layer: ")))
(if e
(progn
(setq e (entget e))
(setq n (cdr (assoc 8 e)))
(setq newcol (cdr (assoc 62 e)))
(if (= newcol nil) (setq newcol "bylayer"))
(setq newlt (cdr (assoc 6 e)))
(if (= newlt nil) (setq newlt "bylayer"))
(setq newlwt (cdr (assoc 370 e)))
(if (= newlwt nil)
(progn
(setq newlwt "bylayer")
);close progn
(progn
(setq newlwt (/ newlwt 100.0))
);close progn
);close if
(command "layer" "s" n "")
(command "color" newcol)
(command "-lweight" newlwt)
(command "linetype" "s" newlt "")
)
)
(princ)
)

Trân trọng!


<<

Filename: 412560_chl.lsp
Tác giả: thanhduan2407
Bài viết gốc: 306042
Tên lệnh: cvt3d
Nhờ các bác xem và sửa dùm em LISP CONVRT TEXT 2D SANG TEXT 3D

Do up lên diễn đàn bị như thế đó bác. 

Em chạy LISP mượt, nhưng kết quả không như mong muốn. Tọa độ Z của nó vẫn không cập nhật.

Có một số lisp convert Text tuy nhiên định dạng nó thay đổi.

Lisp này của Lee Mac nhưng cũng không khắc phục được căn chỉnh Justify.

(defun c:CVT3D ( / e i p s z )
(if
	(setq s (ssget (list (cons 0 ...
>>

Do up lên diễn đàn bị như thế đó bác. 

Em chạy LISP mượt, nhưng kết quả không như mong muốn. Tọa độ Z của nó vẫn không cập nhật.

Có một số lisp convert Text tuy nhiên định dạng nó thay đổi.

Lisp này của Lee Mac nhưng cũng không khắc phục được căn chỉnh Justify.

(defun c:CVT3D ( / e i p s z )
(if
	(setq s (ssget (list (cons 0  "*TEXT,MTEXT"))))
	(repeat (setq i (sslength s))
		(setq e (entget (ssname s (setq i (1- i))))
		      z (atof (cdr (assoc 1 e)))
		)
		(if (or (= "MTEXT" (cdr (assoc 0 e)))
			(and (zerop (cdr (assoc 72 e))) (zerop (cdr (assoc 73 e))))
		    )
			(progn
				(setq p (assoc 10 e))
				(entmod (subst (list 10 (cadr p) (caddr p) z) p e))
			)
			(progn
				(setq p (assoc 11 e))
				(entmod
					(subst (list 10 (cadr p) (caddr p) z) (assoc 10 e)
						(subst (list 11 (cadr p) (caddr p) z) (assoc 11 e) e)
					)
				)
			)
		)
	)
)
(princ)
)

<<

Filename: 306042_cvt3d.lsp
Tác giả: a12k39duchao
Bài viết gốc: 412845
Tên lệnh: ha
Kết Hợp 2 Lisp (Nhấp Nháy Khi Di Chuột Vào Đối Tượng Và Xuất Text Dim Ra Excel)

Em có tìm được trên diễn đàn của mình có 2 lisp:

- Lisp nhấp nháy khi kích chuột vào đối tượng: mục đề #14 http://www.cadviet.com/forum/topic/101252-yeucau-lisp-di-chuyen-chuot-den-chon-pick-net-ve-thi-net-ve-nhap-nhay/

;; free lisp from cadviet.com
;;;...
>>

Em có tìm được trên diễn đàn của mình có 2 lisp:

- Lisp nhấp nháy khi kích chuột vào đối tượng: mục đề #14 http://www.cadviet.com/forum/topic/101252-yeucau-lisp-di-chuyen-chuot-den-chon-pick-net-ve-thi-net-ve-nhap-nhay/

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/101252-yeucau-lisp-di-chuyen-chuot-den-chon-pick-net-ve-thi-net-ve-nhap-nhay/

;Doan  Van Ha - CadViet.com - ngay 13/5/2014. Edit: 17/5/2014.
;Chuc nang: To dam va Highlight cac doi tuong duoc chon, dong thoi lam nhap nhay chung khi di chuot.
(vl-load-com)
(defun Draw_Grvecs(pt rad col / p0 p1 p2 p3 p4)
 (setq p0 (polar pt (/ pi -2) rad) p1 (polar p0 0 rad) p2 (polar p1 (/ pi 2) (* 2 rad)) p3 (polar p2 (/ pi -1) (* 2 rad)) p4 (polar p3 (/ pi -2) (* 2 rad)))
 (grvecs (list col p1 p2 p2 p3 p3 p4 p4 p1)))
(defun Second( / lst)
 (if (and (vl-position "acetutil.arx" (arx)) (not (vl-catch-all-error-p (vl-catch-all-apply (function (lambda nil (acet-sys-shift-down)))))))
  (progn
   (load "julian.lsp")
   (setq lst (jtoc (getvar "date")))
   (- (nth 5 lst) (fix (nth 5 lst))))
  (progn (alert "Chuong trinh yeu cau Ban phai cai dat Tool Express.") (exit))))
(defun *error* (msg)
 (redraw)
 (if (and ss (> (sslength ss) 0)) (HighLightObjects (#SS->Objlist ss) nil))
 (if (and ss2 (> (sslength ss2) 0)) (mapcar 'vla-Delete (#SS->Objlist ss2)))
 (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **")))
 (princ))
(defun HighLightObjects (lst h)
 ((lambda (x) (mapcar '(lambda (obj) (vla-highlight obj x)) lst))
  (if h :vlax-true :vlax-false)))
(defun #SS->Objlist (ss / i lst)
 (repeat (setq i (sslength ss))
  (setq lst (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) lst))))
(defun #SS->List (ss / i lst)
 (repeat (setq i (sslength ss)) (setq lst (cons (ssname ss (setq i (1- i))) lst))))
(defun COPYG(ss / lst ss2 obj1)
 (setq lst (#SS->Objlist ss) ss2 (ssadd))
 (foreach obj lst
  (vla-copy obj) (setq obj1 (vlax-ename->vla-object (entlast)))
  (vla-move obj1 (vlax-3d-point '(0 0)) (vlax-3d-point (list 0 (/ rad 5)))) (setq ss2 (ssadd (entlast) ss2))
  (vla-copy obj) (setq obj1 (vlax-ename->vla-object (entlast)))
  (vla-move obj1 (vlax-3d-point '(0 0)) (vlax-3d-point (list 0 (/ rad -5)))) (setq ss2 (ssadd (entlast) ss2))
  (vla-copy obj) (setq obj1 (vlax-ename->vla-object (entlast)))
  (vla-move obj1 (vlax-3d-point '(0 0)) (vlax-3d-point (list (/ rad 5) 0))) (setq ss2 (ssadd (entlast) ss2))
  (vla-copy obj) (setq obj1 (vlax-ename->vla-object (entlast)))
  (vla-move obj1 (vlax-3d-point '(0 0)) (vlax-3d-point (list (/ rad -5) 0))) (setq ss2 (ssadd (entlast) ss2)))
 ss2)
(defun C:HA( / rad gr code ss ss1 ss2 pt px p0 p1 p2 p3)
 (setq rad (/ (* (getvar "Viewsize") (getvar "Pickbox")) (cadr (getvar "Screensize"))) ss (ssadd))
 (princ "\nSelect objects: ")
 (while (and (setq gr (grread 't 15 1) code (car gr) pt (cadr gr)) (/= code 25) (not (equal gr '(2 13))))
  (redraw)
  (Draw_Grvecs pt rad 3)
  (cond
   ((= code 3)
    (setq p0 (polar pt (/ pi -2) rad) p1 (polar p0 0 rad) p2 (polar p1 (/ pi 2) (* 2 rad)) p3 (polar p2 (/ pi -1) (* 2 rad)))
    (setq ss1 (ssget "c" p1 p3))
(if ss1
(foreach ent (#SS->List ss1) (setq ss (ssadd ent ss)))
(progn
 (redraw)
      (setq px (getcorner pt "\nSpecify opposite corner: "))
 (if px (princ "\nSelect objects: "))
 (if (> (car pt) (car px))
       (setq ss1 (ssget "c" pt px))
       (setq ss1 (ssget "w" pt px)))
 (if ss1
  (progn
 <span> </span>    (foreach ent (#SS->List ss1) (setq ss (ssadd ent ss)))
   (HighLightObjects (#SS->Objlist ss) T))))))
   ((and (= code 5) ss (> (sslength ss) 0))
    (if (and ss2 (> (sslength ss2) 0)) (mapcar 'vla-Delete (#SS->Objlist ss2)))
    (setq ss2 (copyg ss))
    (HighLightObjects (#SS->Objlist ss) (if (or (<= 0 (Second) 0.25) (<= 0.5 (Second) 0.75)) T nil)))))
 (if (and ss (> (sslength ss) 0)) (VisibleObjects (#SS->Objlist ss) T))
 (if (and ss2 (> (sslength ss2) 0)) (mapcar 'vla-Delete (#SS->Objlist ss2)))
 (redraw)
 (princ))
(princ "\nLenh su dung: HA")
(princ)
 

 

- Lisp xuất dim text ra excel: mục đề #6 http://www.cadviet.com/forum/topic/55599-yeu-cau-lisp-lay-gia-tri-cua-dimenson-text-va-xuat-ra-file-text/

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/55599-yeu-cau-lisp-lay-gia-tri-cua-dimenson-text-va-xuat-ra-file-text/


(defun C:HA( / lst fn fw index x y z txt)	;Doan Van Ha Cadviet.com

 (princ "\nChon cac Text/Mtext/Dimension can xuat ra file...")

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

       	fn (getfiled "Chon file de save" "" "csv" 1)

       	fw (open fn "w")

       	index 0 x 1 y 1 z 1)

 (repeat (length lst)

  (cond

   ((= (cdr (assoc 0 (entget (nth index lst)))) "TEXT") (setq txt (strcat (cdr (assoc 1 (entget (nth index lst)))) "," "text" (itoa x)) x (1+ x)))

   ((= (cdr (assoc 0 (entget (nth index lst)))) "MTEXT") (setq txt (strcat (cdr (assoc 1 (entget (nth index lst)))) "," "mtext" (itoa y)) y (1+ y)))

   ((= (cdr (assoc 0 (entget (nth index lst)))) "DIMENSION")

	(if (= (cdr (assoc 1 (entget (nth index lst)))) "")

 	(setq txt (strcat (rtos (cdr (assoc 42 (entget (nth index lst))))) "," "dim" (itoa z)) z (1+ z))

 	(setq txt (strcat (cdr (assoc 1 (entget (nth index lst)))) "," "dim" (itoa z)) z (1+ z)))))

  (princ (strcat txt "\n") fw)

  (setq index (1+ index)))

 (close fw))


 

- Mong muốn: Kết hợp 2 lisp trên lại để khi chọn đối tượng dim rồi thì đối tượng đó sáng lên để không bị chọn lại lần nữa, tránh nhầm lẫn.

 Chân thành cảm ơn mọi người!

 


<<

Filename: 412845_ha.lsp
Tác giả: Bee
Bài viết gốc: 412875
Tên lệnh: test1 test2
Điều Chỉnh Toàn Bộ Text

hiện giờ e vẫn đang làm như thế.

nhưng mà mỗi lần làm thế mất tầm 20-30s.

mà trong 1 buổi thì em phải làm thế tầm 30-40 lần nên cũng tương đối mất công nên mới lên mạn phép nhờ mọi người tạo hộ cái lisp :)

Thử cái này xem nhé. ^_^

(defun...
>>

hiện giờ e vẫn đang làm như thế.

nhưng mà mỗi lần làm thế mất tầm 20-30s.

mà trong 1 buổi thì em phải làm thế tầm 30-40 lần nên cũng tương đối mất công nên mới lên mạn phép nhờ mọi người tạo hộ cái lisp :)

Thử cái này xem nhé. ^_^

(defun Bee_run (ss / n vlaobj)
  (if (tblsearch "style" "gaiheki")
    (command "-style" "gaiheki" "romans.shx" 50. 0.75 "" "" "" "")
    )
  (if ss
    (progn
      (setq n 0)
      (repeat (sslength ss)
        (setq vlaobj (vlax-ename->vla-object (ssname ss n)))
        (if (= (vlax-get vlaobj 'StyleName) "bigfont")
          (vlax-put vlaobj 'StyleName  "standard")
          )
        (vlax-put vlaobj 'Height  100.)
        (vlax-put vlaobj 'ScaleFactor  0.55)
        (setq n (1+ n))
        )      
      )
    )
  )
(defun c:test1 ()                
  (Bee_run (ssget "_X" '((0 . "TEXT,MTEXT"))))
  (princ)
  )
(defun c:test2 ()                
  (Bee_run (ssget '((0 . "TEXT,MTEXT"))))
  (princ)
  )

<<

Filename: 412875_test1_test2.lsp
Tác giả: vodoifx
Bài viết gốc: 412902
Tên lệnh: x22
Lisp các phép tính đại số tự động cập nhật khi giá trị nguồn thay đổi

Chào các anh. Đoạn lisp của anh nataca em có sửa lại với mục đích không phải chọn lại đối tượng mới vẽ nhưng chưa thành công, mong các anh chỉnh lại giúp em với ạ.

 

 

(setq
Tyle 1
tphan 2
)
(defun C:x22 (/ obn Tkq)
(setq G1 (Getpoint "\nChon Diem Bat dau : "))
(setq G2 (Getpoint "\nChon Diem ket thuc: "))
(command "Pline" g1 g2 "")
(setq et (entlast))
; (setq obn...

>>

Chào các anh. Đoạn lisp của anh nataca em có sửa lại với mục đích không phải chọn lại đối tượng mới vẽ nhưng chưa thành công, mong các anh chỉnh lại giúp em với ạ.

 

 

(setq
Tyle 1
tphan 2
)
(defun C:x22 (/ obn Tkq)
(setq G1 (Getpoint "\nChon Diem Bat dau : "))
(setq G2 (Getpoint "\nChon Diem ket thuc: "))
(command "Pline" g1 g2 "")
(setq et (entlast))
; (setq obn (vlax-ename->vla-object (car (entsel "\nChon doi tuong nguon")))
(setq obn (vlax-ename->vla-object (car et))
obd (vlax-ename->vla-object (car (nentsel "\nChon text ghi chieu dai")))
Tkq (strcat
"%<\\AcObjProp Object(%<\\_ObjId "
(rtos (vla-get-objectid obn) 2 0)">%).Length \\f \"%lu2"
"%pr" (rtos tphan 2 0) "%ct8" "\">%"
)
)
(vla-put-textstring obd Tkq)
(vl-cmdf "regen")

(princ)
)


<<

Filename: 412902_x22.lsp
Tác giả: Bee
Bài viết gốc: 413032
Tên lệnh: field to text
Hỏi Cách Thay Đổi Hàng Loạt Công Thức Field Trong Text?

Hoặc remove filed hàng loạt ^_^

(defun c:field_to_text (/ ss e i)
  (if (setq ss (ssget '((0 . "TEXT")))
      )
    (repeat (setq i (sslength ss))
      (setq
	e (ssname ss (setq i (1- i)))
      )
      (if (dictsearch (cdr (assoc 360 (entget e))) "ACAD_FIELD")
	(dictremove (cdr (assoc 360 (entget e))) "ACAD_FIELD")

      )
    )

  )
  (princ)
)

Filename: 413032_field_to_text.lsp
Tác giả: Tot77
Bài viết gốc: 338784
Tên lệnh: te
Hỏi về Lisp (thuật toán, ý tưởng, coding,...)

Thay vì ssget "C" bạn thử dùng ssget "F" như này xem sao.

(defun c:te (/ A N SS) 
(setq ss (ssget "f" (list (setq a (getpoint)) (getpoint a)))
n 0)
(while (> (sslength ss ) 0)
(command "change" (ssname ss 0) "" "P" "c" (itoa (setq n (1+ n))) "")
(ssdel (ssname ss 0) ss)
)
)

Filename: 338784_te.lsp
Tác giả: lp_hai
Bài viết gốc: 103581
Tên lệnh: cheo
vướng mắc autolisp tìm lời giải đáp

mình gửi một lisp này làm vd nha

lisp này vẽ đường chéo một hinh chữ nhậ có sẵn. như bạn thấy ở hàm chính là hàm defun C:cheo() ko hề có lệnh vẽ line nào. còn ở hàm con là (defun veline(A :undecided: có 2 biến là A và B
khi ở hàm chính gọi hàm con (veline PT1 PT3) thì hàm con sẽ làm việc...
>>

mình gửi một lisp này làm vd nha

lisp này vẽ đường chéo một hinh chữ nhậ có sẵn. như bạn thấy ở hàm chính là hàm defun C:cheo() ko hề có lệnh vẽ line nào. còn ở hàm con là (defun veline(A :undecided: có 2 biến là A và B
khi ở hàm chính gọi hàm con (veline PT1 PT3) thì hàm con sẽ làm việc với 2 tham số thế vào là PT1 và PT3 (là vẽ line từ điểm A(khi này là pt1) đến diểm B(là pt2) )
tương tự như vậy cho lần gọi sau...
hy vọng giúp ích dc cho bạn!
<<

Filename: 103581_cheo.lsp
Tác giả: Bee
Bài viết gốc: 413217
Tên lệnh: test
Xác Định 2 Đỉnh Đối Nhau Của Khung Tên Được Xref

Xin chào các bác. Em muốn xác định 2 đỉnh đối nhau của khung tên được Xref để làm lisp IN . Mong các bác chỉ giáo thêm, em xin cảm ơn

Có thể dùng box của Lee nhé. ^_^

Code here:

(defun c:test ( / ent )
    (if (setq ent (car (entsel)))
        (entmake
           ...
>>

Xin chào các bác. Em muốn xác định 2 đỉnh đối nhau của khung tên được Xref để làm lisp IN . Mong các bác chỉ giáo thêm, em xin cảm ơn

Có thể dùng box của Lee nhé. ^_^

Code here:

(defun c:test ( / ent )
    (if (setq ent (car (entsel)))
        (entmake
            (append
               '(
                    (000 . "LWPOLYLINE")
                    (100 . "AcDbEntity")
                    (100 . "AcDbPolyline")
                    (090 . 4)
                    (070 . 1)
                )
                (mapcar '(lambda ( p ) (cons 10 p)) (LM:boundingbox (vlax-ename->vla-object ent)))
            )
        )
    )
    (princ)
)
(vl-load-com) (princ)

;; Bounding Box  -  Lee Mac
;; Returns the point list describing the rectangular frame bounding the supplied object.
;; obj - [vla] VLA-Object

(defun LM:boundingbox ( obj / a b lst )
    (if
        (and
            (vlax-method-applicable-p obj 'getboundingbox)
            (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'a 'b))))
            (setq lst (mapcar 'vlax-safearray->list (list a b)))
        )
        (mapcar '(lambda ( a ) (mapcar '(lambda ( b ) ((eval b) lst)) a))
           '(
                (caar   cadar)
                (caadr  cadar)
                (caadr cadadr)
                (caar  cadadr)
            )
        )
    )
)

<<

Filename: 413217_test.lsp
Tác giả: vietanh2108
Bài viết gốc: 413281
Tên lệnh: feq
Lisp Tìm Và Thay Thế Text Theo Mẫu Có Sẵn

Bạn sử dụng lệnh FIND của CAD cũng được, tuy nhiên nhược điểm là gọi lệnh này sẽ hiện Dialog và mất thời gian load. Góp vui cho bạn một LISP tìm và thay thế tự động!

;superstr.lsp l. gabriel 11-11-1996  22:04:42
;
;object: string search and replace. Works for both text and attributes. Program
;        will globally search and replace every text/attribute within the selection set.
;
;Rev...
>>

Bạn sử dụng lệnh FIND của CAD cũng được, tuy nhiên nhược điểm là gọi lệnh này sẽ hiện Dialog và mất thời gian load. Góp vui cho bạn một LISP tìm và thay thế tự động!

;superstr.lsp l. gabriel 11-11-1996  22:04:42
;
;object: string search and replace. Works for both text and attributes. Program
;        will globally search and replace every text/attribute within the selection set.
;
;Rev 1.0 Added Dimension string search and replace l. gabriel 06.12.08
;
(defun atext (num)
   (cdr (assoc num d))
)
;
(defun echooff ()
  (setq oldecho (getvar "CMDECHO"))
  (setq oldblip (getvar "BLIPMODE"))
  (setq oldosm (getvar "OSMODE"))
  (setvar "CMDECHO" 0)
  (setvar "BLIPMODE" 0)
  (setvar "OSMODE" 0)
  (setq olderror_echo *ERROR*)
  (terpri)
  (defun *ERROR* (msg)
    (princ " \n")
    (princ msg)
    (echoon)
  )
)
;
(defun echoon ()
  (setvar "CMDECHO" oldecho)
  (setvar "BLIPMODE" oldblip)
  (setvar "OSMODE" oldosm)
  (setq *ERROR* olderror_echo)
  (princ)
)
;super search and replace routine
(defun c:FEQ()
    (echooff)
    (setq olsosmode (getvar "OSMODE"))
    (setvar "OSMODE" 0)
    (setq p (ssget))   
    (if p 
	(progn 
            (setq osl (strlen (setq os (getstring "\nOld string: " t))))
            (setq nsl (strlen (setq ns (getstring "\nNew string: " t))))
	    (setq l 0 chm 0 n (sslength p))
	    (setq adj 
		(cond 
		    ((/= osl nsl) (- nsl osl))
		    (T nsl)
		)
	    )
	(while (< l n)                   
	    (setq d (entget (setq e (ssname p l))))
	    (if (and (= (atext 0) "INSERT")(= (atext 66) 1))
		(progn
		    (setq e (entnext e))
		    (while e
			(setq d (entget e))
			(cond 
			    ((= (atext 0) "ATTRIB")
				(setq chf nil si 1)
				(setq s (cdr (setq as (assoc 1 d))))
				(while (= osl (setq sl (strlen
				    (setq st (substr s si osl)))))
				    (cond
					((= st os)
					    (setq s (strcat (substr s 1 (1- si)) ns
					    (substr s (+ si osl))))
					    (setq chf t)
					    (setq si (+ si adj))
					)
				    )
				(setq si (1+ si))
			    )
			    (if chf 
				(progn        
				    (setq d (subst (cons 1 s) as d))
				    (entmod d)	       
				    (entupd e)	       
				    (setq chm (1+ chm))
				)
			    )
			    (setq e (entnext e))
			    )
			    ((= (atext 0) "SEQEND")
				(setq e nil)) 
			    (T (setq e (entnext e)))
                        )
		    )
		)
	    )
            (if (= "MTEXT"            ; Look for MTEXT entity type (group 0)
               (cdr (assoc 0 (setq e (entget (ssname p l))))))
                  (progn
                     (setq chf nil si 1)
                     (setq s (cdr (setq as (assoc 1 e))))
                     (while (= osl (setq sl (strlen
                        (setq st (substr s si osl)))))
                        (if (= st os)
                           (progn
                              (setq s (strcat (substr s 1 (1- si)) ns
                                        (substr s (+ si osl))))
                           (setq chf t) ; Found old string
                        (setq si (+ si nsl))
                      )
                      (setq si (1+ si))
                  )
               )
               (if chf (progn        ; Substitute new string for old
                  (setq e (subst (cons 1 s) as e))
                  (entmod e)         ; Modify the TEXT entity
                  (setq chm (1+ chm))
               ))
            )
         )
	    (if (= "DIMENSION"            ; Look for DIMENSION entity type (group 0)
               (cdr (assoc 0 (setq e (entget (ssname p l))))))
                  (progn
                     (setq chf nil si 1)
                     (setq s (cdr (setq as (assoc 1 e))))
                     (while (= osl (setq sl (strlen
                        (setq st (substr s si osl)))))
                        (if (= st os)
                           (progn
                              (setq s (strcat (substr s 1 (1- si)) ns
                                        (substr s (+ si osl))))
                           (setq chf t) ; Found old string
                        (setq si (+ si nsl))
                      )
                      (setq si (1+ si))
                  )
               )
               (if chf (progn        ; Substitute new string for old
                  (setq e (subst (cons 1 s) as e))
                  (entmod e)         ; Modify the TEXT entity
                  (setq chm (1+ chm))
               ))
            )
         )
	    (if (= "TEXT"            ; Look for TEXT entity type (group 0)
               (cdr (assoc 0 (setq e (entget (ssname p l))))))
                  (progn
                     (setq chf nil si 1)
                     (setq s (cdr (setq as (assoc 1 e))))
                     (while (= osl (setq sl (strlen
                        (setq st (substr s si osl)))))
                        (if (= st os)
                           (progn
                              (setq s (strcat (substr s 1 (1- si)) ns
                                        (substr s (+ si osl))))
                           (setq chf t) ; Found old string
                        (setq si (+ si nsl))
                      )
                      (setq si (1+ si))
                  )
               )
               (if chf (progn        ; Substitute new string for old
                  (setq e (subst (cons 1 s) as e))
                  (entmod e)         ; Modify the TEXT entity
                  (setq chm (1+ chm))
               ))
            )
         )
         (setq l (1+ l))
	)
	)
    )
    (if (> chm 1)
       (princ (strcat "\nUpdated " (itoa chm) " text strings"))
       (princ (strcat "\nUpdated " (itoa chm) " text string"))
    )
    (setvar "OSMODE" oldosmode)
    (terpri)
    (echoon)
)

<<

Filename: 413281_feq.lsp
Tác giả: Bee
Bài viết gốc: 413271
Tên lệnh: test
Nhờ Viết Lisp Tạo Block Attribute Từ Text

Thưa các bác, kiểu là em có sẵn 1 block CODE_COL vs 4 attribute

-Tên_cột

-Cao_đáy

-Cao_đỉnh

-Trừ_cao

và mặt bằng có text tên cột C1, C2... Cn. Em muốn chọn tất cả các text tên cọc và chạy LISP để biến tất cả các text tên cột đó thành block CODE_COL vs tên cột được đưa vào attribute...

>>

Thưa các bác, kiểu là em có sẵn 1 block CODE_COL vs 4 attribute

-Tên_cột

-Cao_đáy

-Cao_đỉnh

-Trừ_cao

và mặt bằng có text tên cột C1, C2... Cn. Em muốn chọn tất cả các text tên cọc và chạy LISP để biến tất cả các text tên cột đó thành block CODE_COL vs tên cột được đưa vào attribute Tên_cột... bác nào đi qua giúp dùm em với, em xin cám ơn trc!

Nghịch tí nào. Lisp yêu cầu là đã có block CODE_COL trong bản vẽ nhé. ^_^

(defun c:test (/ osm ss n value ins)
  (setq osm (getvar 'osmode))
  (if (setq ss (ssget '((0 . "TEXT"))))
    (progn
      (setq n 0)
      (repeat (sslength ss)
	(setq value (cdr (assoc 1 (entget (ssname ss n)))))
	(setq ins (cdr (assoc 10 (entget (ssname ss n)))))
	(mapcar 'setvar (mapcar 'vl-list->string (list '(65 84 84 68 73 65) '(79 83 77 79 68 69))) '(0 0))
	(command "insert" "CODE_COL" ins 1 1 0 value "" "" "")
	(entdel (ssname ss n))
	(setq n (1+ n))
	)
      )
    (princ "\nBan da khong chon text.")
    );if
  (setvar 'osmode osm)
  (princ)
  )

<<

Filename: 413271_test.lsp
Tác giả: a12k39duchao
Bài viết gốc: 413402
Tên lệnh: ha
Lisp Tự Động Đo Và Ghi Kích Thước Nhiều Đối Tượng

Ý bạn là gì :) 2 ý tưởng này thực hiện nó không khó tí nào :)
Ý tưởng 1 mình có viết đo hàng loạt đoạn thẳng rồi, bạn lấy chỉnh sửa khoảng cách thôi.

Ý bạn là gì :) 2 ý tưởng này thực hiện nó không khó tí nào :)
Ý tưởng 1 mình có viết đo hàng loạt đoạn thẳng rồi, bạn lấy chỉnh sửa khoảng cách thôi.
http://www.cadviet.com/forum/topic/166596-xin-lisp-tu-dong-do-chieu-dai-nhieu-line-ko-tinh-tong/
Ý tưởng 2 thì lấy 2 đầu defpoint rồi entmake Line :)

Cảm ơn Anh ketxu.
1. Em cũng có xài lisp của Anh nhưng thấy rằng. Đối tượng vẫn là dimension nhưng không thể export tới excel bằng lisp này được

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/55599-yeu-cau-lisp-lay-gia-tri-cua-dimenson-text-va-xuat-ra-file-text/


(defun C:HA( / lst fn fw index x y z txt)	;Doan Van Ha Cadviet.com

 (princ "\nChon cac Text/Mtext/Dimension can xuat ra file...")

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

       	fn (getfiled "Chon file de save" "" "csv" 1)

       	fw (open fn "w")

       	index 0 x 1 y 1 z 1)

 (repeat (length lst)

  (cond

   ((= (cdr (assoc 0 (entget (nth index lst)))) "TEXT") (setq txt (strcat (cdr (assoc 1 (entget (nth index lst)))) "," "text" (itoa x)) x (1+ x)))

   ((= (cdr (assoc 0 (entget (nth index lst)))) "MTEXT") (setq txt (strcat (cdr (assoc 1 (entget (nth index lst)))) "," "mtext" (itoa y)) y (1+ y)))

   ((= (cdr (assoc 0 (entget (nth index lst)))) "DIMENSION")

	(if (= (cdr (assoc 1 (entget (nth index lst)))) "")

 	(setq txt (strcat (rtos (cdr (assoc 42 (entget (nth index lst))))) "," "dim" (itoa z)) z (1+ z))

 	(setq txt (strcat (cdr (assoc 1 (entget (nth index lst)))) "," "dim" (itoa z)) z (1+ z)))))

  (princ (strcat txt "\n") fw)

  (setq index (1+ index)))

 (close fw))



và em muốn vẫn hiện các đường gióng có được không (anh cứ để 2 phương án nha  :) )

2. Lệnh entmake Line này có từ cad bao nhiêu trở lên vậy. Vì em đang xài cad 2007.

Cảm ơn Anh ketxu


<<

Filename: 413402_ha.lsp
Tác giả: Danh Cong
Bài viết gốc: 413448
Tên lệnh: ha
Lisp Tự Động Đo Và Ghi Kích Thước Nhiều Đối Tượng

Mình  sửa luôn trong lisp bác #Ha < bên dưới này > cho bạn. Bạn copy về xem thế nào. Bạn nên cám ơn những người cống hiến vì diễn đàn nhiều như bác Kết vs bác Bee kia kìa. :) Mình đi học mót thôi, trình còn gà lắm.

;; free lisp from cadviet.com
;;; this lisp was downloaded from...
>>

Mình  sửa luôn trong lisp bác #Ha < bên dưới này > cho bạn. Bạn copy về xem thế nào. Bạn nên cám ơn những người cống hiến vì diễn đàn nhiều như bác Kết vs bác Bee kia kìa. :) Mình đi học mót thôi, trình còn gà lắm.

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/55599-yeu-cau-lisp-lay-gia-tri-cua-dimenson-text-va-xuat-ra-file-text/


(defun C:HA( / lst fn fw index x y z txt)	;Doan Van Ha Cadviet.com

 (princ "\nChon cac Text/Mtext/Dimension can xuat ra file...")

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

       	fn (getfiled "Chon file de save" "" "csv" 1)

       	fw (open fn "w")

       	index 0 x 1 y 1 z 1)

 (repeat (length lst)

  (cond

   ((= (cdr (assoc 0 (entget (nth index lst)))) "TEXT") (setq txt (strcat (cdr (assoc 1 (entget (nth index lst)))) "," "text" (itoa x)) x (1+ x)))

   ((= (cdr (assoc 0 (entget (nth index lst)))) "MTEXT") (setq txt (strcat (cdr (assoc 1 (entget (nth index lst)))) "," "mtext" (itoa y)) y (1+ y)))

   ((= (cdr (assoc 0 (entget (nth index lst)))) "DIMENSION")

	(if (= (cdr (assoc 1 (entget (nth index lst)))) "")

 	(setq txt (strcat (rtos (cdr (assoc 42 (entget (nth index lst))))) "," "dim" (itoa z) "," (cdr (assoc 8 (entget (nth index lst))))) z (1+ z))

 	(setq txt (strcat (cdr (assoc 1 (entget (nth index lst)))) "," "dim" (itoa z)  "," (cdr (assoc 8 (entget (nth index lst))))) z (1+ z)))))

  (princ (strcat txt "\n") fw)

  (setq index (1+ index)))

 (close fw))




<<

Filename: 413448_ha.lsp
Tác giả: quocmanh04tt
Bài viết gốc: 413610
Tên lệnh: tt
Hỏi về Lisp (thuật toán, ý tưởng, coding,...)
Có cái này đơn giản hơn này:
(defun c:tt (/ a b c l)
(cond ((setq a (entsel))
(and (eq (cdr (assoc 0 (entget (car a)))) "INSERT")
(setq b (nentselp (cadr a)))
(eq (cdr (assoc 0 (entget (car B)))) "LWPOLYLINE")
(setq c (entmakex (entget (car B))))
(not (vla-transformby (vlax-ename->vla-object c) (vlax-tmatrix (caddr B))))
(setq l (mapcar 'cdr (vl-remove-if-not '(lambda (x) (eq (car x) 10)) (entget c))))
(entdel c))))
l)

Filename: 413610_tt.lsp
Tác giả: Bee
Bài viết gốc: 413609
Tên lệnh: test
Hỏi về Lisp (thuật toán, ý tưởng, coding,...)

Mọi người cho hỏi ngu tí:

Tôi có 1 block_att chứa 1 pline và 1 att, đem chèn nó vào điểm A, sau đó move qua điểm B. Làm thế nào để lấy tọa độ các đỉnh pline khi chọn block đã move? Vì khi lấy entget của các đối tượng con của block thì tọa độ pline nó lấy tọa độ lúc chèn (điểm A) chứ không phải...

>>

Mọi người cho hỏi ngu tí:

Tôi có 1 block_att chứa 1 pline và 1 att, đem chèn nó vào điểm A, sau đó move qua điểm B. Làm thế nào để lấy tọa độ các đỉnh pline khi chọn block đã move? Vì khi lấy entget của các đối tượng con của block thì tọa độ pline nó lấy tọa độ lúc chèn (điểm A) chứ không phải tọa độ sau move (điểm 'B). Không nổ block nhé.

Cách khác,

Bác Hạ tham khảo code này của Giles, pline thì bác thay ngon lành qua matrix ^_^

;; Entmatrix
;; Returns a list which first item is the 3X3 tranformation matrix and second item
;; the insertion point of a block refernce in its owner (space or block definition)
(defun EntMatrix (ename / elst ang norm)
  (setq	elst (entget ename)
	ang  (cdr (assoc 50 elst))
	norm (cdr (assoc 210 elst))
  )
  (list
    (mxm
      (mapcar (function (lambda (v) (trans v 0 norm T)))
	      '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
      )
      (mxm
	(list (list (cos ang) (- (sin ang)) 0.0)
	      (list (sin ang) (cos ang) 0.0)
	      '(0.0 0.0 1.0)
	)
	(list (list (cdr (assoc 41 elst)) 0.0 0.0)
	      (list 0.0 (cdr (assoc 42 elst)) 0.0)
	      (list 0.0 0.0 (cdr (assoc 43 elst)))
	)
      )
    )
    (trans (cdr (assoc 10 elst)) norm 0)
  )
)

;; Blk2Coord
;; Returns a list of a block reference entities coordinates
(defun Blk2Coord (ref mat ins / blk ent lst)
  (setq blk (tblsearch "BLOCK" (cdr (assoc 2 (entget ref)))))
  (setq ent (cdr (assoc -2 blk)))
  (while ent
    (setq elst (entget ent)
	  typ  (cdr (assoc 0 elst))
    )
    (cond
      ((= "LINE" typ)
       (setq lst (cons (list typ
			     (mapcar '+ ins (mxv mat (cdr (assoc 10 elst))))
			     (mapcar '+ ins (mxv mat (cdr (assoc 11 elst))))
		       )
		       lst
		 )
       )
      )
      ((member typ '("POINT" "TEXT"))
       (setq lst (cons (list typ
			     (mapcar '+ ins (mxv mat (cdr (assoc 10 elst))))
		       )
		       lst
		 )
       )
      )
      ((= "INSERT" typ)
       (setq nent (EntMatrix ent))
       (setq lst
	      (append
		lst
		(Blk2Coord ent
			   (mxm  mat (car nent))
			   (mapcar '+ ins (mxv mat (cadr nent)))
		)
	      )
       )
      )
      (T nil)
    )
    (setq ent (entnext ent))
  )
  (cons (list (cdr (assoc 2 blk)) ins) lst)
)

;; Transpose a matrix Doug Wilson
(defun trp (m)
  (apply 'mapcar (cons 'list m))
)

;; Apply a transformation matrix to a vector by Vladimir Nesterovsky
(defun mxv (m v)
  (mapcar (function (lambda (r) (apply '+ (mapcar '* r v))))
	  m
  )
)

;; Multiply two matrices by Vladimir Nesterovsky
(defun mxm (m q)
  (mapcar (function (lambda (r) (mxv (trp q) r))) m)
)

;; Main function

(defun c:test (/ ss n ent mtx lst)
  (if (setq ss (ssget '((0 . "INSERT"))))
    (repeat (setq n (sslength ss))
      (setq ent	(ssname ss (setq n (1- n)))
	    mtx	(EntMatrix ent)
	    lst	(append (Blk2Coord ent (car mtx) (cadr mtx)) lst)
      )
    )
  )
  (mapcar 'print lst)
  (textscr)
  (princ)
)

<<

Filename: 413609_test.lsp
Tác giả: Bee
Bài viết gốc: 411708
Tên lệnh: tru
Nhờ Sửa Lisp Trừ 2 Text

up ai giup minh voi

Đây.

(defun c:tru  (/ l)
  (entmod
    (subst (cons 1
                 (rtos (- (atof (cdr (assoc 1 (entget (car (entsel "\nChon TEXT tru: "))))))
                          (atof (cdr (assoc 1 (entget (car (entsel "\nChon TEXT bi tru: "))))))
                          )
                       2
          ...
>>

up ai giup minh voi

Đây.

(defun c:tru  (/ l)
  (entmod
    (subst (cons 1
                 (rtos (- (atof (cdr (assoc 1 (entget (car (entsel "\nChon TEXT tru: "))))))
                          (atof (cdr (assoc 1 (entget (car (entsel "\nChon TEXT bi tru: "))))))
                          )
                       2
                       2
                       )
                 )
           (assoc 1 (setq l (entget (car (entsel "\nChon TEXT ket qua: ")))))
           l
           )
    )
  (princ)
  )

<<

Filename: 411708_tru.lsp
Tác giả: gia_bach
Bài viết gốc: 53470
Tên lệnh: txtfr
Hướng dẫn lập trình Lisp

Chào bạn tuan_thietkedien.
Bạn thử dùng lại LISP này nhé.
Hy vọng kết quả khả quan hơn.

Filename: 53470_txtfr.lsp

Trang 216/306

216