Jump to content
InfoFile
Tác giả: ketxu
Bài viết gốc: 186685
Tên lệnh: test
[Yêu cầu] Lisp dim các block không thẳng hàng!
Ví dụ 1 : Theo quy luật trái -> phải
Quick code, k bắt lỗi,không khử biến, vì mình vội quá rồi. Bạn hãy làm từng khoảng 1, khi mà quy luật trái -> phải vẫn đúng với mong muốn của bạn

(defun c:test ()
(vl-load-com)
(setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(defun ST:SS->List-Vla (ss / n e l)
(setq n (sslength ss))
(while (setq e (ssname ss (setq...
>>
Ví dụ 1 : Theo quy luật trái -> phải
Quick code, k bắt lỗi,không khử biến, vì mình vội quá rồi. Bạn hãy làm từng khoảng 1, khi mà quy luật trái -> phải vẫn đúng với mong muốn của bạn

(defun c:test ()
(vl-load-com)
(setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(defun ST:SS->List-Vla (ss / n e l)
(setq n (sslength ss))
(while (setq e (ssname ss (setq n (1- n))))
(setq l (cons (vlax-ename->vla-object e) l))
)
)
(defun CV:Geom-Midpoint (p1 p2 )(mapcar '(lambda (x y) (* (+ x y) 0.5)) p1 p2))
(defun block_base (block)(vlax-get block 'InsertionPoint))
(setq ss (vl-sort (ST:SS->List-Vla(ssget (list (cons 0 "INSERT")(cons 2 "BT 06")))) '(lambda(x y)(< (car (block_base x))(car (block_base y))))))
(setq obj (car ss) obj1 (cadr ss) disBase (distance (setq p1 (block_base obj)) (setq p2 (block_base obj1))) p (CV:Geom-Midpoint p1 p2))
(setq uv (mapcar '- (getpoint p "\nDiem dat text : ") p) i 0 3d vlax-3d-point)
(repeat (length ss)
(setq obj (nth i ss) obj1 (nth (setq i (1+ i)) ss) p1 (block_base obj) p2 (block_base obj1) p (CV:Geom-Midpoint p1 p2) p (mapcar '+ p uv))
(vla-AddDimAligned mspace (3d p1)(3d p2) (3d p))
)
)

Ngoài ra bạn tự sửa "BT 06" thành tên gì đó khác theo tên Block bạn xử lý
<<

Filename: 186685_test.lsp
Tác giả: snowman.hms
Bài viết gốc: 351896
Tên lệnh: test
lisp copy nội dung text trong một loạt dimenson...

lisp có tác dụng là lọc lấy phần text của tất cả các kích thước m chọn

Filename: 351896_test.lsp
Tác giả: snowman.hms
Bài viết gốc: 351888
Tên lệnh: rcn
Lisp vẽ Line hoặc Polyline trim
Làm sao khi mình vẽ một line hoặc polyline thì các đoạn thằng bên trong hình chữ nhật được cắt bởi hình chữ nhật đó

Filename: 351888_rcn.lsp
Tác giả: Tot77
Bài viết gốc: 313717
Tên lệnh: test
Một số hàm con VL- hữu ích

Tôi đâu biết cái nào bạn biết rồi, cái nào bạn chưa biết. Nhỡ nhè cái bạn biết rồi mà nói thì đâm ra thừa. 

Tuy nhiên thấy các bạn nhiệt tình nên cũng giới thiệu cho bạn cái hàm vlax-curve-getClosestPointTo mà mấy cái lisp gần đây tôi hay dùng.

Dạng của nó là  (vlax-curve-getClosestPointTo doituong diem ) 

Mục đích là lấy điểm nằm trên curve gần với điểm cho trước nhất...

>>

Tôi đâu biết cái nào bạn biết rồi, cái nào bạn chưa biết. Nhỡ nhè cái bạn biết rồi mà nói thì đâm ra thừa. 

Tuy nhiên thấy các bạn nhiệt tình nên cũng giới thiệu cho bạn cái hàm vlax-curve-getClosestPointTo mà mấy cái lisp gần đây tôi hay dùng.

Dạng của nó là  (vlax-curve-getClosestPointTo doituong diem ) 

Mục đích là lấy điểm nằm trên curve gần với điểm cho trước nhất (hay còn gọi là điểm thẳng góc ngắn nhất)

Để minh họa thì bạn hãy vẽ 1 line, 1 pline, 1 arc, 1 circle hay bất cứ dtg nào bạn muốn (trừ block) rồi chạy cái lsp dưới đây.

Nó sẽ vẽ 2 đường : màu đỏ với tham số nil và màu vàng với tham số t.

(defun c:test ()
  (setq a (car (entsel "\nChon doi tuong:"))
b (getpoint "\nChon diem:"))
  (entmake (list (cons 0 "LINE") (cons 10 b) (cons 11 (vlax-curve-getClosestPointTo a b))
(cons 62 1)))
  (entmake (list (cons 0 "LINE") (cons 10 b) (cons 11 (vlax-curve-getClosestPointTo a b t))
(cons 62 2)))
)

<<

Filename: 313717_test.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 353217
Tên lệnh: cpl
Lisp copy text, kết quả đổi sang layer hiện hành
Nếu bạn phải copy 1 đối tượng (layer 1) sang bên cạnh rồi lại đổi nó về layer khác (layer hiện hành: layer 2)
Lisp sẽ copy thực hiện được kết quả luôn như thế. Kết quả: sẽ chuyển sang layer hiện hành

Filename: 353217_cpl.lsp
Tác giả: ketxu
Bài viết gốc: 354062
Tên lệnh: t2b
Thay thế tên block bằng bản vẽ block

Table bạn lấy từ Datalink thì k nên Explode ra. Tranh thủ chờ Arsenal chưa đá mình quick code cho bạn. K bắt lỗi nhé. Số cột mình để là biến, đề phòng cấu trúc bảng của bạn thay đổi. Gluck

(defun c:t2b(/ GetObjectID  *adoc*  *ul* *bl* c1 rs n r ss)
; Replace Text to Block preview in table
; Ketxu 30-5-2015
(defun GetObjectID (ul obj)
	(if (vl-string-search "64" (getenv...
>>

Table bạn lấy từ Datalink thì k nên Explode ra. Tranh thủ chờ Arsenal chưa đá mình quick code cho bạn. K bắt lỗi nhé. Số cột mình để là biến, đề phòng cấu trúc bảng của bạn thay đổi. Gluck

(defun c:t2b(/ GetObjectID  *adoc*  *ul* *bl* c1 rs n r ss)
; Replace Text to Block preview in table
; Ketxu 30-5-2015
(defun GetObjectID (ul obj)
	(if (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
	(vlax-invoke-method ul 'GetObjectIdString obj :vlax-false )
	(vla-get-Objectid obj))
)
(setq *adoc*(vla-get-ActiveDocument (vlax-get-acad-object))
      *ul* 	(vla-get-Utility *adoc*)
	  *bl* 	(vla-get-blocks *adoc*)	  
	  ss	(ssget (list (cons 0 "ACAD_TABLE")))
	  ss 	(vla-get-ActiveSelectionSet *adoc*)	  
)
(or c (setq c 3))
(setq c	(cond ((getint (strcat "\nColumn to replace <" (itoa c) "> :")))(c)) c1 (1- c))
(vlax-map-collection *bl* '(lambda(x / n)
	(if (and
		(= (vla-get-isXref x) :VLAX-FALSE)
		(= (vla-get-islayout x) :VLAX-FALSE)
		(not (wcmatch (setq n (vla-get-name x)) "*`**,*|*"))
	)
	(setq rs (cons n rs))
	)
))
(vlax-for tb ss
	(setq r -1)
	(while (< (setq r (1+ r)) (vla-get-Rows tb))
		(cond
			((and	(setq bn (vla-gettext tb r c1))
					(member bn rs))
			(vla-Setcellstate tb r c1 0)
			(vla-SetBlockTableRecordId tb r c1 (GetObjectID *ul* (vla-item *bl* bn)) :vlax-true)
		)
	)	
)
)
(if ss (vla-delete ss))
)

<<

Filename: 354062_t2b.lsp
Tác giả: quocmanh04tt
Bài viết gốc: 354140
Tên lệnh: layon layoff
Cần xin Lisp ẩn và hiện tất cả các layer!!!

Bạn thử xem sao:(defun c:layon ()

(vlax-for each (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
(vla-put-layeron each :vlax-true))
(princ))
(defun c:layoff (/ ss i)
(if (setq ss (ssget))
(repeat (setq i (sslength ss))
(vla-put-layeron (vlax-ename->vla-object
(tblobjname "LAYER" (vla-get-layer (vlax-ename->vla-object (ssname ss (setq i (1- i)))))))
:vlax-false)))
(princ))


Filename: 354140_layon_layoff.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 354395
Tên lệnh: ttt
Nhờ giúp đỡ: Viết lisp chỉnh sửa kí tự trong text.

Dạ, tại giờ em mới biết lệnh này, em vừa thử. được rồi ạ, lần trước thấy thấy làm bằng llisp rất nhanh mà tìm khắp diễn đàn mình không thấy, em chưa biết gì về lisp cả ạ

Hế hế hế,

Muốn lisp thì có isp đây:

(defun...
>>

Dạ, tại giờ em mới biết lệnh này, em vừa thử. được rồi ạ, lần trước thấy thấy làm bằng llisp rất nhanh mà tìm khắp diễn đàn mình không thấy, em chưa biết gì về lisp cả ạ

Hế hế hế,

Muốn lisp thì có isp đây:

(defun c:ttt (/ ss old new)
(vl-load-com)
  (setq old (getstring "\n Nhap chuoi can thay the: ")
          new (getstring "\n Nhap chuoi gia tri thay the: ") )
 (alert "\n Chon cac text can thay the")
 (setq sst (acet-ss-to-list (ssget (list (cons 0 "*text")))))
(foreach a ssl
   (setq txt (cdr (assoc 1 (setq el (entget a))))
             txt (vl-string-translate old new txt) )
   (entmod (subst (cons 1 txt) (assoc 1 el) el))
)
)

<<

Filename: 354395_ttt.lsp
Tác giả: Tr.CongSon
Bài viết gốc: 349415
Tên lệnh: dsp
Lisp thiết lập giá trị cho Dimspace


Lisp thay đổi giá trị mặc định của Dimspace ( 2*chiều cao text dim )

Filename: 349415_dsp.lsp
Tác giả: quocmanh04tt
Bài viết gốc: 354708
Tên lệnh: bd
Cần lisp để đưa các dim về nằm ngang bằng nhau (lệnh tắt BD)

Có phải cái này không?

(defun C:BD (/ CMD SS LTH DEM PT DS KDL N70 GOCX GOCY PT13 PT14 PTI PT10 PT10I PT10N O10 N10 PT11 PT11N O11 N11 KC OSM OLDERR *error* myerror)
(setq CMD (getvar "CMDECHO"))
(setq OSM (getvar "OSMODE"))
(defun myerror (s)
(cond ((= s "quit / exit abort") (princ))
((/= s "Function cancelled") (princ (strcat "\nError: " s))))
(setvar "cmdecho" CMD)
(setvar "osmode" OSM)
(setq *error* OLDERR)
(princ))
(setq OLDERR...

>>

Có phải cái này không?

(defun C:BD (/ CMD SS LTH DEM PT DS KDL N70 GOCX GOCY PT13 PT14 PTI PT10 PT10I PT10N O10 N10 PT11 PT11N O11 N11 KC OSM OLDERR *error* myerror)
(setq CMD (getvar "CMDECHO"))
(setq OSM (getvar "OSMODE"))
(defun myerror (s)
(cond ((= s "quit / exit abort") (princ))
((/= s "Function cancelled") (princ (strcat "\nError: " s))))
(setvar "cmdecho" CMD)
(setvar "osmode" OSM)
(setq *error* OLDERR)
(princ))
(setq OLDERR *error*
*error* myerror)
(princ "Please select dimension object!")
(setq SS (ssget))
(setvar "CMDECHO" 0)
(if (/= SS nil)
(progn (if (not (setq PT (getpoint "\nPoint to trim or extend: ")))
(exit))
(setq PT (trans PT 1 0))
(command "UCS" "W")
(setq LTH (sslength SS))
(setq DEM 0)
(while (< DEM LTH)
(progn (setq DS (entget (ssname SS DEM)))
(setq KDL (cdr (assoc 0 DS)))
(if (= "DIMENSION" KDL)
(progn (setq PT13 (cdr (assoc 13 DS)))
(setq PT14 (cdr (assoc 14 DS)))
(setq PT10 (cdr (assoc 10 DS)))
(setq PT11 (cdr (assoc 11 DS)))
(setq N70 (cdr (assoc 70 DS)))
(if (or (= N70 0) (= N70 32) (= N70 33) (= N70 160) (= N70 161))
(progn (setq GOCY (angle PT10 PT14)) (setq GOCX (+ GOCY (/ pi 2)))))
(setvar "OSMODE" 0)
(setq PTI (polar PT GOCX 2))
(setq PT10I (polar PT10 GOCY 2))
(setq PT10N (inters PT PTI PT10 PT10I NIL))
(setq KC (distance PT10 PT10N))
(setq O10 (assoc 10 DS))
(setq N10 (cons 10 PT10N))
(setq DS (subst N10 O10 DS))
(setq PT11N (polar PT11 (angle PT10 PT10N) KC))
(setq O11 (assoc 11 DS))
(setq N11 (cons 11 PT11N))
(setq DS (subst N11 O11 DS))
(entmod DS)))
(setq DEM (+ DEM 1))))
(command "UCS" "P")
(setvar "CMDECHO" CMD)
(setvar "OSMODE" OSM)
(setq *error* OLDERR))
(exit))
(princ))


<<

Filename: 354708_bd.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 355040
Tên lệnh: ha
Nhờ viết lisp thêm 2 đầu cho đường MLine

Lisp đây"

; Lisp ve thanh thep hinh tu 2 lo bulon, co doan mut. by HA, 2/6/2015
(defun C:HA( / cmd osm l p1 p2)
 (command "undo" "be") (setq cmd (getvar "cmdecho") osm (getvar "osmode")) (setvar "cmdecho" 0)
 (setq l (getreal "\nChieu dai doan mut: "))
 (command "mline")
 (command pause)
 (setq p1 (getvar "lastpoint"))
 (command pause)
 (setq p2 (getvar "lastpoint"))
 (command "")
 (entdel...
>>

Lisp đây"

; Lisp ve thanh thep hinh tu 2 lo bulon, co doan mut. by HA, 2/6/2015
(defun C:HA( / cmd osm l p1 p2)
 (command "undo" "be") (setq cmd (getvar "cmdecho") osm (getvar "osmode")) (setvar "cmdecho" 0)
 (setq l (getreal "\nChieu dai doan mut: "))
 (command "mline")
 (command pause)
 (setq p1 (getvar "lastpoint"))
 (command pause)
 (setq p2 (getvar "lastpoint"))
 (command "")
 (entdel (entlast))
 (setvar "osmode" 0)
 (command "mline" (polar p1 (+ pi (angle p1 p2)) l) (polar p2 (angle p1 p2) l) "")
 (setvar "osmode" osm) (setvar "cmdecho" cmd) (command "undo" "e") (princ))

<<

Filename: 355040_ha.lsp
Tác giả: quocmanh04tt
Bài viết gốc: 355158
Tên lệnh: blkqty
Lisp đếm block BLKQTY

@vandv:

+ Description phải dùng hexa.

+ Cách dùng đơn giản nhất để nhập mã hexa: 

@vandv:

+ Description phải dùng hexa.

+ Cách dùng đơn giản nhất để nhập mã hexa: http://www.cadviet.com/forum/topic/65354-thao-luan-go-tieng-viet-unicode-hexadecimal-ngay-trong-trinh-soan-thao-code-lisp/

Đây là lisp:

(defun c:BlkQty (/ blk_id blk_len blk_name blks cur_var ent h header_lsp height i ins j len0 lst_blk msp pt row ss str tblobj width width1 width2 x y blk_obj defx blk_def)
;; By : Gia Bach, gia_bach @ www.CadViet.com ;;
(defun TxtWidth (val h msp / txt minp maxp)
(setq txt (vla-addtext msp val (vlax-3d-point '(0 0 0)) h))
(vla-getboundingbox txt 'minp 'maxp)
(vla-erase txt)
(- (car (vlax-safearray->list maxp)) (car (vlax-safearray->list minp))))
(defun GetOrCreateTableStyle (tbl_name / name namelst objtblsty objtblstydic tablst txtsty)
(setq objTblStyDic (vla-item (vla-get-dictionaries *adoc) "ACAD_TABLESTYLE"))
(foreach
itm (vlax-for itm objTblStyDic (setq tabLst (append tabLst (list itm))))
(if (not (vl-catch-all-error-p (setq name (vl-catch-all-apply 'vla-get-name (list itm)))))
(setq nameLst (append nameLst (list name)))))
(if (not (vl-position tbl_name nameLst))
(vla-addobject objTblStyDic tbl_name "AcDbTableStyle"))
(setq objTblSty (vla-item objTblStyDic tbl_name)
TxtSty (variant-value (vla-getvariable *adoc "TextStyle")))
(mapcar '(lambda (x) (vla-settextstyle objTblSty x TxtSty)) (list actitlerow acheaderrow acdatarow))
(vla-setvariable *adoc "CTableStyle" tbl_name))
(defun GetObjectID (obj)
(if (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
(vlax-invoke-method (vla-get-utility *adoc) 'GetObjectIdString obj :vlax-false)
(vla-get-objectid obj))) ;main
(if (setq ss (ssget (list (cons 0 "INSERT"))))
(progn (vl-load-com)
(setq i -1
len0 8)
(while (setq ent (ssname ss (setq i (1+ i))))
(setq blk_name (vla-get-name (vlax-ename->vla-object ent)))
;; ------------- Lay Description -------------------
(setq blk_obj (vlax-ename->vla-object ent)
blk_def (vla-item
(vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
(vla-get-effectivename blk_obj))
defx (vl-catch-all-apply (function (lambda () (vla-get-comments blk_def)))))
;;-------------Thay doi Len-------------------------
(if (> (setq blk_len (strlen defx)) len0)
(setq str defx
len0 blk_len))
(setq blk_name (list blk_name defx)) ; Them Description
(if (not (assoc blk_name lst_blk))
(setq lst_blk (cons (cons blk_name 1) lst_blk))
(setq lst_blk (subst (cons blk_name (1+ (cdr (assoc blk_name lst_blk)))) (assoc blk_name lst_blk) lst_blk))))
;;--------------------------------------------------
(setq lst_blk (vl-sort lst_blk '(lambda (x y) (< (car (car x)) (car (car y)))))) ; Them car
(setq cur_var (mapcar 'getvar '("DYNMODE" "DYNPROMPT")))
(mapcar 'setvar '("DYNMODE" "DYNPROMPT") '(1 1))
(initget "Yes No")
(setq ins (getkword "\nChen ki hieu Block : "))
(or ins (setq ins "Yes"))
(mapcar 'setvar '("DYNMODE" "DYNPROMPT") cur_var)
(or *h* (setq *h* (* (getvar "dimtxt") (getvar "dimscale"))))
(initget 6)
(setq h (getreal (strcat "\nChieu cao chu <" (rtos *h*) "> :")))
(if h (setq *h* h)
(setq h *h*))
(setq *adoc (vla-get-activedocument (vlax-get-acad-object))
msp (vla-get-modelspace *adoc)
blks (vla-get-blocks *adoc))
(setq width1 (* 2 (TxtWidth "STT" h msp))
width (* 2 (TxtWidth "So luong" h msp))
height (* 2 h))
(if str
(setq width2 (* 1.25 (TxtWidth (strcase str) h msp)))
(setq width2 width))
(if (> h 3)
(setq width (* (fix (/ width 10)) 10)
width1 (* (fix (/ width1 10)) 10)
width2 (* (fix (/ width2 10)) 10)
height (* (fix (/ height 5)) 5)))
(GetOrCreateTableStyle "CadViet")
(setq pt (getpoint "\nDiem dat Bang :")
TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst_blk) 2) 5 height width))
(vla-put-regeneratetablesuppressed TblObj :vlax-true)
(vla-setcolumnwidth TblObj 0 width1)
(vla-setcolumnwidth TblObj 1 width2)
(vla-put-vertcellmargin TblObj (* 0.75 h))
(vla-put-horzcellmargin TblObj (* 0.75 h))
(mapcar '(lambda (x) (vla-settextheight TblObj x h)) (list actitlerow acheaderrow acdatarow))
(mapcar '(lambda (x) (vla-setalignment TblObj x 2)) (list actitlerow acheaderrow acdatarow))
(vl-catch-all-error-p (vl-catch-all-apply (function (lambda () (vla-mergecells TblObj 0 0 0 3)))))
(vla-settext TblObj 0 0 "B\U+1EA2NG TH\U+1ED0NG K\U+00CA")
(vla-setcelltextheight TblObj 0 0 (* h 2))
(setq j -1
header_lsp (list "STT" "T\U+00CAN G\U+1ECCI" "\U+0110\U+01A0N V\U+1ECA" "S\U+1ED0 L\U+01AF\U+1EE2NG" "K\U+00DD HI\U+1EC6U"))
(repeat (length header_lsp) (vla-settext TblObj 1 (setq j (1+ j)) (nth j header_lsp)))
(setq row 2
i 1)
(foreach
pt lst_blk
(setq blk_name (car pt)
j -1)
(mapcar '(lambda (x) (vla-settext TblObj row (setq j (1+ j)) x))
(list i (cadr blk_name) "C\U+00C1I" (cdr pt))) ; Them cadr
(if (= ins "Yes")
(vlax-for
blk blks
(if (= (vla-get-name blk) (car blk_name)) ; Them car
(vla-setblocktablerecordid TblObj row 4 (GetObjectID blk) :vlax-true))))
(vla-setcellalignment TblObj row 1 7)
(vla-setcellalignment TblObj row 3 9)
(setq row (1+ row)
i (1+ i)))
(vla-put-regeneratetablesuppressed TblObj :vlax-false)
(vlax-release-object TblObj)))
(princ))


<<

Filename: 355158_blkqty.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 355018
Tên lệnh: addm
nhờ viết lisp vẽ thêm đường đồng mức phụ

cảm ơn anh đã nhiệt tình giúp đỡ!

Hề hề hề,

Gửi bạn cái này để dùng chơi xem sao nhé.

(defun c:addm (/ e plst obj ss p0 e1 llst pls i j )
(vl-load-com)
(while (setq e (car (entsel "\n Chon duong dong muc thu nhat")))
   (setq plst (readpl e))
 ...
>>

cảm ơn anh đã nhiệt tình giúp đỡ!

Hề hề hề,

Gửi bạn cái này để dùng chơi xem sao nhé.

(defun c:addm (/ e plst obj ss p0 e1 llst pls i j )
(vl-load-com)
(while (setq e (car (entsel "\n Chon duong dong muc thu nhat")))
   (setq plst (readpl e))
   (setq obj (vlax-ename->vla-object (car (entsel "\n Chon duong dong muc thu hai"))))
   (setq ss (ssadd))
   (command "undo" "be")
   (foreach p plst
        (setq p0 (vlax-curve-getclosestpointto obj p))
        (command "pline" p p0 "")
        (setq e1 (entlast)
                  ss (ssadd e1 ss)   )
   )
   (command "undo" "e")
   (setq llst (acet-ss-to-list ss)
             pls (list) )
   (command "undo" "be")
   (foreach en llst
        (command "divide" en 5)
        (setq ss1 (ssget "p"))
        (setq pts (list)
                 i 0)        
        (repeat 4
              (setq pt (cdr (assoc 10 (entget (ssname ss1 i))))
                        pts (append pts (list pt)) 
                        i (1+ i)  )
        )
        (setq pls (append pls (list pts)))
        (command "erase" ss1 "")
        (setq ss1 nil)
   )
   (command "undo" "e")
   (setq j 0)
   (command "undo" "be")
   (repeat 4
        (if (and (= (cdr (assoc 70 (entget e))) 5) (vlax-curve-isclosed obj))
            (progn
            (command "spline" )
            (foreach lst pls 
                   
                   (command (nth j lst))
            )
            (command "c" "" )
            )
            (progn
            (command "spline" ) 
                     (foreach lst (cdr pls )
                             (setq p (nth j lst))
                             (command p)
                     )
            (command  "" "" "")
            )
         )
         (setq j (1+ j))
    )
    (command "erase" ss"")
    (command "undo" "e")
)
)
 
;;;;;;;
(defun readpl (pl / e l ds p) ;;;; lay danh sach cac dinh cua pline
  (if (not (equal pl etcam))
    (progn
      (setq ds '())
      (setq e (entget pl))
      (setq l (cdr (assoc 0 e)))
      (if (= l "POLYLINE")
(progn
 (setq pl (entnext pl))
 (setq e (entget pl))
 (setq l (cdr (assoc 0 e)))
 (while (= l "VERTEX")
   (setq p (cdr (assoc 10 e)))
   (setq ds (cons p ds))
   (setq pl (entnext pl))
   (setq e (entget pl))
   (setq l (cdr (assoc 0 e)))
 )
)
      )
      (if (= l "LINE")
(setq ds (list
  (cdr (assoc 11 e))
  (cdr (assoc 10 e))
)
)
      )
;(if (/= convangbac 1001) (setq ds nil) )
      (setq ds (reverse ds))
     ;; (if (= l "LWPOLYLINE")
;;(setq ds (xddstdpl pl))
     ;; )
    )
  )
  (setq ds ds)
)

<<

Filename: 355018_addm.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 354492
Tên lệnh: vm
Lisp vẽ mây chú thích
- khi vẽ mây tự động mây nằm trong layer defpoint nhưng không làm thay đổi layer hiện hành
- hiện bảng chọn các bán kính kể trên

Filename: 354492_vm.lsp
Tác giả: thanhduan2407
Bài viết gốc: 207034
Tên lệnh: daochieu
Lisp đổi thứ tự đầu cuối cho đối tượng line/polyline

Ví du: khi vẽ taluy, khi cắt 1 đoạn thẳng ra làm 2 phần sau đó dùng lisp vẽ taluy trên mỗi đoạn thì được 2 đoạn taluy ko đối xứng. em nghĩ là đổi chiều đầu cuối cho 1 trong 2 đoạn thẳng thì mới cho ra 2 taluy giống nhau

Filename: 207034_daochieu.lsp
Tác giả: pawuta
Bài viết gốc: 356981
Tên lệnh: doimau
Lisp đổi màu đối tượng được chọn


Sử dụngkết hợp 2 thao tác vào lisp hoặc chọn các đối tượng trước rồi mới đánh lệnh đổi màu các đối tượng đó hoặc đánh lệnh trước rồi chọn các đối tượng cần đổi màu. Và lưu lại màu chọn cho các lần thao tác sau

Filename: 356981_doimau.lsp
Tác giả: quocmanh04tt
Bài viết gốc: 358095
Tên lệnh: d100 tgc
Lisp chuyển Text Style, Dim nhanh chóng
Ví dụ: có các Dim style: DIM 1-1; DIM 1-100; DIM 1-50.....và có các Text style: TEXT GHI CHU; TEXT TIEU DE; TEXT DIM....
1. Khi chọn các Dimension trên bản vẽ (1 hoặc nhiều dimstyle), đánh lệnh D100 thì các Dim này chuyển về dimstyle DIM 1-100; và có thể đánh lệnh trước hoặc chọn các Dim để thay đổi, hoặc nhấn enter để dimstyle DIM 1-100 làm hiện hành. Tương tự với D50, D1....
2. Khi chọn các Text, Mtext trên...
>>
Ví dụ: có các Dim style: DIM 1-1; DIM 1-100; DIM 1-50.....và có các Text style: TEXT GHI CHU; TEXT TIEU DE; TEXT DIM....
1. Khi chọn các Dimension trên bản vẽ (1 hoặc nhiều dimstyle), đánh lệnh D100 thì các Dim này chuyển về dimstyle DIM 1-100; và có thể đánh lệnh trước hoặc chọn các Dim để thay đổi, hoặc nhấn enter để dimstyle DIM 1-100 làm hiện hành. Tương tự với D50, D1....
2. Khi chọn các Text, Mtext trên bản vẽ (1 hoặc nhiều textstyle), đánh lệnh TGC thì các Text này chuyển về textstyle TEXT GHI CHU; và có thể đánh lệnh trước rồi chọn các text hoặc enter để textstyle TEXT CHI CHU làm hiện hành.
<<

Filename: 358095_d100_tgc.lsp
Tác giả: tien2005
Bài viết gốc: 358341
Tên lệnh: m2c
Yêu câu lisp: copy chính giữa đối tượng vào Rectang

đã chỉnh sửa cho Bạn

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/280-lisp-move-text-vao-chinh-giua-mot-rectang/
(defun c:m2c (/ comm src des oldos mid)
  (defun mid (ent / p1 p2)
    (vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)
    (setq p1 (vlax-safearray->list p1)
	  p2 (vlax-safearray->list p2)
	  pt (mapcar '+ p1 p2)
	  pt (mapcar '* pt '(0.5 0.5 0.5))
    )
    pt
 ...
>>

đã chỉnh sửa cho Bạn

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/280-lisp-move-text-vao-chinh-giua-mot-rectang/
(defun c:m2c (/ comm src des oldos mid)
  (defun mid (ent / p1 p2)
    (vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)
    (setq p1 (vlax-safearray->list p1)
	  p2 (vlax-safearray->list p2)
	  pt (mapcar '+ p1 p2)
	  pt (mapcar '* pt '(0.5 0.5 0.5))
    )
    pt
  )
  (or com (setq com "C"))
  (initget "C M")
  (setq comm (getkword  (strcat "\nBan muon Copy hay Move <"com">:")))
  (if(not comm)(setq comm com))
  (setq com comm)
  (setq oldos (getvar "osmode"))
  (setvar "osmode" 0)
  (while (and
	   (setq src (car (entsel "\nDoi tuong can di chuyen: ")))
	   (not(redraw src 3))
	   (setq des (car (entsel "\nDoi tuong dich: ")))
	   (not(redraw src 4))
	 )
    (if	(= (strcase comm) "C")
      (command ".copy" src "" (mid src) (mid des))
      (command ".move" src "" (mid src) (mid des))
    )
  )
  (setvar "osmode" oldos)
  (princ)
)
(vl-load-com)

Việc chon nhiều rectang rồi chọn các đối tương thì chưa có vì phải có qui luật sắp xếp. Nếu sắp xếp theo thứ tự chọn thì làm theo lisp trên sẽ nhanh hơn


<<

Filename: 358341_m2c.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 359179
Tên lệnh: ha
lisp cộng trừ dim, edit số
Đầu vào: các dim rotated và aligned dimesion.
Chọn đối tượng là các dim (các số trên dim này có thể là nguyên dạng hoặc số edit)
Nhập số đại số cần thêm vào các dim đó Ví dụ là số A với A là số nguyên thuộc tập Z ( A dương thì là cộng; A âm thì là trừ)
Kết quả dim mới có giá trị hiển thị (là giá trị edit số) được thêm bớt 1 lượng là số A nhập vào

Filename: 359179_ha.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 359064
Tên lệnh: fz
Lisp tìm kiếm và hiển thị thông tin

Ví dụ: có một bản đồ gồm nhiều thửa đất, trên đó đã có các thông tin: lọai ruộng đất, số hiệu thửa đất, diện tích thửa đất, tên chủ sử dụng...Mỗi thông tin được thiết kế trên một lớp riêng biệt (ví dụ lọai ruộng đất thuộc lớp "loaidat"), khi nhập thông tin cần tìm theo lớp(số hiệu thửa đất hoặc tên chủ sử dụng...)

Filename: 359064_fz.lsp

Trang 193/303

193