- page 257

Info

File

Tác giả: CUONG20051982
Bài viết gốc: 210438
Tên lệnh: ha u2t

Lisp chuyển Font12 (font xuyệc (/)) sang UNICODE hay TCVN-3

Lisp này tôi đang viết để chuyển qua lại giữa 4 font chữ: Unicode, TCVN3, VNI, và "Xuyệc", nhưng chưa hoàn chỉnh. Tuy nhiên chủ topic...

Lisp này tôi đang viết để chuyển qua lại giữa 4 font chữ: Unicode, TCVN3, VNI, và "Xuyệc", nhưng chưa hoàn chỉnh. Tuy nhiên chủ topic có thể dùng để chuyển từ font "Xuyệc" qua TCVN3, Unicode, VNI. Riêng với TCVN3 thì bạn cần tạo trước 2 kiểu font mẫu: TCVN3 chữ thường và TCVN3 chữ hoa để chọn font mẫu cho phù hợp.

; Lisp cha hoµn thiÖn. Míi chØ chuyÓn ®îc 9/12 kiÓu ch÷ thêng. Cßn 3/12 kiÓu ch÷ thêng vµ 12 kiÓu ch÷ hoa.
; "µ Ì ß ï ¸ Ð ã ó ¶ Î á ñ · Ï â ò ¹ Ñ ä ô © ª «  Ç Ò å õ Ê Õ è ø È Ó æ ö É Ô ç ÷ Ë Ö é ù ¨ × ¬ ú » Ý ê ý ¾ Ø í û ¼ Ü ë ü ½ Þ ì þ ¨ ® î ¦ ¢ § ¤ ¥ ¡ £"
;----- 	'(TCVN  UNI  XUYEC  VNI) =  '("Ç" "\U+1EA7" "a/m/f" "aà")
(defun C:HA( / entlst sty kieu)
(initget "V2T V2U V2X T2X  T2V T2U U2T U2X U2V X2V X2T X2U")
(setq kieu (getkword "\nChon 1 trong 12 kieu chuyen : "))
(cond
 ((= kieu "V2T") (setq from "VNI" to "TCVN"))
 ((= kieu "V2U") (setq from "VNI" to "UNICODE"))
 ((= kieu "V2X") (setq from "VNI" to "XUYEC"))
 ((= kieu "T2X") (setq from "TCVN" to "XUYEC"))
 ((= kieu "T2V") (setq from "TCVN" to "VNI"))
 ((= kieu "T2U") (setq from "TCVN" to "UNICODE"))
 ((= kieu "U2T") (setq from "UNICODE" to "TCVN"))
 ((= kieu "U2X") (setq from "UNICODE" to "XUYEC"))
 ((= kieu "U2V") (setq from "UNICODE" to "VNI"))
 ((= kieu "X2V") (setq from "XUYEC" to "VNI"))
 ((= kieu "X2T") (setq from "XUYEC" to "TCVN"))
 ((= kieu "X2U") (setq from "XUYEC" to "UNICODE")))
(princ (strcat "\nChon cac Text " from " can chuyen sang " to "..."))
(setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "*TEXT")))))))
(setq sty (cdr (assoc 7 (entget (car (entsel (strcat "\nChon 1 Text de lay Font " to " mau: ")))))))
(foreach ent entlst
 (if (or (= kieu "T2U") (= kieu "T2V") (= kieu "T2X"))
  (entmod (subst (cons 1 (HA2 (cdr (assoc 1 (entget ent))))) (assoc 1 (entget ent)) (entget ent)))
  (entmod (subst (cons 1 (HA1 (cdr (assoc 1 (entget ent))))) (assoc 1 (entget ent)) (entget ent))))
 (entmod (subst (cons 7 sty) (assoc 7 (entget ent)) (entget ent))))
(princ))
;-----
(defun HA1 (stsua / hoa)
(if (= (strcase stsua) stsua) (setq stsua (strcase stsua T) hoa T))
(foreach n lst
 (cond
  ((= kieu "X2T") (setq stsua (acet-str-replace (caddr n) (car n) stsua)))	;OK100%; Chó ý: nÕu ch÷ Hoa th× chän TCVN Hoa, nÕu ch÷ thêng th× chän TCVN thêng.
  ((= kieu "X2U") (setq stsua (acet-str-replace (caddr n) (cadr n) stsua)))	;OK100%
  ((= kieu "X2V") (setq stsua (acet-str-replace (caddr n) (cadddr n) stsua)))	;OK100%
  ((= kieu "V2T") (setq stsua (acet-str-replace (cadddr n) (car n) stsua)))	;OK
  ((= kieu "V2X") (setq stsua (acet-str-replace (cadddr n) (caddr n) stsua)))	;OK
  ((= kieu "V2U") (setq stsua (acet-str-replace (cadddr n) (cadr n) stsua)))		;NO
  ((= kieu "U2T") (setq stsua (acet-str-replace (cadr n) (car n) stsua)))		;NO
  ((= kieu "U2X") (setq stsua (acet-str-replace (cadr n) (caddr n) stsua)))	;OK
  ((= kieu "U2V") (setq stsua (acet-str-replace (cadr n) (cadddr n) stsua)))		;NO
))
(if (and (or (= kieu "X2V") (= kieu "X2U")) (= hoa T)) (setq stsua (xstrcase stsua)))
stsua)
;-----
(defun HA2 (stsua / i stdich chuht chusua)
(setq i 0 stdich "")
(repeat (strlen stsua)
 (setq chuht (substr stsua (setq i (1+ i)) 1) chusua chuht)
 (foreach n lst
  (if (member chuht n)
(setq chusua
(cond
 	((= kieu "T2X") (caddr n))					;OK
 	((= kieu "T2V") (cadddr n))					;OK
 	((= kieu "T2U") (cadr n))))))					;OK
 (setq stdich (strcat stdich chusua)))
stdich)
;------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
;Trang web nay co .net cua Gia_bach chuyen nhieu kieu hon: http://www.cadviet.com/forum/index.php?showtopic=22767&st=0
;----- ChuyÓn tõ UNICODE => TCNN3
(defun C:U2T( / entlst sty)
(princ "\nChon cac Text UNICODE can chuyen sang TCVN...")
(setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "TEXT")))))))
(setq sty (cdr (assoc 7 (entget (car (entsel "\nChon Text de lay Font TCVN mau: "))))))
(foreach ent entlst
 (entmod (subst (cons 1 (Unicode-TCVN (HEXA3 (HEXA2 (HEXA1 (cdr (assoc 1 (entget ent)))))))) (assoc 1 (entget ent)) (entget ent)))
 (entmod (subst (cons 7 sty) (assoc 7 (entget ent)) (entget ent))))
(princ))
;----- Hµm bá ký tù ®· thªm "\" tríc khi chuyÓn sang TCVN.
(defun HEXA3(str)
(setq x 1)
(repeat (strlen str)
 (cond ((= "\U+005C" (substr str x 7)) (setq str (vl-string-subst "\\" "\U+005C" str))))
 (setq x (1+ x)))
str)
;----- Hµm chuyÓn 20 ký tù (µ, ó,...) tõ Unicode sang Hexa.
(defun HEXA2(str)
(setq x 1)
(repeat (strlen str)
 (cond ((= (chr 194) (substr str x 1)) (setq str (vl-string-subst "\U+00C2" (substr str x 1) str) x (+ x 6)))
   	((= (chr 202) (substr str x 1)) (setq str (vl-string-subst "\U+00CA" (substr str x 1) str) x (+ x 6)))
   	((= (chr 208) (substr str x 1)) (setq str (vl-string-subst "\U+0110" (substr str x 1) str) x (+ x 6)))
   	((= (chr 212) (substr str x 1)) (setq str (vl-string-subst "\U+00D4" (substr str x 1) str) x (+ x 6)))
   	((= (chr 224) (substr str x 1)) (setq str (vl-string-subst "\U+00E0" (substr str x 1) str) x (+ x 6)))
   	((= (chr 225) (substr str x 1)) (setq str (vl-string-subst "\U+00E1" (substr str x 1) str) x (+ x 6)))
   	((= (chr 226) (substr str x 1)) (setq str (vl-string-subst "\U+00E2" (substr str x 1) str) x (+ x 6)))
   	((= (chr 227) (substr str x 1)) (setq str (vl-string-subst "\U+00E3" (substr str x 1) str) x (+ x 6)))
   	((= (chr 232) (substr str x 1)) (setq str (vl-string-subst "\U+00E8" (substr str x 1) str) x (+ x 6)))
   	((= (chr 233) (substr str x 1)) (setq str (vl-string-subst "\U+00E9" (substr str x 1) str) x (+ x 6)))
   	((= (chr 234) (substr str x 1)) (setq str (vl-string-subst "\U+00EA" (substr str x 1) str) x (+ x 6)))
   	((= (chr 236) (substr str x 1)) (setq str (vl-string-subst "\U+00EC" (substr str x 1) str) x (+ x 6)))
   	((= (chr 237) (substr str x 1)) (setq str (vl-string-subst "\U+00ED" (substr str x 1) str) x (+ x 6)))
   	((= (chr 242) (substr str x 1)) (setq str (vl-string-subst "\U+00F2" (substr str x 1) str) x (+ x 6)))
   	((= (chr 243) (substr str x 1)) (setq str (vl-string-subst "\U+00F3" (substr str x 1) str) x (+ x 6)))
   	((= (chr 244) (substr str x 1)) (setq str (vl-string-subst "\U+00F4" (substr str x 1) str) x (+ x 6)))
   	((= (chr 245) (substr str x 1)) (setq str (vl-string-subst "\U+00F5" (substr str x 1) str) x (+ x 6)))
   	((= (chr 249) (substr str x 1)) (setq str (vl-string-subst "\U+00F9" (substr str x 1) str) x (+ x 6)))
   	((= (chr 250) (substr str x 1)) (setq str (vl-string-subst "\U+00FA" (substr str x 1) str) x (+ x 6)))
   	((= (chr 253) (substr str x 1)) (setq str (vl-string-subst "\U+00FD" (substr str x 1) str) x (+ x 6))))
 (setq x (1+ x)))
str)
;----- Hµm gi÷ nguyªn m· Hexa (kh«ng cho chuyÓn qua Unicode).
(defun HEXA1(str)
(setq x 1 moi "")
(repeat (strlen str)
 (setq kytu7 (substr str x 7))
 (setq x (+ x 1))
 (if (= (substr kytu7 1 3) "\\U+")
  (setq moi (strcat moi (strcat "\U+005C" (substr kytu7 2 7))) x (+ x 6))
  (setq moi (strcat moi (substr kytu7 1 1))))))
;----- ChuyÓn ngîc tõ Unicode --> TCVN.
(defun Unicode-TCVN (stsua / i stdich chuht)
(TAO_TAPSUA)
(setq i 1)
(repeat (- (strlen stsua) 6)
 (setq chuht (substr stsua i 7)
   	i (1+ i))
 (cond ((assoc chuht tapsuan1)
	(setq stsua (THAY_CONV stsua (car (assoc chuht tapsuan1)) (cdr (assoc chuht tapsuan1)))))))
(setq stdich stsua))
;----- Hµm con cña chuyÓn ngîc.
(defun THAY_CONV(str old new / n strpp strtt)
(while (setq n (vl-string-search old str))
 (setq strpp (substr str (+ 1 n (strlen old))))
 (setq strtt (substr str 1 (- (strlen str) (strlen old) (strlen strpp))))
 (setq str (strcat strtt new strpp))))
;----- T¹o danh s¸ch c¬ së ®Ó chuyÓn thuËn vµ ngîc gi÷a 4 kiÓu (tæ hîp thµnh 12 kiÓu chuyÓn).
(setq lst		; 74 ký tù (c¸c ký tù IN HOA cã dÊu kh«ng viÕt ®îc b»ng TCVN3 trong Notepad)
(list            
 '("Ç" "\U+1EA7" "a/m/f" "aà")	'("å" "\U+1ED3" "o/m/f" "oà")	'("Ò" "\U+1EC1" "e/m/f" "eà")	'("õ" "\U+1EEB" "/]/f" "öø")
 '("Ê" "\U+1EA5" "a/m/s" "aá") 	'("è" "\U+1ED1" "o/m/s" "oá")	'("Õ" "\U+1EBF" "e/m/s" "eá") 	'("ø" "\U+1EE9" "/]/s" "öù")
 '("Ë" "\U+1EAD" "a/m/j" "aä") 	'("é" "\U+1ED9" "o/m/j" "oä")	'("Ö" "\U+1EC7" "e/m/j" "eä") 	'("ù" "\U+1EF1" "/]/j" "öï")
 '("È" "\U+1EA9" "a/m/r" "aå") 	'("æ" "\U+1ED5" "o/m/r" "oå")	'("Ó" "\U+1EC3" "e/m/r" "eå") 	'("ö" "\U+1EED" "/]/r" "öû")
 '("É" "\U+1EAB" "a/m/x" "aã") 	'("ç" "\U+1ED7" "o/m/x" "oã")	'("Ô" "\U+1EC5" "e/m/x" "eã") 	'("÷" "\U+1EEF" "/]/x" "öõ")
 '("»" "\U+1EB1" "a/w/f" "aè") 	'("ê" "\U+1EDD" "/" "ö")
 '("¨" "\U+0103" "a/w" "aê") 	'("¬" "\U+01A1" "/[" "ô")  
 '("¡" "\U+0102" "A/W" "AÊ") 	'("¥" "\U+01A0" "/{" "Ô")	'("£" "\U+00CA" "E/M" "EÂ")	'("¦" "\U+01AF" "/}" "Ö")
 '("¢" "\U+00C2" "A/M" "AÂ") 	'("¤" "\U+00D4" "O/M" "OÂ")
 '("ý" "\U+00FD" "y/s" "yù") 	'("û" "\U+1EF7" "y/r" "yû")	'("ü" "\U+1EF9" "y/x" "yõ")	'("þ" "\U+1EF5" "y/j" "î")	'("ú" "\U+1EF3" "y/f" "yø")
 '("Ý" "\U+00ED" "i/s" "í") 	'("Ø" "\U+1EC9" "i/r" "æ")	'("Ü" "\U+0129" "i/x" "ó") 	'("Þ" "\U+1ECB" "i/j" "ò") 	'("×" "\U+00EC" "i/f" "ì")
 '("®" "\U+0111" "/d" "ñ") 	'("§" "\U+0110" "/D" "Ñ")))
;-----
;   				(cons "%%174" "ñ") (cons "%%167" "Ñ") (cons "%%181" "aø") (cons "%%184" "aù")
;   				(cons "%%182" "aû") (cons "%%183" "aõ") (cons "%%185" "aï") (cons "%%169" "aâ")
;   				(cons "%%162" "AÂ") (cons "%%199" "aà") (cons "%%202" "aá") (cons "%%200" "aå")
;   				(cons "%%201" "aã") (cons "%%203" "aä") (cons "%%168" "aê") (cons "%%161" "AÊ")
;   				(cons "%%187" "aè") (cons "%%190" "aé") (cons "%%188" "aú") (cons "%%189" "aü")
;   				(cons "%%198" "aë") (cons "%%204" "eø") (cons "%%208" "eù") (cons "%%206" "eû")
;   				(cons "%%207" "eõ") (cons "%%209" "eï") (cons "%%170" "eâ") (cons "%%163" "EÂ")
;   				(cons "%%210" "eà") (cons "%%213" "eá") (cons "%%211" "eå") (cons "%%212" "eã")
;   				(cons "%%214" "eä") (cons "%%215" "ì") (cons "%%221" "í") (cons "%%216" "æ")
;   				(cons "%%220" "ó") (cons "%%222" "ò") (cons "%%223" "oø") (cons "%%227" "où")
;   				(cons "%%225" "oû") (cons "%%226" "oõ") (cons "%%228" "oï") (cons "%%171" "oâ")
;   				(cons "%%164" "OÂ") (cons "%%229" "oà") (cons "%%232" "oá") (cons "%%230" "oå")
;   				(cons "%%231" "oã") (cons "%%233" "oä") (cons "%%172" "ô") (cons "%%165" "Ô")
;   				(cons "%%234" "ôø") (cons "%%237" "ôù") (cons "%%235" "ôû") (cons "%%236" "ôõ")
;   				(cons "%%238" "ôï") (cons "%%239" "uø") (cons "%%243" "uù") (cons "%%241" "uû")
;   				(cons "%%242" "uõ") (cons "%%244" "uï") (cons "%%173" "ö") (cons "%%166" "Ö")
;   				(cons "%%245" "öø") (cons "%%248" "öù") (cons "%%246" "öû") (cons "%%247" "öõ")
;   				(cons "%%249" "öï") (cons "%%250" "yø") (cons "%%253" "yù") (cons "%%251" "yû")
;   				(cons "%%252" "yõ") (cons "%%254" "î")
;-----

Cảm ơn Doan Van Ha mình đã test thử lisp trên bản vẽ của mình. Thấy chuyển từ font xuyêc sang unicode thì được nhưng từ font xuyêc hay Unicode sang font TCVN-3; VNI và ngược lại thì không được thấy font bị chuyển thành kí tự không đọc được.

Đây là file CAD có font xuyêc xem lại giúp mình nhé:http://www.cadviet.c...khoa_locker.dwg

Download lisp

Filename: 210438_ha_u2t.lsp

Tác giả: tinya1225
Bài viết gốc: 149945
Tên lệnh: %2B%2B

Lisp chỉnh sửa nội dung text

Mình không rành xử lý string lắm, mà chính xác là hok thích lắm. Viết như thế này, bạn thử xem có dùng được hem :

>>
Mình không rành xử lý string lắm, mà chính xác là hok thích lắm. Viết như thế này, bạn thử xem có dùng được hem :
(defun c:++(/ num kq oldvalue str)
(setq num (getint "\nS\U+1ED1 c\U+1EA7n c\U+1ED9ng th\U+00EAm :"))
(foreach ent (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "*TEXT")))))))
(setq kq (vl-string-subst 
(rtos (+ num (atoi (setq oldvalue (substr 
	(setq str (vlax-get-property ent 'TextString))
	(+ 2 (vl-string-position (ascii "-") str)) 
)))) 2 0)
oldvalue
str
))
(if (=(substr str (strlen str))  ")")(setq kq (strcat kq ")")))
(vlax-put-property ent 'TextString kq))
)
cám ơn bác đã bỏ công sức giúp em.

em đã chạy lệnh báo lỗi như sau:

Command: ++

Số cần cộng thêm :1

Select objects: 1 found

Select objects:

; error: no function definition: nil

đã thử với text, mtext, dtext

mong bác tiếp tục giúp em.

<<

Download lisp

Filename: 149945_%2B%2B.lsp

Tác giả: quansla
Bài viết gốc: 221213
Tên lệnh: ccot cchang dantexty ddan %602

Canh Text theo hàng dọc

Tạm thời thì mình đang dùng cái này, bạn xem dùng được thì dùng,

tên lệnh

CCot can text thẳng đứng
CCHang (dễ nhầm nhầm với lệnh Change của Cad) căn text phương ngang
DanTexty tạo khoảng cách cho các Text
Lệnh DanTexty còn có thể dùng lệnh sau thay thế: ddab
```
	

;;can text thang cot voi nhau
(defun c:Ccot(/ TDT...
>>
```

Tạm thời thì mình đang dùng cái này, bạn xem dùng được thì dùng,

tên lệnh

CCot can text thẳng đứng
CCHang (dễ nhầm nhầm với lệnh Change của Cad) căn text phương ngang
DanTexty tạo khoảng cách cho các Text

Lệnh DanTexty còn có thể dùng lệnh sau thay thế: ddab

	

;;can text thang cot voi nhau
(defun c:Ccot(/ TDT XTextmau dt i )
 	(if(setq TDT (ssget '((0 . "*TEXT"))))
	(progn
 		(command "JUSTIFYTEXT" TDT "" "L")
 		(If (null(setq Xtextmau (car(getpoint "\Nhap tao do diem"))))
(setq Xtextmau (cadr(assoc 10 (entget(car(entsel"\nChon Text mau dau tien:"))))))
)
 		(progn
(command "undo" "begin")
;;;list se canh tat ca cac Text ve cung mot toa do x(giu nguyen toa do y)
(setq i 0)
(while (< i (sslength TDT))
      (setq dt (entget(ssname TDT i)))
      (setq i (1+ i))
      (setq dt (subst
      	(subst XTextmau (cadr(assoc 10 dt)) (assoc 10 dt))
      	(assoc 10 dt) dt))
      (entmod dt)
      )
(command "undo" "end")
)
 		)
	(print)
	))   

;--------------------------------------------------	;;;------can text ve cung mot hang------------
(defun c:CcHang(/ TDT YTextmau dt i )
 	(if(setq TDT (ssget '((0 . "*TEXT"))))
	(progn
 		(command "JUSTIFYTEXT" TDT ""  "L")
 		(If (null(setq Ytextmau (cadr(getpoint "\Nhap tao do diem"))))
(setq Ytextmau (caddr(assoc 10 (entget(car(entsel"\nChon Text mau dau tien:"))))))
)
 		(progn
(command "undo" "begin")
;;;list se canh tat ca cac Text ve cung mot hang(toa do y)(giu nguyen toa do x)
(setq i 0)
(while (< i (sslength TDT))
      (setq dt (entget(ssname TDT i)))
      (setq i (1+ i))
      (setq dt (subst
      	(subst yTextmau (caddr(assoc 10 dt)) (assoc 10 dt))
      	(assoc 10 dt) dt))
      (entmod dt)
      )
(command "undo" "end")
)
 		)
	))   
;--------------------------------------------------
;--------------------------------------------------	;-----------------dan Text Phuong dung--------------------------   
(defun KhoangCach (/ k t1 t2)
 	(prompt "\nChon Text lay khoang cach/Nhap khoang cach")
 	(if (setq k (getdist "\nNhap khoang cach"))
	(progn
 		k
	)
	(progn
 		(prompt "\nChon Text lay khoang cach")
 		(if (setq TDT (ssget (list (cons 0 "*text"))))
(progn
      (setq N (sslength TDT))
      (setq t1 (entget (ssname TDT (- N 1)))
 	t2 (entget (ssname TDT (- N 2)))
      )
      (- (nth 2 (assoc 10 t1)) (nth 2 (assoc 10 t2)))
)
 		)
	)
 	)
)   
;;Lisp dan Text phuong dung
(defun DanTexty (/ TDT dt k i p pdt)
 	(if (setq k (khoangcach))
	(progn
 		(alert "\nChon Text can dan")
 		(setq TDT nill)
 		(while (null TDT)
(setq TDT (ssget (list (cons 0 "*text"))))
)
 		(setq N (sslength TDT)
    	p (cdr (assoc 10 (entget (ssname TDT (1- N)))))
    	i (- N 2)
 		)
 		(while (> i -1)
(setq dt (entget (ssname TDT i)))
(setq pdt (cdr (assoc 10 dt))
      	pdt (list (car pdt) (- (cadr p) k) 0)
      	p   pdt
)
(entmod (subst (cons 10 p) (assoc 10 dt) dt))
(setq i (1- i))
 		)
	)
	(progn
 		(alert "\nPhai nhap KHOANG CACH, hoac chon Text ")
 		(princ)
 		)
	)
 	)
 	(defun c:DanTexty () (DanTexty))   
 (defun c:ddan () (DanTexty))	;-----------------dan Text Phuong dung--------------------------   
;;;Ho tro chon truoc doi tuong
(defun c:`2()
 	(ssget (list (assoc 0 (entget(car (entsel "\nChon doi tuong mau"))))))
 	)
;;--------------------------------------------------------------

Download lisp

Filename: 221213_ccot_cchang_dantexty_ddan_%602.lsp

Tác giả: tuan138
Bài viết gốc: 409074
Tên lệnh: test

Nhờ Tư Vấn Lisp Chuyển Polyline Sang Arc

Vẫn làm đc ^_^ nhưng sẽ không chính xác 1 số góc cong. Thử cái này xem nhé.
(defun c:test (/ ss pLlst vLst...
>>
Vẫn làm đc ^_^ nhưng sẽ không chính xác 1 số góc cong. Thử cái này xem nhé.
(defun c:test (/ ss pLlst vLst n p1 p2 p3)
  (command "ucs" "name" "save" "temp")
  (command "ucs" "w")
  (if (not (setq ss (ssget '((0 . "LWPOLYLINE")))))
    (print "Ban da khong chon pline.")
    (progn
      (setq pLlst (vl-remove-if
		    'listp
		    (mapcar 'cadr (ssnamex ss))
		  )
      )
      
      (foreach pl pLlst
	(setq vLst   (mapcar 'cdr
			     (vl-remove-if-not
			       '(lambda (x) (= 10 (car x)))
			       (entget pl)
			     )
		     )
	)				;setq
	(setq n 0)
	(while (< 1 (length vLst))
	  (setq	p1 (nth n vLst)
		p2 (nth (+ n 1) vLst)
		p3 (nth (+ n 2) vLst)
	  )				;setq
	  (command "_arc" "_none" p1 "_none" p2 "_none" p3)
	  (setq vLst (cddr vLst))
	)				;while
      )					;foreach
    )					;progn
  )					;if
  (command "ucs" "name" "restore" "temp")
  (command "ucs" "name" "delete" "temp")
  (princ)
)					;defun
Bác Bee ơi.

Cho em hỏi chút. Em chạy Lisp này của bác nhưng bị lỗi sau khi vẽ được 1 cung đầu tiên.

; error: bad argument type: fixnump: nil

Theo em hiểu thì nó báo sai định dạng.

Em thử atof để chuyển nó về Float cũng không được bác nhỉ. Bác giúp em với.

Em dùng ( autocad 2009 mechanical)

Thanks bác.

<<
Download lisp
Filename: 409074_test.lsp

Tác giả: tuan138
Bài viết gốc: 408943
Tên lệnh: tt

Nhờ Tư Vấn Lisp Chuyển Polyline Sang Arc

Thêm 1 bước làm mịn Pline (còn vấn đề kia thì tính toán phức tạp):
(defun c:tt (/ vertices-pl lsp...
>>
Thêm 1 bước làm mịn Pline (còn vấn đề kia thì tính toán phức tạp):
(defun c:tt (/ vertices-pl lsp lst pl lastEnt ss)
(defun vertices-pl (e)

(if (setq e (member (assoc 10 e) e))

(cons (cdr (assoc 10 e)) (vertices-pl (cdr e)))))

(if (and (setq pl (car (entsel "\nPick PLine"))) (eq (cdr (assoc 0 (entget pl))) "LWPOLYLINE"))

(progn (setq lsp (mapcar '(lambda (p) (trans p 0 1)) (vertices-pl (entget pl)))

lst (cdddr lsp))

(setvar 'CMDECHO 0)

(entdel pl) ;Xoa Pline goc

(command "_.pline" "_none" (car lsp) "a" "s" "_none" (cadr lsp) "_none" (caddr lsp))

(while lst (command "_none" (car lst)) (setq lst (cdr lst)))

(command "")

(initget "Y N")

(if (eq (getkword "\nLam min Pline ? <N>:") "Y")

(progn (command "_.pedit" (ssget "L") "f" "")

(setq pl (ssget "L"))

(setq lastEnt (entlast)

ss (ssadd))

(command "_.explode" pl)

(while (setq lastEnt (entnext lastEnt)) (ssadd lastEnt ss))

(command "_.pedit" "m" ss "" "j" "" "")))))

(princ))

@Bác DuongTrungHuy: Là quy đổi điểm từ hệ tọa độ này sang hệ tọa độ kia, hàm (trans p 0 1) nằm trong mapcar như vậy thì bác biết p là gì rồi. UCS world: 0, UCS User (current ucs): 1
Bác quocmanh04tt ơi!

Thay vì làm mịn thì có thể làm đơn giản hóa(kỷ hà) đoạn polyline được không ạ?

Em cảm ơn bác đã sửa code và giải thích trans ( em cũng đang tìm trans là gì)

<<
Download lisp
Filename: 408943_tt.lsp

Tác giả: tuan138
Bài viết gốc: 408866
Tên lệnh: hehehe

Nhờ Tư Vấn Lisp Chuyển Polyline Sang Arc

Explode pline thì không cần. Code này của 1 đồng chí Russia :D

Thử nghịch xem nhé. Chuyển các segment là line thành arc segment. Nhớ...

Explode pline thì không cần. Code này của 1 đồng chí Russia :D

Thử nghịch xem nhé. Chuyển các segment là line thành arc segment. Nhớ di chuột ít thôi nhé ^_^

(defun c:hehehe ( / massoclst nthmassocsubst v^v unit _ilp doc lw enx gr enxb p1 p2 p3 b i n )

  (vl-load-com)

  (defun massoclst ( key lst )
    (if (assoc key lst) (cons (assoc key lst) (massoclst key (cdr (member (assoc key lst) lst)))))
  )

  (defun nthmassocsubst ( n key value lst / k slst p j plst m tst pslst )
    (setq k (length (setq slst (member (assoc key lst) lst))))
    (setq p (- (length lst) k))
    (setq j -1)
    (repeat p
      (setq plst (cons (nth (setq j (1+ j)) lst) plst))
    )
    (setq plst (reverse plst))
    (setq j -1)
    (setq m -1)
    (repeat k
      (setq j (1+ j))
      (if (equal (assoc key (member (nth j slst) slst)) (nth j slst) 1e-6)
        (setq m (1+ m))
      )
      (if (and (not tst) (= n m))
        (setq pslst (cons (cons key value) pslst) tst t)
        (setq pslst (cons (nth j slst) pslst))
      )
    )
    (setq pslst (reverse pslst))
    (append plst pslst)
  )

  (defun v^v ( u v )
    (mapcar '(lambda ( s1 s2 a b ) (+ ((eval s1) (* (nth a u) (nth b v))) ((eval s2) (* (nth a v) (nth b u))))) '(+ - +) '(- + -) '(1 0 0) '(2 2 1))
  )

  (defun unit ( v )
    (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
  )

  (defun _ilp ( p1 p2 o nor / p1p p2p op tp pp p )
    (if (not (equal (v^v nor (unit (mapcar '- p2 p1))) '(0.0 0.0 0.0) 1e-7))
      (progn
        (setq p1p (trans p1 0 (v^v nor (unit (mapcar '- p2 p1))))
              p2p (trans p2 0 (v^v nor (unit (mapcar '- p2 p1))))
              op  (trans o 0 (v^v nor (unit (mapcar '- p2 p1))))
              op  (list (car op) (cadr op) (caddr p1p))
              tp  (polar op (+ (* 0.5 pi) (angle '(0.0 0.0 0.0) (trans nor 0 (v^v nor (unit (mapcar '- p2 p1)))))) 1.0)
        )
        (if (inters p1p p2p op tp nil)
          (progn
            (setq p (trans (inters p1p p2p op tp nil) (v^v nor (unit (mapcar '- p2 p1))) 0))
            p
          )
          nil
        )
      )
      (progn
        (setq pp (list (car (trans p1 0 nor)) (cadr (trans p1 0 nor)) (caddr (trans o 0 nor))))
        (setq p (trans pp nor 0))
        p
      )
    )
  )

  (or doc (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))))
  (vla-startundomark doc)
  (if (and (setq lw (entsel "\nPick LWPOLYLINE..."))
          (= (cdr (assoc 0 (setq enx (entget (car lw))))) "LWPOLYLINE")
      )
    (progn
      (setq i (fix (vlax-curve-getParamAtPoint
                  (car lw)
                  (vlax-curve-getClosestPointToProjection (car lw) (trans (cadr lw) 1 0) '(0.0 0.0 1.0))
                  ) ;_  vlax-curve-getParamAtPoint
              ) ;_  fix
           p1 (vlax-curve-getPointAtParam (car lw) i)
           p3 (vlax-curve-getPointAtParam (car lw) (1+ i))
           lw (car lw)
      )
      (setq enxb (massoclst 42 enx))
      (while (= 5 (car (setq gr (grread t))))
        (setq p2 (_ilp (trans (cadr gr) 1 0) (mapcar '+ (trans (cadr gr) 1 0) '(0.0 0.0 1.0)) p1 (cdr (assoc 210 (entget lw)))))
        (setq b ((lambda (a) (/ (sin a) (cos a)))
                (/ (- (angle (trans p2 0 lw) (trans p3 0 lw)) (angle (trans p1 0 lw) (trans p2 0 lw))) 2.0)
               )
        )
        (setq n -1)
        (foreach dxf42 enxb
          (setq n (1+ n))
          (if (= n i)
            (setq enx (nthmassocsubst n 42 b enx))
            (setq enx (nthmassocsubst n 42 (+ (cdr dxf42) b) enx))
          )
        )
        (entupd (cdr (assoc -1 (entmod enx))))
      )
    )
    (prompt "\n Nothing selected or picked object not a LWPOLYLINE ")
  )
  (vla-endundomark doc)
  (princ)
)

Bác Bee tìm được lisp hay ghê.

Em thử nghiên cứu cái lisp của bác xem.

Cảm ơn Bác Bee nhiều nhé.

Mà bác Bee ơi. Muốn làm theo cách mà bác @DuongTrungHuy thì có làm được không bác Bee nhỉ:

1.- Đầu tiên ta vẽ cung tròn qua 3 điểm đầu 1,2,3

2.- Tiếp đến ta vẽ cung tròn tiếp xúc với cung cũ tại 3 và đi qua điểm 4.

3.- Lại vẽ tiếp cung đi tiếp xúc với cung tròn last tại 4 và đi qia điểm 5.

4.- Cứ thế cho đến hết v.v....

Em cảm ơn các bác đã quan tâm đến vấn đề của em :D

Download lisp

Filename: 408866_hehehe.lsp

Tác giả: fengstupid
Bài viết gốc: 147876
Tên lệnh: c

hỏi han về cái bắt tâm hình vuông mà cài osnap không được

Tue_NV chưa biết cách làm với CAD. Nhưng hình như là không có.

Lisp sau có thể bắt trọng tâm của một đa giác kín bất...
>>
Tue_NV chưa biết cách làm với CAD. Nhưng hình như là không có.

Lisp sau có thể bắt trọng tâm của một đa giác kín bất kì
(defun centre(dt / cen)
 (if (or (= (cdr(assoc 0 (entget dt))) "REGION") 
     	(and (wcmatch (cdr(assoc 0 (entget dt))) "*POLYLINE")
      (= (cdr(assoc 70 (entget dt))) 1)
        )
     )
      (if (and (wcmatch (cdr(assoc 0 (entget dt))) "*POLYLINE")
      (= (cdr(assoc 70 (entget dt))) 1)
          )
 (Progn
   (command "copy" dt "" '(0 0 0) "@")
   	   (command "region" dt "")
   (setq dt (entlast))
   (setq cen (vlax-get (vlax-ename->vla-object dt) 'Centroid))
   (entdel dt)
 )
 (setq cen (vlax-get (vlax-ename->vla-object dt) 'Centroid))
       )

 )
 cen
)
(defun c:c() (centre (car(entsel "\n Pick chon doi tuong lay trong tam :"))))
Cách bắt trọng tâm của 1 đa giác kín như sau : (trong 1 lệnh)

1. Apload Lisp

2. Vẽ 1 Line với điểm đầu là trọng tâm của 1 đa giác

Command: L -> Gõ L

LINE Specify first point: 'c -> Gõ 'c

Pick chon doi tuong lay trong tam : -> Pick vào hình cần lấy trọng tâm

(22.0409 20.9165)

Specify next point or : -> Điểm kê tiếp của lệnh LINE

Specify next point or :

Để lấy trọng tâm ở 1 lệnh khác cũng gõ 'c

Lisp trên cũng là 1 lời giải :rolleyes:
cảm ơn bác

<<

Download lisp

Filename: 147876_c.lsp

Tác giả: huaductiep
Bài viết gốc: 276104
Tên lệnh: dop

Nhờ Viết Lisp Dim hàng loạt theo phương đứng

Do chưa hiểu file của bạn....

Code Lisp của bạn đây:
(defun c:dop(/ Tue-dxf Tue-ent-Lpoint...
>>
Do chưa hiểu file của bạn....

Code Lisp của bạn đây:
(defun c:dop(/ Tue-dxf Tue-ent-Lpoint cur line dd)
(vl-load-com)
(defun Tue-dxf (dxf ename)(cdr(assoc dxf (entget ename))))
(defun Tue-ent-Lpoint(e / i Lpoint);Tue-dxf
(if (wcmatch (Tue-dxf 0 e) "*POLYLINE")
(progn
  (if (= (type e) 'VLA-OBJECT) (setq e (vlax-vla-object->ename e)))
  (setq i -1)
  (Repeat (if (wcmatch (Tue-dxf 0 e) "*POLYLINE") (fix (1+ (vlax-curve-getEndParam e))) 2)
    (setq Lpoint (append Lpoint (list (vlax-curve-getPointatParam e (setq i (1+ i))))))
  )
)
)
(if (wcmatch (Tue-dxf 0 e) "LINE")
  (setq Lpoint (append Lpoint (list (Tue-dxf 10 e) (Tue-dxf 11 e))))
)
Lpoint
)
  (command "ucs" "W")
(while (and
  (setq cur (car (entsel "\nChon Pline :")))
  (setq line (car (entsel "\nChon line1 :")))
  (setq dd (getpoint "\nChon diem dat :"))
  )
  (foreach x (Tue-ent-Lpoint cur)
  (command "._dimlinear"  x (vlax-curve-getClosestPointTo line x) x
             "._dimtedit" (entlast) (list (car x) (cadr dd) 0.0))
  )
)
)
(defun c:dop(/ Tue-dxf Tue-ent-Lpoint cur line dd)

(defun Tue-dxf (dxf ename)(cdr(assoc dxf (entget ename))))

(defun Tue-ent-Lpoint(e / i Lpoint);Tue-dxf

(if (wcmatch (Tue-dxf 0 e) "*POLYLINE")

(progn

(if (= (type e) 'VLA-OBJECT) (setq e (vlax-vla-object->ename e)))

(setq i -1)

(Repeat (if (wcmatch (Tue-dxf 0 e) "*POLYLINE") (fix (1+ (vlax-curve-getEndParam e))) 2)

(setq Lpoint (append Lpoint (list (vlax-curve-getPointatParam e (setq i (1+ i))))))

)

)

)

(if (wcmatch (Tue-dxf 0 e) "LINE")

(setq Lpoint (append Lpoint (list (Tue-dxf 10 e) (Tue-dxf 11 e))))

)

Lpoint

)

(command "ucs" "W")

(while (and

(setq cur (car (entsel "\nChon Pline :")))

(setq line (car (entsel "\nChon line1 :")))

(setq dd (getpoint "\nChon diem dat :"))

)

(foreach x (Tue-ent-Lpoint cur)

(command "._dimlinear" x (vlax-curve-getClosestPointTo line x) x

"._dimtedit" (entlast) (list (car x) (cadr dd) 0.0))

)

)

)
Cám ơn bác Tuệ rất nhiều. Lisp bác viết rất đúng ý em rồi. Nhưng em dùng có điều này mong bác giúp là:

+ Thêm sự lựa chọn hàng loạt Polyline một lúc.

+ Và thêm hàm có thể giúp Undo trở lại trước khi Dim. Em thử thêm mấy dòng này vào Lisp mà ko được : (command "undo" "be") (command "undo" "end")

Hoặc nếu bác chỉ cho em cách sửa lisp thì tốt quá. Em gà về khoản này quá. Mong bác chỉ giúp. :)

<<

Download lisp

Filename: 276104_dop.lsp

Tác giả: hakhoailang
Bài viết gốc: 161161
Tên lệnh: ttt

lip tính khối lượng thể tích vật liệu

Bạn thử đoạn code, Tue_NV mới viết :

(defun c:ttt(/ e1 e2 tile s1 s2 Res text)
(defun gb( / ss from to cur)
 (setq frome...
>>

Download lisp

Filename: 161161_ttt.lsp

Tác giả: hoacomay70
Bài viết gốc: 367324
Tên lệnh: tnn

VIẾT LISP KÉO DÀI, CẮT BỚT NHIỀU ĐỐI TƯỢNG!

Vậy bạn thử cái này, chỉ dùng với line thôi, và khi giao điểm của 2 line ở gần, chứ không thể kéo dài tới vô cực...

Download lisp

Filename: 367324_tnn.lsp

Tác giả: HoangSon614
Bài viết gốc: 93687
Tên lệnh: blkqty

Viết lisp theo yêu cầu [phần 2]

Bạn chạy thử LISP này :

(defun c:BlkQty (/ blk_name ent i lst_blk pt row ss tblobj x y)
 (if (setq ss (ssget (list (cons 0 "INSERT"))))
   (progn
     (vl-load-com)
     (setq i -1)
...
>>

Bạn chạy thử LISP này :

(defun c:BlkQty (/ blk_name ent i lst_blk pt row ss tblobj x y)
 (if (setq ss (ssget (list (cons 0 "INSERT"))))
   (progn
     (vl-load-com)
     (setq i -1)
     (while (setq ent (ssname ss (setq i (1+ i))))
(setq blk_name (vla-get-name (vlax-Ename->Vla-Object ent)))
(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 x) (car y)) ) )
    pt (getpoint "\nDiem dat Bang :")
    TblObj (vla-addtable
	     (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-Acad-Object)))
	     (vlax-3d-point pt) (+ (length lst_blk) 2) 4 375 2000))
     (vla-SetColumnWidth TblObj 0 1000)
     (vla-SetColumnWidth TblObj 1 3000)
     (vla-put-vertcellmargin TblObj 50)
     (mapcar '(lambda (x y)(vla-setTextHeight TblObj x y))
      (list acTitleRow acHeaderRow acDataRow)
      (list 250 250 175))
     (mapcar '(lambda (x)(vla-setAlignment TblObj x 8))
      (list acTitleRow acHeaderRow acDataRow))
     (vla-MergeCells TblObj 0 0 0 2)
     (vla-setText TblObj 0 0 "Bang thong ke")
     (vla-setText TblObj 1 0 "STT")
     (vla-setText TblObj 1 1 "Ten")
     (vla-setText TblObj 1 2 "Don vi")
     (vla-setText TblObj 1 3 "So luong")
     (setq row 2 i 1)
     (foreach pt lst_blk
(vla-setText TblObj row 0 (itoa i))
(vla-setText TblObj row 1 (car pt))
(vla-setText TblObj row 2 "cai")
(vla-setText TblObj row 3 (itoa (cdr pt)))
(setq row (1+ row) i (1+ i))	)	)
     (vlax-release-object TblObj)      )
 (princ))

Mình đã cài Cad 2008 và sử dụng được rồi, chạy rất tốt nhưng mình muốn bạn giúp mình tý nữa, cụ thể là:
1. Tăng độ rộng hàng lên 2 lần

2. Mặc định font chữ là Vni-hel

3. Cột thứ 2 mình muốn text nằm bên trái (không phải giữa)

Với 3 yêu cầu trên mình phải sửa như thế nào, nhờ bạn giúp mình. Cảm ơn bạn nhiều

gia_bach giúp mình với. Cảm ơn bạn

Download lisp

Filename: 93687_blkqty.lsp

Tác giả: HoangSon614
Bài viết gốc: 93567
Tên lệnh: tkck

Viết lisp theo yêu cầu [phần 2]

Đừng bực mình nữa mờ :undecided:

Bạn sử dụng code này thử xem :

Code này là của bác phamthanhBinh đã được Tue_NV chỉnh lại cho phù hợp với yêu cầu của...

Đừng bực mình nữa mờ :undecided:

Bạn sử dụng code này thử xem :

Code này là của bác phamthanhBinh đã được Tue_NV chỉnh lại cho phù hợp với yêu cầu của HoangSon.

Tuy nhiên mình vẫn thích sử dụng cách lập bảng như code của anh gia bach hơn

HoangSon thử nhé :

(defun c:tkck (/ ltxt ltst)
(command "undo" "be")
(setq ss (ssget (list (cons 0 "insert")))
ltxt (list)
ltst (list)
i -1)
(while (setq ent (ssname ss (setq i (1+ i))))
(setq ltxt (append ltxt (list(cdr (assoc 2 (entget ent)))))))
(foreach x ltxt
(if (setq old (cdr (assoc x ltst)))
(setq ltst (subst (cons x (1+ old) ) (assoc x ltst) ltst))
(setq ltst (append ltst (list (cons x 1))))))
(setq k 1
p (getpoint "\n Chon diem dat bang")
h (getreal "\n Nhap chieu cao text: ")
d (getreal "\n Nhap do rong cot: "))
(entmake (list (cons 0 "TEXT") (cons 10 p) (cons 40 h) (cons 1 "THONG KE CAU KIEN")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (- (cadr p) (* 2 h))))
(cons 40 h) (cons 1 "STT")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car p) d) (- (cadr p) (* 2 h))))
(cons 40 h) (cons 1 "TEN CAU KIEN")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car p) (* 2 d)) (- (cadr p) (* 2 h))))
(cons 40 h) (cons 1 "SO LUONG")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car p) (* 3 d)) (- (cadr p) (* 2 h))))
(cons 40 h) (cons 1 "GHI CHU")))
(foreach x1 ltst
(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (- (cadr p) (* 2 h (+ 1 k)))))
(cons 40 h) (cons 1 (rtos k 2 0))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car p) d) (- (cadr p) (* 2 h (+ 1 k)))))
(cons 40 h) (cons 1 (car x1))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car p) (* 2 d)) (- (cadr p) (* 2 h (+ 1 k)))))
(cons 40 h) (cons 1 (rtos (cdr x1) 2 0))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car p) (* 3 d)) (- (cadr p) (* 2 h (1+ k)))))
(cons 40 h) (cons 1 "" )))
(setq k (1+ k)))
(command "undo" "e")
(princ)
)

Cảm ơn Tue_NV. Nhưng nếu code trên mà kẻ thêm khung nữa thì hay biết mấy (nói chung mình rất tiếc code của gia_bach)

Download lisp

Filename: 93567_tkck.lsp

Tác giả: vanhaks
Bài viết gốc: 408359
Tên lệnh: tt

Nhờ Các Bác Sửa Dùm Lisp Thống Kê Text Phổ Biến Cho Ae Xd

Bạn thử lisp này xem (AttBlock): >>
Bạn thử lisp này xem (AttBlock): http://www.cadviet.com/upfiles/6/141736_tkckattblk.lsp
(defun c:tt (/ stt-sl-int acdoc blname ent i itl ktd lst mspace pt ss str tck tenbve)
(defun stt-sl-int (num)

(if (> num 9)

(setq str (itoa num))

(setq str (strcat (chr 48) (itoa num))))

str)

;; *** MAIN ***

(vl-load-com)

(or #sohienbanve# (setq #sohienbanve# 1))

(if (and (setq ss (getblockselection "CK"))

(setq acdoc (vla-get-activedocument (vlax-get-acad-object))

mspace (vla-get-modelspace acdoc)

blname "TKCK"

tenbve "KC-"

i -1)

(setq #sohienbanve# (cond ((getint (strcat "\nSo hieu ban ve <" tenbve (stt-sl-int #sohienbanve#) ">: ")))

(#sohienbanve#)))

(setq pt (getpoint "\nDiem chen bang: ")))

(progn (while (setq ent (ssname ss (setq i (1+ i))))

(setq itl (LM:vl-getattributes (vlax-ename->vla-object ent))

tck (cdr (car itl))

ktd (cdr (cadr itl)))

(if (not (assoc (list tck ktd) lst))

(setq lst (cons (cons (list tck ktd) 1) lst))

(setq lst (subst (cons (list tck ktd) (1+ (cdr (assoc (list tck ktd) lst)))) (assoc (list tck ktd) lst) lst))))

(LM:vl-setattributevalues (vla-InsertBlock mspace (vlax-3d-point pt) blname 1 1 1 0)

(mapcar '(lambda (a B) (cons a B))

'("STT" "TEN_CK" "KICH_THUOC" "SO_LUONG" "CHI_TIET_XEM_BAN_VE")

(list "STT" "TÊN CK" "KÍCH TH\U+01AF\U+1EDAC" "S\U+1ED0 L\U+01AF\U+1EE2NG" "CHI TI\U+1EBET XEM B\U+1EA2N V\U+1EBC")))

(setq i 0)

(foreach x (vl-sort lst '(lambda (x y) (< (caar x) (caar y))))

(LM:vl-setattributevalues (vla-InsertBlock mspace (vlax-3d-point (polar pt (* 1.5 pi) (* 600 (1+ i)))) blname 1 1 1 0)

(mapcar '(lambda (a B) (cons a B))

'("STT" "TEN_CK" "KICH_THUOC" "SO_LUONG" "CHI_TIET_XEM_BAN_VE")

(list (stt-sl-int (setq i (1+ i)))

(caar x)

(cadar x)

(stt-sl-int (cdr x))

(strcat tenbve (stt-sl-int #sohienbanve#))))))))

(princ))

;;-----------------------------------------------------------

(defun LM:getanonymousreferences (blk / ano def lst rec ref)

(setq blk (strcase blk))

(while (setq def (tblnext "block" (null def)))

(if (and (= 1 (logand 1 (cdr (assoc 70 def))))

(setq rec (entget (cdr (assoc 330 (entget (tblobjname "block" (setq ano (cdr (assoc 2 def))))))))))

(while (and (not (member ano lst)) (setq ref (assoc 331 rec)))

(if (and (entget (cdr ref)) (wcmatch (strcase (LM:al-effectivename (cdr ref))) blk))

(setq lst (cons ano lst)))

(setq rec (cdr (member (assoc 331 rec) rec))))))

(reverse lst))

(defun LM:al-effectivename (ent / blk rep)

(if (wcmatch (setq blk (cdr (assoc 2 (entget ent)))) "`**")

(if (and (setq rep (cdadr (assoc -3 (entget (cdr (assoc 330 (entget (tblobjname "block" blk)))) '("acdbblockrepbtag")))))

(setq rep (handent (cdr (assoc 1005 rep)))))

(setq blk (cdr (assoc 2 (entget rep))))))

blk)

(defun LM:vl-getattributes (blk)

(mapcar '(lambda (att) (cons (vla-get-tagstring att) (vla-get-textstring att)))

(vlax-invoke blk 'getattributes)))

(defun LM:vl-setattributevalues (blk lst / itm)

(foreach att (vlax-invoke blk 'getattributes)

(if (setq itm (assoc (vla-get-tagstring att) lst))

(vla-put-textstring att (cdr itm)))))

(defun getblockselection (blk)

(ssget

(list '(0 . "INSERT")

'(66 . 1)

(cons 2

(apply 'strcat (cons blk (mapcar '(lambda (x) (strcat ",`" x)) (LM:getanonymousreferences blk))))))))

P/s:

- Số hiệu bản vẽ chỉ cần nhập số.

- Phần KC- bạn có thể thay trong lisp.
Anh @quocmanh04tt ơi. Em tải về và tạo BLOCK có tên "CK" với 2 attribute (1 ATT dành cho tên cấu kiện, 1 ATT cho kích thước) nhưng khi chọn điểm chèn bảng thì nó báo lỗi Automation Error. Filer error. Em không biết cần hiệu chỉnh gì thêm trong lisp nữa không. :( Em không rành về lisp cho lắm. Em gửi anh file cad. https://drive.google.com/file/d/0BxkByQrR-fPvbGxXLWVkOU9OUFU/view

<<

Download lisp

Filename: 408359_tt.lsp

Tác giả: hongquan88
Bài viết gốc: 228136
Tên lệnh: gcddm

Đưa bình đồ dạng đường đồng mức về bình đồ dạng cao độ

Hề hề hề,

Mình không phải dân chuyên ngành của bạn. Sau khi đọc yêu cầu của bạn và xem bản vẽ bạn gửi,...
>>
Hề hề hề,

Mình không phải dân chuyên ngành của bạn. Sau khi đọc yêu cầu của bạn và xem bản vẽ bạn gửi, minh viết cái lisp sau giúp bạn có thể ghi được cao độ của các đường đồng mức dựa vào cách làm như sau:

1/- Mở bản vẽ zoom gần tới một vị trí point chuẩn có ghi sẵn cao độ của điểm đó. Tỷ dụ bạn chọn điểm có cao độ là 392

2/- Vẽ một lwpolyline sao cho nó cắt mỗi đường đồng mức chỉ tại một điểm theo một chiều.gọi là đường dẫn

3/- load lisp

4/- Gõ lệnh cddm và làm theo các yêu cầu của lisp;

Khi líp yêu cầu chọn đường dẫn thì chọn polyline vừa vẽ

Khi lisp yêu cầu nhập cao độ bắt đầu thì nhập giá trị chẵn bước của đường đồng mức gần với điểm đã ghi cao độ trước (trong trường hợp cụ thể bản vẽ của bạn gửi thì nhập 380 tường ứng với cao độ điểm là 392)

Khi líp yêu cầu nhập độ chênh cao giữa các đường đồng mức thì tùy theo chiều vẽ polyline mà nhấp giá trị dương hay âm của độ chênh cao này (trong trường hợp bản vẽ bạn gửi thì giá trị này là + hoặc - 20.

Sau đó nhấn enter và chờ líp hoàn thành công việc của nó.

5/- Check lại xem lisp ghi đúng chưa, nếu thấy chưa đúng thì undo để xóa toàn bộ những gì líp đã làm, không ảnh hưởng tới bản vẽ của bạn.

Lưu ý rằng trong bản vẽ bạn gửi, các đường đồng mức nằm trên nhiều layẻ khác nhau mà mình chỉ mới phát hiện được có 3 layẻ là 1,2 và 5. Khi thấy lisp bỏ sót các đường đồng mức chưa được ghi cao độ thì có thể là do đường đồng mức đó nắm khác layẻ với các layẻ kể trên và bạn phải bổ sung layẻ này vào trong bộ chọn đối tượng của lisp.

Hy vọng bạn có thể dùng được lisp này để thuận lợi cho công việc của bạn. Nếu quá trình dùng có vấn đề gì chưa rõ cứ post lên mình sẽ tìm hiểu và giải thích.

Chúc bạn vui
</p>
<p> </p>
<div>(defun c:gcddm ( / pl plst ssdml cdmax chcd i els ssp cdt )</div>
<div>(vl-load-com)</div>
<div>(setq oldos (getvar "osmode"))</div>
<div>(setvar "osmode" 0)</div>
<div>(command "undo" "be")</div>
<div>(setq pl (car (entsel "\n Chon duong dan"))</div>
<div>          plst (acet-geom-vertex-list pl ) )</div>
<div> </div>
<div>(setq ssdml (acet-ss-to-list (ssget "f" plst (list (cons 0 "lwpolyline") (cons 62 30) (cons 8 "1,2,5")))))</div>
<div> </div>
<div>(setq cdmax (getreal "\n Nhap cao do bat dau: ")</div>
<div>          chcd (getreal "\n Nhap do chenh cao giua cac duong dong muc: ")</div>
<div>          i 0 )</div>
<div> (foreach dm ssdml</div>
<div>         (setq els (entget dm)</div>
<div>                  cdt  (+ cdmax (* i chcd))</div>
<div>                  els (subst (cons 38 cdt ) (assoc 38 els) els)</div>
<div>                  els (subst (cons 62 2) (assoc 62 els) els) )</div>
<div>         (entmod els)</div>
<div>         (command "measure" dm   200)</div>
<div>         (setq ssp (acet-ss-to-list (ssget "p")))</div>
<div>         (foreach pt ssp</div>
<div>               (command "insert" "cd1" (cdr (assoc 10 (entget pt))) 1 1 0 (rtos cdt 2 0) )</div>
<div>         )</div>
<div>         (setq i (1+ i)  )</div>
<div>)</div>
<div>(command "erase" pl "")</div>
<div>(command "undo" "e")</div>
<div>(setvar "osmode" oldos)</div>
<div>(princ)</div>
<div>)</div>
<div>         
Bạn cho mình hỏi vẽ cái đường dẫn bằng pl ấy như thế nào nhỉ, chỉ cần cắt các đường đồng mức tại 1 điểm là được ah? Sao mình vẽ rồi chọn vẫn báo lỗi: "Chon duong dan; error: no function definition: ACET-GEOM-VERTEX-LIST" . Mong bạn hướng dẫn rõ hơn chút. Cám ơn bạn nhiều.

<<

Download lisp

Filename: 228136_gcddm.lsp

Tác giả: nguyen tuan hung
Bài viết gốc: 178678
Tên lệnh: oca

Lisp copy tăng dần.

Đây là lisp do bác Bình viết:

(defun C:OCA( / e e0 dn p1 cn c n p2 dat) ;;;Make Ordinal number. Copy from Atttribute block
(setq
e0...
>>

Download lisp

Filename: 178678_oca.lsp

Tác giả: minhchien89tb
Bài viết gốc: 412521
Tên lệnh: clo

Lisp tạo viewport từ khung chọn bên model.

Của bạn đây.

Hướng...

Của bạn đây.

Hướng dẫn:

1. Lệnh CLO

2. Chọn máy in, khổ giấy, style...

3. Đặt tên Layout, tỉ lệ

4. Chọn các khung hình chữ nhật (Polyline) bên Model để tạo Viewport bên Layout. Khi quét chọn thì Lisp sẽ tự động căn các khung theo thứ tự từ trái sang phải.

5. Chọn Block hoặc file xref. Nếu không cần thì khỏi chọn.

6. Bấm OK, Lisp sẽ tạo mỗi bản vẽ trên một Layout.

;LISP TAO LAYOUT HANG LOAT BANG CACH CHON KHUNG VIEW BEN MODEL
(vl-load-com)
(defun Make_dcl	(/ ret)
  (if (= Printer nil) (setq Printer 0))
  (if (= Size nil) (setq Size 0))
  (if (= Style nil) (setq Style 0))
  (if (= Block nil) (setq Block 0))
  (if (= TenLayout nil) (setq TenLayout "Layout"))
  (if (= Tyle nil) (setq Tyle "1000"))
  (setq fl (vl-filename-mktemp "CLO" nil ".dcl"))
  (setq ret (open fl "w"))
  (write-line
    (strcat
      "CLO : dialog { label = \"Create Layout\";
      : column {
      : boxed_column {label = \"Page Setup\";
      : popup_list { key=\"Printer\"; label= \"Printer\";  value = \"" (itoa Printer) "\"; edit_width = 40;}
      : popup_list { key=\"PaperSize\"; label= \"Paper Size   \"; value = \"" (itoa Size) "\"; edit_width = 40;}
      : popup_list { key=\"Style\"; label= \"Style            \"; value = \"" (itoa Style) "\";edit_width = 40;}
      : edit_box {   key = \"LO_name\"; label = \"Layout Name  \"; value = \"" TenLayout "\";edit_width = 20;}
      : edit_box {   key = \"Tyle\"; label = \"Drawing Scale\"; value = \"" Tyle "\";edit_width = 20;}}
      : button { key = \"Chonkhung\"; label = \"Select Frame \"; }
      : boxed_column {
      label = \"\";
      :row {
      : button { key = \"TaoBlock\"; label = \"Create Title Block\"; is_default = false; width=30; fixed_width=true;}
      : popup_list {key=\"Block\"; label= \"Block\"; width=30; fixed_width=true; value = \"" (itoa Block) "\";}}
      : row {
      : button {key = \"Select_Xref\"; label = \"Xref Title Block\"; is_default = false; width=30; fixed_width=true;}
      : button {key = \"Remove\"; label = \"Remove Title Block\"; is_default = false; width=30; fixed_width=true;}}
      : list_box {label =\"\"; key = \"Xref_File\"; height = 3; value = \"0\";}
      }
      : boxed_row {
      : button { key = \"accept\"; label = \" OK \"; width=30; fixed_width=true; is_default = true;}
      : button { key = \"cancel\"; label = \"Cancel\"; is_default = false; is_cancel = true; width=30; fixed_width=true;}}}} "
    )
    ret
  )
  (setq ret (close ret))
)
(defun *error* (msg) (vl-file-delete fl))
(defun Chon ()
  (vl-file-delete fl)
  (setq taphop(ssget '((0 . "POLYLINE,LWPOLYLINE"))))
  (Make_dcl)
  (setq ddiag 3)
)
(defun TaoBlock (/ taphop pt)
  (vl-file-delete fl)
  (alert "Chon doi tuong de tao Block khung ten")
  (if (/= (setq taphop(ssget)) nil)
    (progn
      (setq pt(getpoint "\n Chon Base point cua Block: "))
      (setq ten(lisped "Nhap ten cua Block"))
      (while (/= (tblsearch "Block" ten) nil)
	(setq ten(lisped "Trung ten Block da co. Nhap ten khac cho Block")))
      (command "BLOCK" ten pt taphop "")
      (setq dsblock(cons "" (tablelist "Block")))
      ))
  (Make_dcl)
  (setq ddiag 3)
)
(defun Update ()
  (vla-put-ConfigName (ActLay) (nth (atoi (get_tile "Printer")) dsmayin))
  (setq dsPaper (PaperList))
  (start_list "PaperSize" 3)
  (mapcar 'add_list dsPaper)
  (end_list)
)
(defun Chon_Xref ()
  (if (not Path) (setq Path(getvar "dwgprefix")))
  (setq File(getfiled "Chon File khung ten" Path "dwg" 2))
  (if (/= File nil) (setq Path File dsFile (list File)))
  (start_list "Xref_File" 3)
  (mapcar 'add_list dsFile)
  (end_list)
  )
(defun Remove_Xref ()
  (setq File "" dsFile (list File))
  (start_list "Xref_File" 3)
  (mapcar 'add_list dsFile)
  (end_list)
  )
(defun ActLay () (vla-get-ActiveLayout(vla-get-activedocument(vlax-get-acad-object))))
(defun PlotDeviceNamesList ()
  (vla-RefreshPlotDeviceInfo (ActLay))
  (vlax-safearray->list(vlax-variant-value(vla-GetPlotDeviceNames (ActLay)))))
(defun PaperList (/ PLObj PSL)
  (setq PLObj (vla-GetCanonicalMediaNames (ActLay)))
  (foreach i (vlax-safearray->list (vlax-variant-value PLObj))
    (setq PSL (append PSL (list (vla-GetLocaleMediaName (ActLay) i))))))
(defun PlotStyleTableNamesList ()
  (vla-RefreshPlotDeviceInfo (ActLay))
  (vlax-safearray->list(vlax-variant-value(vla-GetPlotStyleTableNames(ActLay)))))
(defun tablelist (s / d r)
  (while (setq d (tblnext s (null d)))
    (setq r (cons (cdr (assoc 2 d)) r))))
(defun DeleteLayouts (/ layouts layout i)
  (vl-load-com)
  (setq	layouts	(vla-get-Layouts(vla-get-activedocument (vlax-get-acad-object))))
  (if (> (vla-get-count layouts) 2)
    (vlax-for layout layouts
      (if (= (vla-get-ModelType layout) :vlax-false)
	(if (< (vla-get-count (vla-get-block layout)) 2)
	  (vla-delete layout))))))
(setq dsmayin (PlotDeviceNamesList))
(setq dsStyle (PlotStyleTableNamesList))
(setq dsblock(cons "" (tablelist "Block")))
(defun hopthoai	()
  (setq dcl_id (load_dialog fl))
  (if (not (new_dialog "CLO" dcl_id)) (exit))
  (start_list "Printer" 3)
  (mapcar 'add_list dsmayin)
  (end_list)
  (Update)
  (action_tile "Printer" "(Update)")
  (action_tile "Chonkhung" "(setq ddiag 5)(saveVars)(done_dialog)")
  (action_tile "TaoBlock" "(setq ddiag 9)(saveVars)(done_dialog)")
  (start_list "Style" 3)
  (mapcar 'add_list dsStyle)
  (end_list)
  (start_list "Block" 3)
  (mapcar 'add_list dsBlock)
  (end_list)
  (start_list "Xref_File" 3)
  (mapcar 'add_list dsFile)
  (end_list)
  (action_tile "Select_Xref" "(Chon_Xref)")
  (action_tile "Xref_File" "(Chon_Xref)")
  (action_tile "Remove" "(Remove_Xref)")
  
  (action_tile "cancel" "(setq ddiag 1)(done_dialog)")
  (action_tile "accept" "(setq ddiag 2)(setq tieptuc 1)(saveVars)(done_dialog)" )
  (start_dialog)
  (unload_dialog dcl_id)
)
(defun saveVars	()
  (setq Printer (atoi (get_tile "Printer")))
  (setq Size (atoi (get_tile "PaperSize")))
  (setq Style (atoi (get_tile "Style")))
  (setq Tyle (get_tile "Tyle"))
  (setq Block (atoi (get_tile "Block")))
  
  (setq Printer1 (nth Printer dsmayin))
  (setq Size1 (nth Size (PaperList)))
  (setq Style1 (nth Style dsStyle))
  (setq TenLayout (get_tile "LO_name"))
  
  (setq Tyle1 (/ (atof (get_tile "Tyle")) 1000))
  (setq Block1 (nth Block dsBlock))
)
(defun C:CLO (/ os)
  (setvar "CMDECHO" 0)
  (command "UNDO" "BE")
  (setq os(getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setvar "TILEMODE" 1)
  (setq dsblock(cons "" (tablelist "Block")))
  (if (= File nil) (setq dsFile (list "")))
  (setq tieptuc 0)
  (Make_dcl)
  (setq ddiag 3)
  (while (= ddiag 3)
    (hopthoai)
    (if	(= ddiag 5) (Chon))
    (if	(= ddiag 9) (TaoBlock))
  )
  (vl-file-delete fl)
  (if (= tieptuc 1)
    (progn
      (Sapxepkhung)
      (Make_Layout)
      (DeleteLayouts)
      )
    )
  (setvar "OSMODE" os)
  (command "UNDO" "END")
  (princ)
  )
(defun Sapxepkhung(/ index khung S1 S2 D1 D2)
  (setq index 0)
  (setq lst_Khung(list))
  (setq S1 0 S2 0)
  (while (< index (sslength taphop))
    (setq khung (ssname taphop index))
    (setq lst_Khung(append lst_Khung (list(list khung S1 S2))))
    (setq index (1+ index))
    )
  (setq lst_Khung(vl-sort lst_Khung '(lambda (e1 e2) (< (cadr(assoc 10 (entget(car e1)))) (cadr(assoc 10 (entget(car e2))))))))
  )
(defun Make_Layout (/ disp index khung lst pt0 pt1 pt2 pt3 P1 P2)
  (setq disp(getenv "CreateViewports"))
  (setenv "CreateViewports" "0")
  (setq index 1)
  (foreach khung1 lst_Khung
    (setq khung (car khung1))
    (setq lst (acet-geom-vertex-list khung))
    (setq lst (vl-sort lst '(lambda(e1 e2) (if (/= (car e1) (car e2)) (< (car e1) (car e2)) (< (cadr e1) (cadr e2))))))
    (setq pt0 (nth 0 lst) pt3 (nth 3 lst))
    (if	(> (cadr (nth 1 lst)) (cadr (nth 2 lst)))
      (setq pt1	(nth 1 lst) pt2	(nth 2 lst))
      (setq pt1	(nth 2 lst) pt2	(nth 1 lst)))
    (command "LAYOUT" "N" (strcat TenLayout (itoa (+ 0 index))))
    (command "LAYOUT" "S" (strcat TenLayout (itoa (+ 0 index))))
    (command "ERASE" "ALL" "")
    (if (/= File nil) (command "xref" "A" file (list 0 0) "" "" ""))
    (if (/= Block1 "") (command "INSERT" Block1 (list 0 0) "" "" ""))
    (command "ZOOM" "E")
    (if	(> (distance pt2 pt0) (distance pt1 pt0))
      (command "RECTANG"  (list 0 0) (list (/ (distance pt2 pt0) tyle1) (/ (distance pt1 pt0) tyle1)))
      (command "RECTANG"  (list 0 0) (list (/ (distance pt1 pt0) tyle1) (/ (distance pt2 pt0) tyle1)))
      )
    (command "MVIEW" "O" (entlast))
    (command "MSPACE")
    (if	(> (distance pt2 pt0) (distance pt1 pt0))
      (command "DVIEW" khung "" "TW" (- 90 (* (/ (angle pt0 pt1) pi) 180)) "")
      (command "DVIEW" khung "" "TW" (- 0 (* (/ (angle pt0 pt1) pi) 180)) ""))
    (command "ZOOM" "W" pt0 pt3)
    (command "PSPACE")
    (command "ZOOM" "E")
    (Setq P1 (Getvar "EXTMIN") P2 (Getvar "EXTMAX"))
    (command "PLOT" "Y" "" printer1 size1 "M" "L" "N" "W" P1 P2 "1" "C" "Y" Style1 "Y" "N" "N" "N" "N" "Y" "N")
    (command "MODEL")
    (setq index (+ index 1))
  )
  (setenv "CreateViewports" disp)
  (princ)
)
(princ "\n           Type CLO to run program\n")

KangKun à nhờ bạn sửa giúp mình là

+chọn theo hàng ngang được không ( tức là từ trái sang phải trước)- lips đang chọn theo cột

+ hoặc theo tứ tự chọn từ click

thank bạn nhiều

Download lisp

Filename: 412521_clo.lsp

Tác giả: tientracdia
Bài viết gốc: 230192
Tên lệnh: kk

Lisp up nội dung từ Excel vào Cad

Không muốn dùng Block Attribute thì chơi Lisp này, đúng theo yêu cầu luôn.

http://www.cadviet.com/upfiles/3/71162_update_so_lieu_tu_excel_vao_cad_rev1_1.lsp

;=====LISP UPDATE SO LIEU TU FILE TXT VAO CAD - REV1==========
;================KANGKUNG 25/03/2013==========================
(defun C:KK()
  (command "UNDO" "BE")
  (setq taphop(ssget '((0 . "TEXT"))) os(getvar "OSMODE"))
  (if (not Path) (setq Path(getvar "dwgprefix")))
  (setq file(getfiled "Select File:" Path "txt" 2) Path file index 0 TEXT_LIST (list))
  (while (< index (sslength taphop))
    (setq TEXT (entget (ssname taphop index)))
    (if (/= (read (cdr(assoc 1 TEXT))) (atof (cdr(assoc 1 TEXT))))
      (progn
	(setq String(cdr(assoc 1 TEXT)))
	(if (= (+ (cdr(assoc 72 TEXT)) (cdr(assoc 73 TEXT))) 0)
	  (setq InsertPoint(cdr(assoc 10 TEXT)))
	  (setq InsertPoint(cdr(assoc 11 TEXT))))
	(setq TEXT_LIST (append (list (list String InsertPoint)) TEXT_LIST))))
    (setq index (1+ index)))
  (setq file_in(open file "R") lst_solieu(list))
  (while(setq txt(read-line file_in))
    (if (/= txt nil) (setq lst (read (strcat "(" txt ")"  ))))
    (foreach dt TEXT_LIST
      (if (= (car dt) (vl-princ-to-string(car lst)))
	(progn
	  (setq pt1(cadr dt) pt2(list (- (car pt1) 1.0757) (- (cadr pt1) 1.3762)) pt3(list (+ (car pt1) 1.2744) (- (cadr pt1) 1.3762)) pt4(list (car pt1) (- (cadr pt1) 2.7500)))
	  (entmakex (list '(0 . "TEXT") (cons 8 "Main_DTOV") (cons 62 3) (cons 10 pt1) (cons 40 0.5) (cons 1 (vl-princ-to-string(car lst))) (cons 72 1) (cons 11 pt1) (cons 73 2)))
	  (entmakex (list '(0 . "TEXT") (cons 8 "Main_CDTC") (cons 62 130) (cons 10 pt2) (cons 40 0.5) (cons 1 (rtos (cadr lst) 2 2)) (cons 72 1) (cons 11 pt2) (cons 73 2)))
	  (entmakex (list '(0 . "TEXT") (cons 8 "Main_DTOV") (cons 62 2) (cons 10 pt3) (cons 40 0.5) (cons 1 (rtos (caddr lst) 2 2)) (cons 72 1) (cons 11 pt3) (cons 73 2)))
	  (entmakex (list '(0 . "TEXT") (cons 8 "Main_KLOV") (cons 62 31) (cons 10 pt4) (cons 40 0.5) (cons 1 (rtos (cadddr lst) 2 2)) (cons 72 1) (cons 11 pt4) (cons 73 2)))
	  )
	)
      )
    )
  (COMMAND "ERASE" TAPHOP "")
  (close file_in)
  (command "UNDO" "END")
  )
(princ "\n                Written By KangKung - 25/03/2013\n")
(princ "\n                  Nhap KK de chay chuong trinh\n")

Bạn cho mình hỏi dòng lệnh này nghĩa thế nào vậy bạn : (setq pt1(cadr dt) pt2(list (- (car pt1) 1.0757) (- (cadr pt1) 1.3762)) pt3(list (+ (car pt1) 1.2744) (- (cadr pt1) 1.3762)) pt4(list (car pt1) (- (cadr pt1) 2.7500)))

Mình muốn thay vòng tròn cũ R 2.5 va mới R= 1.5 để phù hợp với ô lưới, việc xuất text vào thì không còn đúng vào vị trí ô củ trước đây

Mong được Bạn chỉ giúp.

Cám ơn

Download lisp

Filename: 230192_kk.lsp

Tác giả: vantran
Bài viết gốc: 92496
Tên lệnh: abc

chuyển tọa độ từ file excel sang cad

File Txt của bạn có 2 dòng không đúng cấu trúc, không nhất thiết phải dùng ký tự TAB để tách dữ liệu, bạn có thể dùng ký tự khác, giải sử là "|"
Khi đó...
>>
File Txt của bạn có 2 dòng không đúng cấu trúc, không nhất thiết phải dùng ký tự TAB để tách dữ liệu, bạn có thể dùng ký tự khác, giải sử là "|"
Khi đó bạn chỉ cần thay cụm ký tự "\t" trong đoạn mã sau thành "|" là được.

Bạn thử xem nhé
(defun c:ABC()
 (setq f (open "D:\\ABC.txt" "r"))
 (while (setq Line (read-line f))
(if (vl-string-search "\t" Line)
  (progn
(setq Point (split Line "\t" ))
(command "Text" "J" "MC" (cdr Point) "" "" (car Point))
  )
)
 )
)
(defun Split (Str Char)
 (setq Lst '())
 (while (setq Local (vl-string-search Char Str))
(if (null Lst)

  (setq Lst (list (substr Str 1 Local))
	Str (substr Str (+ Local 2)))
  (setq Lst (append Lst (list (read(substr Str 1 Local))))
  Str (substr Str (+ Local 2)))
)
 )
 (setq Lst (append Lst (list (read Str))))
)
sao minh load lisp lên rồi đánh lệnh ABC mà cad lại báo lỗi là error: bad argument type: FILE nil.

bạn có thể hướng dẫn mình cách sử dụng không. cảm ơn bạn nhé

<<

Download lisp

Filename: 92496_abc.lsp

Tác giả: hhhhgggg
Bài viết gốc: 56704
Tên lệnh: vnh

lisp đổi Font sang font SHX bị lỗi.

Kiểm tra với các font .shx khác thì OK nhưng chưa kiểm tra với font kythuat1.SHX vì bạn không post lên ở đây. Hãy chạy thử nếu không có vấn đề gì thì thôi, còn nếu bạn...
>>
Kiểm tra với các font .shx khác thì OK nhưng chưa kiểm tra với font kythuat1.SHX vì bạn không post lên ở đây. Hãy chạy thử nếu không có vấn đề gì thì thôi, còn nếu bạn có vấn đề thì hãy post lên đây, kèm theo font kythuat1.shx của bạn.
Code được chỉnh lại chút xíu
(defun c:vnh ()
(command "undo" "be")
(command "-style" "doifont1" "kythuat1.shx" "0" "1" "0" "n" "n" "n")
(prompt "\nChon chu muon chinh.")
(setq ss (ssget))
(setq c 0)
(if ss (setq e (ssname ss c)))
(while e
(setq e (entget e))
(if (= (cdr (assoc 0 e)) "TEXT")
(progn
(setq txt "doifont1")
(setq e (subst (cons 7 txt) (assoc 7 e) e))
(entmod e)
)
)
(setq c (1+ c))
(setq e (ssname ss c))
)
(command "undo" "end")
(Princ)
)
:cheers:
ok ! Thanks !

<<

Download lisp

Filename: 56704_vnh.lsp

Tác giả: namhai
Bài viết gốc: 73973
Tên lệnh: np

Lisp vẽ nối tiếp đường thẳng?

Thử xem, lệnh NP. Nếu chưa đúng ý thì reply:
(defun C:NP( / p ss);;;Noi tiep pline
(setq
 p (getpoint "\nChon diem cuoi line, pline hoac arc:")
 ss (ssget "c" p p '((0 ....
>>
Thử xem, lệnh NP. Nếu chưa đúng ý thì reply:
(defun C:NP( / p ss);;;Noi tiep pline
(setq
 p (getpoint "\nChon diem cuoi line, pline hoac arc:")
 ss (ssget "c" p p '((0 . "LINE,POLYLINE,LWPOLYLINE,ARC")))
)
(command "pline" p (getpoint p "\nDiem tiep theo:") "")
(command "pedit" (entlast) "j" ss "" "")
(princ)
)
Bác Ssg à, Bác có thể cải tiến hơn 1 chút nữa là sau khi dùng lệnh np sẽ vẽ được đường pline 1 cách bình thường,ở đây e thấy lisp này chỉ nỗi thêm 1 đường line, nếu mình muốn vẽ nối tiếp nhiều đường thì bất tiện quá, cảm ơn bác nhiều nhiều nha!!

<<