Đây là lisp mình đã rút gọn lại. đồng thời sửa thêm một số chi tiết về nhập số liệu và chế độ bắt điểm để thuận...

>>

Đây là lisp mình đã rút gọn lại. đồng thời sửa thêm một số chi tiết về nhập số liệu và chế độ bắt điểm để thuận tiện hơn khi sử dụng. Lisp cũng đã tự động load các block cần thiết. bạn chỉ cần copy bản vẽ này vào thư mục D:\Lisp CAD là OK.

(Chú ý là không sử dụng bản vẽ BV1 của bạn nữa nhé. vì các block hơi xấu khi canh lề text, đông thời bản vẽ đó có mấy block không sử dụng nhưng mình không có cách gì purge nó đi được nên lisp load rất chậm)

(defun DXF (code elist)
  (cdr (assoc code elist))
)

(defun c:tn (); / DZ pt y ptside ang OT sc1 scale)
  (vl-load-com)
  (setvar "cmdecho" 0)

(if (not scale) (setq scale 1))
(setq sc1 (getreal (strcat "\n Cao text <"(rtos scale 2 0)">:")))
(if sc1 (setq scale sc1))
(SETQ OSLAST (getvar "OSMODE"))
(setq DZ (getvar "DIMZIN"))
(setvar "DIMZIN" 0)
(setq OT (getvar "ORTHOMODE"))
(setvar "ORTHOMODE" 0)
(command "osmode" 99)
(setq pt0 (osnap (getpoint "Diem tim TN tu nhien <end of> : ") "end")) (print)
(setq x0 (car pt0) y0 (cadr pt0))
(setq ed (entget (car (entsel "\nChon cao do tim: "))))
(setq H0 (read (DXF 1 ed)))	
(command "osmode" 15359) 
(setq pt (getpoint "\nDiem chen: "))

(While (/= pt nil)
(Progn
(setq ptside (getpoint "\nPhia chen:" pt)
ang (angle pt ptside))
(setq y (- (cadr pt) y0 (- H0)))
(setq x (- (car pt) x0))
		 
(cond ((> x 0) (setq x (strcat "" (rtos x 2 2))))
		 ((< x 0) (setq x (rtos (abs x) 2 2)))
		 ((= x 0) (setq x "0.00"))		 )
(cond ((> y 0) (setq y (strcat "+" (rtos y 2 2))))
		 ((< y 0) (setq y (rtos y 2 2)))
		 ((= y 0) (setq y "%%p0.00")))
;(setq x (ustr 0 "Khoang cach: " x T))
;(setq y (ustr 0 "Cao do: " y T))

(if (not (tblsearch "block" "LCD1"))
(progn (command "insert" "D:\\Lisp CAD\\BVTN.dwg" "" "" "" "")
(command "erase" (entlast) "")))

( if (AND (>= ang 0) (< ang 1.5708)) (command "INSERT" "LCD1" pt scale scale "0" x y))
( if (AND (>= ang 1.5708) (< ang 3.1416)) (command "INSERT" "LCD2" pt scale scale "0" y x))
( if (AND (>= ang 3.1416) (< ang 4.7124)) (command "INSERT" "LCD3" pt scale scale "0" x y))
( if (AND (>= ang 4.7124) (< ang 6.2832)) (command "INSERT" "LCD4" pt scale scale "0" y x))

(setq pt (getpoint "\nDiem chen: "))
);pro
);while 
(setvar "OSMODE" OSLAST)
(setvar "DIMZIN" DZ)
(setvar "ORTHOMODE" OT))
;---------------------------------------------------------------------------

Link tải bản vẽ bị hư rồi bác ạ. Bác gửi lại cho em xin với đc ko ạ? Thanks bác nhiều nhiều!

<<

 

Bạn xem cái này vừa ý không.

Format:

Space: 123 00 00

Dot: 123.0000

Comma: 123,0000

Dash:...

>>

 

Bạn xem cái này vừa ý không.

Format:

Space: 123 00 00

Dot: 123.0000

Comma: 123,0000

Dash: 123-00-00

Degress:123d00'00"

 

Toán tử: +, -

 

 

Nếu bỏ qua thì format và toán tử sẽ lấy lần nhập trước. Cái này có kiểm tra phím nhập, do đó khi nhập toán tử bạn phải nhập đúng ký tự +, -

 

(defun c:demo (/ e e1 e2 key #func)
(defun s2d (str / ret)
 (setq ret
 (vl-list->string
(vl-remove-if
 	'(lambda (x) (or (< x 48) (> x 57)))
 	(reverse (vl-string->list str))
)
 )
 )
 (angtof
(vl-list->string
 	(reverse
(vl-string->list
(strcat "\"" (substr ret 1 2) "'" (substr ret 3 2) "d" (substr ret 5))
   	)
 	)
)
 )
)
(defun format (value fm / lst mm ss)
(setq ss (vl-list->string (cdr (member 39 (vl-string->list value)))))
(if (= (strlen ss) 2) (setq value (strcat (substr value 1 (- (strlen value) 2)) "0" ss)))
(setq mm (vl-list->string (cdr (member 100 (vl-string->list value)))))
(if (= (strlen mm) 5) (setq value (strcat (substr value 1 (- (strlen value) 5)) "0" mm)))

 (setq lst '(("Space" . 32)
  	("dOt" . 46)
  	("Comma" . 44)
  	("dAsh" . 45)
 	)
 )
 (setq fm (cdr (assoc fm lst)))
 (cond
((member fm '(32 45))
(vl-list->string
 	(subst fm
 	100
 	(subst fm 39 (vl-remove 34 (vl-string->list value)))
 	)
))
((member fm '(44 46))
(vl-list->string
 	(subst fm
 	100
 	(vl-remove 39 (vl-remove 34 (vl-string->list value)))
 	)
))
(T value)
 )
)

(if (null func) (setq func +))
(if (null fm) (setq fm "Degress"))
(setq key T)
(while (not (member key '("-" "+" nil)))
(setq #func  (chr (cadr (reverse (vl-string->list (vl-princ-to-string func))))))
(initget "Degress Space dOt Comma dAsh + -")
(setq key (getkword (strcat "\nEnter an option <Default: "#func"/"fm">:")))
(cond
  ((member key '("-" "+")) (setq func (eval (read key))) nil)
  (T (setq fm key))
)
)

(while
 (and

(setq e1 (car (entsel "\nEnter Text 1 <Exit>:")))
(setq e1 (s2d (cdr (assoc 1 (setq e (entget e1))))))
(setq e2 (car (entsel (strcat "\nEnter Text 2  <Exit>:"))))
(setq e2 (s2d (cdr (assoc 1 (entget e2)))))
(setq p (Getpoint "\nDiem chen ket qua <exit>:"))
)
  	(setq e (subst (cons 10 p) (assoc 10 e) e))
  	(setq e (subst (cons 1  (format (angtos (func e1 e2) 1 4) fm)) (assoc 1 e) e))
  	(entmake e)
 )
 (princ)
)

 

Bạn đã giúp thi giúp cho chót nhé:

Mr npham và mọi người có thể sửa lisp này được như thế này không vậy:

 

Thanks!

<<

Hình như cái này:

(defun c:andim(/ ssd)
(setq dimsty (cdr (assoc 3 (entget (car (entsel "\nChon kieu Dim mau can giu lai:...
>>

Hình như cái này:

(defun c:andim(/ ssd)
(setq dimsty (cdr (assoc 3 (entget (car (entsel "\nChon kieu Dim mau can giu lai: "))))))
(princ "\nChon cac Dim...")
 (if (setq ssd (ssget '((0 . "DIMENSION"))))
(acet-ss-visible (ssget "X" (list '(0 . "DIMENSION") '(-4 . "<NOT") (cons 3 dimsty) '(-4 . "NOT>"))) 1)))

 

Từ lisp trên em mới nghĩ đến mình hay phải chỉnh sửa các bản vẽ do người người khác chuyển đến (tính chất công việc hơi kỳ dị) nên rất hay phải sử lý với text và Dim, nay có một nhu cầu muốn nhờ các bro bớt chút thời gian vàng ngọc (hi hi) giúp em cái lisp với nhu cầu lựa chọn Text và Dim như sau:

I.1: Trường hợp 1 :

1. Nhập tên lệnh: A5

2. Hỏi kiểu lựa chọn (1. Dim hoặc 2. Text): 1

3. Kiểu chọn Dim (1. Nhập giá trị dim hoặc 2. Cận Dim): 1

4. Giá trị dim cần chọn: 1200

5. Select vùng lựa chọn: (Kéo chọn)

Lisp sẽ chọn tất cả các Dim có giá trị 1200 thuộc vùng chọn (mục 5)

I.1: Trường hợp 2:

1. Nhập tên lệnh: A5

2. Hỏi kiểu lựa chọn (1. Dim hoặc 2. Text): 1

3. Kiểu chọn Dim (1. Nhập giá trị dim hoặc 2. Cận Dim): 2

4. Chọn cận Dim trên hoặc dưới (1. Cận trên hoặc 2. Cận dưới): 1

5. Nhập giá trị Cận trên: 1200

6. Select vùng lựa chọn: (Kéo chọn)

Lisp sẽ chọn tất cả các Dim có giá trị lớn hơn 1200 thuộc vùng chọn (mục 6)

I.1: Trường hợp 3:

1. Nhập tên lệnh: A5

2. Hỏi kiểu lựa chọn (1. Dim hoặc 2. Text): 1

3. Kiểu chọn Dim (1. Nhập giá trị dim hoặc 2. Cận Dim): 2

4. Chọn cận Dim trên hoặc dưới (1. Cận trên hoặc 2. Cận dưới): 2

5. Nhập giá trị Cận dưới: 1200

6. Select vùng lựa chọn: (Kéo chọn)

Lisp sẽ chọn tất cả các Dim có giá trị hơn hơn 1200 thuộc vùng chọn (mục 6)

I.1: Trường hợp 4:

1. Nhập tên lệnh: A5

2. Hỏi kiểu lựa chọn (1. Dim hoặc 2. Text): 2

3. Kiểu chọn Text (1. Nhập chuổi text 2. Pick chọn Text mẫu): 1

4. Select vùng lựa chọn: (Kéo chọn)

Lisp sẽ chọn tất cả các chuỗi Text giống chuỗi Text đã nhập thuộc vùng chọn (mục 4)

I.1: Trường hợp 5:

1. Nhập tên lệnh: A5

2. Hỏi kiểu lựa chọn (1. Dim hoặc 2. Text): 2

3. Kiểu chọn Text (1. Nhập chuổi text 2. Pick chọn Text mẫu): 2

4. Select vùng lựa chọn: (Kéo chọn)

Lisp sẽ chọn tất cả các chuỗi Text giống chuỗi Text mẫu thuộc vùng chọn (mục 4)

 

Ghi chú: - Cận Dim trên là Dim lớn hơn (ví dụ: cận Dim trên 1500 là các giá trị Dim >1500)

- Cận Dim dưới là Dim nhỏ hơn (ví dụ: cận Dim dưới 1500 là các giá trị Dim <1500)

- Tất cả các giá trị Dim có thể là Dim chế (Dim fake)

Cảm ơn các Bro trước nhé!

<<

Trong khi chờ mình tim cái mặt cắt dọc dầm bạn dùng thừ cái Mặt cắt sàn này nhé.

;VE MAT CAT SAN
(defun c:Mcs (/ A1 A2 A3 A4 A5 A6 A7 AA AA1 AM4...
>>

Trong khi chờ mình tim cái mặt cắt dọc dầm bạn dùng thừ cái Mặt cắt sàn này nhé.

;VE MAT CAT SAN
(defun c:Mcs (/ A1 A2 A3 A4 A5 A6 A7 AA AA1 AM4 B2 B3 B4 B5 B6 B66 B67 B7 BB
BB11 BB12 BX BX1 C1 C2 C3 C4 C5 C6 CC CL1 DD1 DDAM DDT DY DY1 G1
G10 G11 G12 G2 G7 G8 G9 GG7 GG8 J1 J10 J11 J12 J13 J14 J2 J3 J4
J5 J6 J7 J8 J9 JJ1 JJ2 K12 K19 KC KC1 LX LX1 LXY1 LY LY1 MM MM1
MM2 N10 N11 N12 N13 N14 N15 N16 N17 N18 N19 N7 N8 N9 NBC OD OU OV
P1 P10 P67 P9 Q1 Q2 Q3 TDD TDD1 TIEP TONG TT1 TTR1 TTR2 TTR3 U1 U2 U3 V1 XG YG)
(taolayer)
(SETQ NBC (GETVAR "CLAYER"))
(setvar "osmode" 1)
(setq tiep "C")
(setq tong 0)
(setq ddam 350)
(setq dy1 (getreal (strcat "Chieu cao dam < " (itoa ddam) " >: ")))
(if (null dy1) (setq dy1 ddam))
(setq ou 20)
(setq od 100)
(setq ov 200)
(initget 6)
(setq kc1 (getreal (strcat "\nkhoang bao ve (mm) <" (itoa ou) ">: ")))
(if (null kc1) (setq kc1 ou))
(setq dy (* dy1 5))
(setq kc (* kc1 4))
(while (= tiep "C")
(setvar "cmdecho" 0)
(setvar "osmode" 15359)
(setq BB (getpoint "Diem chen :"))
(setvar "osmode" 0)
(setq xg (car BB))
(setq yg (cadr BB))
(initget 6)
(setq Ly1 (getreal (strcat "\nChieu day ban (mm) <" (itoa od) ">: ")))
(if (null Ly1) (setq Ly1 od)) 
(setq Lxy1 (getreal "Chieu dai nhip(m) :"))
(setq Lx1 (* Lxy1 1000))
(setq Bx1 (getreal "Chieu dai thep am (mm):"))
(setq tdd1 (getreal (strcat "\nKhoang cach cac thanh thep (mm) <" (itoa ov) ">: ")))
(if (null tdd1) (setq tdd1 ov)) 
(SETQ TTR1 200)
(setq TTR2 (RTOS TTR1 2 0))
(setq Tt1 (RTOS TDD1 2 0))
(setq dd1 (STRCAT "a"TT1""))
(setq ddT (STRCAT "a"TTR2""))
(setq Lx (* Lx1 4))
(setq tong (+ tong Lx)) 
(setq Ly (* Ly1 5))
(setq Bx (* Bx1 4))
(setq tdd (* tdd1 4))
(setq TTR3 (* TTR1 4))
(setq B2 (list xg (+ yg Ly)))
(setq B3 (list xg (+ (- yg dy) Ly)))
(setq B4 (polar B3 0 880))
(setq B5 (polar BB 0 880))
(setq B6 (polar BB 0 Lx))
(setq B66 (polar B6 (* Pi 1.5) (- dy Ly)))
(setq B67 (polar B66 0 440))
(setq B7 (polar B2 0 (+ Lx 440)))
(setq p1 (/ Bx TTR3))
(setq g1 (fix p1))
(setq g2 (- g1 1))
(setq v1 (/ (- Lx 880) tdd))
(setq u1 (fix v1))
(setq u2 (+ u1 1))
(setq u3 (- (/ (- Lx (* u1 tdd)) 2) 440)) 
(setq A1 (list (+ xg 440) (+ yg kc)))
(setq A2 (list (+ xg 440) (- (cadr B2) kc)))
(setq A3 (polar A2 0 Bx))
(setq A4 (polar A1 0 Bx))
(setq Am4 (polar A4 (* Pi 1.5) kc))
(setq A5 (list (- (car A3) 50) (- (cadr A3) 50)))
(setq J5 A5)
(setq A7 (list (+ (+ (car A1) 440) u3) (+ (cadr A1) 50)))
(setq N7 (polar A7 0 tdd))
(setq N8 (polar N7 0 tdd))
(setq N9 (list (+ (car N7) (* 0.5 tdd)) (- (cadr n7) (+ 900 (* 1.5 KC)))))
(setq N10 (polar N9 0 900))
(setq N11 (polar N10 0 250))
(setq N12 (list (+ (car N9) 450) (+ (cadr N9) 220)))
(setq K12 (polar N12 (* Pi 1.5) 440))
(setq N13 (list (+ (car a7) (* tdd 6.5)) (cadr a1)))
(setq N14 (polar N13 (* Pi 1.25) kc))
(setq N15 (polar N13 (* Pi 0.25) kc))
(setq N16 (polar N13 (* Pi 1.5) (+ 900 kc)))
(setq N17 (polar N16 0 900))
(setq N18 (polar N17 0 250))
(setq N19 (list (+ (car N16) 450) (+ (cadr N16) 220)))
(setq K19 (polar N19 (* Pi 1.5) 440))
(command "osmode" 0 "")
(setvar "CLAYER" "8")
(command ".line" N7 N9 N8 "")
(command ".line" N10 N9 "")
(command ".line" N14 N15 "")
(command ".line" N13 N16 N17 "")
(setvar "CLAYER" "3")
(command ".text" "mc" N12 "250" "0" "/G10" "")
(command ".text" "mc" N19 "250" "0" "/g10" "")
(command ".text" "mc" K12 "250" "0" DD1 "")
(command ".text" "mc" K19 "250" "0" DD1 "")
(setq A6 (polar A1 0 Lx))
(setq AA1 (polar A3 (* 1.5 Pi) Ly))
(setq AA (polar A2 (* 0.5 Pi) 1500))
(setq C1 (polar B3 0 440))
(setq C3 (polar C1 0 Lx))
(setq C5 (polar C1 (* 1.5 Pi) 800))
(setq C2 (polar C5 0 (/ Lx 2)))
(setq C6 (polar C5 (* 1.5 Pi) 100))
(setq C4 (polar C6 (* 1.5 Pi) 350))
(setq CC (polar C2 (* 0.5 Pi) 250))
(command "osmode" 0 "")
(setvar "CLAYER" "3")
(command "donut" "0" kc A5 A7"")
(repeat g2
(setq A5 (polar A5 Pi TTR3))
(command "donut" "0" kc A5 "")
)
(setq mm (ssget "W" A2 AA1))
(setq J6 (polar J5 Pi TTR3))
(setq J4 (polar A3 Pi (* TTR3 1.5)))
(setq jj1 (polar j4 (* Pi 1.25) kc))
(setq jj2 (polar j4 (* Pi 0.25) kc))
(setvar "CLAYER" "8")
(command ".line" JJ1 JJ2 "")
(setq J7 (polar J6 0 (* TTR3 0.5)))
(setq J8 (polar J7 (* 0.5 Pi) 800))
(setq J3 (polar J4 (* 0.5 Pi) 800))
(setq J2 (polar J3 Pi 900))
(setq J9 (polar J8 0 900))
(setq J10 (polar J9 0 250))
(setq J1 (polar J2 Pi 250))
(command ".line" J5 J8 J6 "")
(command ".line" J8 J9 "")
(command ".line" J4 J3 J2 "")
(command ".circle" J1 "d" 500)
(setq cl1 (entlast))
(setq J11 (list (+ (car J2) 450) (+ (cadr J2) 220)))
(setq J12 (polar J11 (* Pi 1.5) 440))
(setq J13 (list (+ (car J8) 450) (+ (cadr J8) 220)))
(setq J14 (polar J13 (* Pi 1.5) 440))
(setvar "CLAYER" "3") 
(command ".text" "mc" J11 "250" "0" "/G10" "")
(command ".text" "mc" J13 "250" "0" "%%c6" "")
(command ".text" "mc" J12 "250" "0" DDT "")
(command ".text" "mc" J14 "250" "0" "a200" "")
(command "-ATTDEF" "" "+" "1" "1" "j" "mc" J1 "250" "")
(if (= (tblsearch "block" "ghithep") nil)
(command "block" "ghithep" J1 (entlast) cl1 "")
)
(if (/= (tblsearch "block" "ghithep") nil)
(command "block" "ghithep" "y" J1 (entlast) cl1 "")
)
(repeat u1
(setq A7 (polar A7 0 tdd))
(command "donut" "0" kc A7 "")
)
(setvar "CLAYER" "7")
(command ".line" BB B3 B4 B5 B6 "")
(command ".line" B2 B7 "")
(command ".line" B6 B66 B67 "")
(command ".line" C5 C6 "")
(setvar "CLAYER" "4")
(command ".pline" A2 A3 Am4 "")
(setq mm1 (ssget "L")) 
(command ".line" A1 A6 "")
(setvar "CLAYER" "100")
(command ".DIMLINEAR" C1 C3 C2)
(setq BB11 (polar BB (* 1 Pi) 500))
(setq BB12 (polar BB11 (* 1 Pi) 700)) 
(setvar "CLAYER" "20")
(command ".DIMLINEAR" BB B2 BB11)
(command ".DIMLINEAR" B3 B2 BB12)
(setvar "CLAYER" "100")
(command ".DIMLINEAR" A2 A3 AA)
(setq mm2 (ssget "L"))
(chenblock N11 1 1)
(chenblock N18 1 1)
(chenblock J1 "1" "1")
(chenblock J10 "1" "1")
(chenblock C4 "1.4" "1.4")
(command ".select" mm mm1 mm2 "")
(command ".mirror" "p" "" C2 CC "")
(initget 1 "C K")
(setq tiep (strcase (getkword "Lam tiep cau kien khac  :")))
)
(setq g7 (polar B67 (* Pi 0) 440))
(setq g8 (polar g7 (* Pi 0.5) dy))
(setq g9 (polar g8 (* Pi 1) 440))
(setq g10 (polar g9 (* Pi 1.5) kc))
(setq j10 (polar g9 (* Pi 1.5) (- Ly kc)))
(setq g11 (polar g10 (* Pi 0) 360))
(setq g12 (polar g11 (* Pi 1.5) (- Ly kc)))
(setq p67 (polar b67 (* 1.5 Pi) 800))
(setq p9 (polar p67 (* 1.5 Pi) 100))
(setq p10 (polar p9 (* 1.5 Pi) 350))
(setq j11 (polar j10 0 300))
(setq j12 (polar j11 (* 0.5 Pi) 100))
(setq j13 (polar j12 Pi 90))
(chenblock p10 "1.4" "1.4")
(setvar "CLAYER" "4")
(command "pline" j13 j12 "a" "a" -180 j11 "l" j10 "")
(setq Q1 (ssget "L")) 
(command "pline" g10 g11 g12 "")
(setq Q2 (ssget "L")) 
(setvar "CLAYER" "7")
(command ".line" B67 g7 "")
(command ".line" g8 g9 "")
(command ".line" g8 g7 "")
(setq gG7 (polar G7 Pi (/ (+ tong 880) 2)))
(setq gG8 (polar G8 Pi (/ (+ tong 880) 2)))
(setq Q3 (ssget "L")) 
(command ".line" p9 p67 "")
(command ".select" Q1 Q2 Q3 "")
(command ".mirror" "p" "" GG7 GG8 "")
(setvar "osmode" 691)
(SETVAR "CLAYER" NBC)
)
(defun taolayer ()
(if (= (tblsearch "layer" "3") nil) (command "layer" "n" "3" ""))
(if (= (tblsearch "layer" "4") nil) (command "layer" "n" "4" ""))
(if (= (tblsearch "layer" "7") nil) (command "layer" "n" "7" ""))
(if (= (tblsearch "layer" "8") nil) (command "layer" "n" "8" ""))
(if (= (tblsearch "layer" "20") nil) (command "layer" "n" "20" ""))
(if (= (tblsearch "layer" "100") nil) (command "layer" "n" "100" ""))
)
(defun chenblock ( dcb x y /)
(command "-insert" "ghithep" dcb x y "" "")
)

Bạn có thể chỉ giùm mình đoạn nào trong code này để vẽ ký hiệu trục là vòng tròn lớn trong lisp này không?Cảm ơn bạn trước.

<<

Mình sửa cho bạn này. Lớp bảo vệ bằng nhau thì đường kính thép sẽ bằng nhau.

;; free lisp from cadviet.com
(defun c:MCD (/ A B C BV D E D1 E1 F...
>>

Mình sửa cho bạn này. Lớp bảo vệ bằng nhau thì đường kính thép sẽ bằng nhau.

;; free lisp from cadviet.com
(defun c:MCD (/ A B C BV D E D1 E1 F P1 P2 S)
(setq oldosmode (getvar "osmode"))
(setvar "osmode" 0)
(setq 
A (getreal "\nBe rong mc DAM:")
B (getreal "\nBe dai mc DAM:")
S (getreal "\nBe day san:")
BV (getreal "\nLop bv mc DAM:")
D (getint "\nS.luong thep ngang mc DAM:")
E (getint "\nS.luong thep doc mc DAM:")
P1 (getpoint "\nDiem chen:")
F (* bv 0.7)
D1 (/ (- A (* 2 BV) (* F 2)) (- D 1))
E1 (/ (- B (* 2 BV) (* F 2)) (- E 1))
); end of setq
(command ".rectangle" "f" (* bv 0.5) (list (+ (car P1) BV) (+ (cadr P1) BV)) 
(list (+ (car P1) (- A BV)) (+ (cadr P1) (- B BV))) "" "f" "0" ""
".change" "L" "" "P" "C" 1 ""
".pline" (Polar P1 0 (/ A 2)) "W" 0 0 
P1
(setq P11 (list (car P1) (+ (cadr P1) (- B S))))
(setq P11 (list (- (car P11) (* 2 S)) (cadr P11)))
(list (car P11) (- (cadr P11) (* 0.4 S)))
(setq P11 (list (car P11) (+ (cadr P11) (* 0.4 S))))
(setq P11 (list (- (car P11) (* 0.4 S)) (cadr P11)))
(setq P11 (list (+ (car P11) (* 0.8 S)) (+ (cadr P11) (* 0.2 S))))
(setq P11 (list (- (car P11) (* 0.4 S)) (cadr P11)))
(list (car P11) (+ (cadr P11) (* 0.8 S)))
(setq P11 (list (car P11) (+ (cadr P11) (* 0.4 S))))
(setq P11 (list (+ (car P11) (* 2 S) (/ A 2)) (cadr P11)))
""
".mirror" "L" "" (Polar P1 0 (/ A 2)) P11 ""
".pedit" "l" "j" "p" "l" "" ""

); end of command
(setq P2 (list (+ (car P1) BV F) (+ (cadr P1) BV F)))
(repeat D 
(command ".donut" 0 F P2 ^C)
(setq P2 (polar P2 0 D1))
); end of repeat1
(setq P2 (list (+ (car P1) BV F) (+ (cadr P1) (- B BV F) )))
(repeat D 
(command ".donut" 0 F P2 ^C)
(setq P2 (polar P2 0 D1))
); end of repeat2
(setq P2 (list (+ (car P1) BV F) (+ (cadr P1) BV F)))
(repeat (- E 2)
(setq P2 (polar P2 (/ pi 2) E1))
(command ".donut" 0 F P2 ^C)
); end of repeat3
(setq P2 (list (+ (car P1) (- A BV F)) (+ (cadr P1) BV F)))
(repeat (- E 2)
(setq P2 (polar P2 (/ pi 2) E1))
(command ".donut" 0 F P2 ^C)
); end of repeat3
(setvar "osmode" oldosmode)
)

;; free lisp from cadviet.com

(defun c:MCC (/ A B C BV D E D1 E1 F P1 P2)
       (vl-load-com)
(setq oldosmode (getvar "osmode"))
       (setvar "osmode" 0)
       (setq 
	A (getreal "\nBe rong mc cot:")
	B (getreal "\nBe dai mc cot:")
	BV (getreal "\nLop bv mc cot:")
	D (getint "\nS.luong thep ngang mc cot:")
	E (getint "\nS.luong thep doc mc cot:")
	P1 (getpoint  "\nDiem chen:")
               F (* BV 0.7)
		D1 (/ (- A (* 2 BV) (* F 2)) (- D 1))
	E1 (/ (- B (* 2 BV) (* F 2)) (- E 1))
       ); end of setq
(command ".rectangle" "f" "0" P1 (list (+ (car P1) A) (+ (cadr P1) :undecided: ) ""
	".offset" BV (ssget P1) (list (+ (car P1) BV) (+ (cadr P1) BV)) ""
       )
       (setq ver (acet-geom-vertex-list (entlast)))
       (entdel (entlast))
       (command ".rectangle" "f" (* bv 0.7) (car ver) (caddr ver)
        ".change" (entlast) "" "P" "C" 1 ""
       ); end of command
       (setq 	P2 (list (+ (car P1) BV F) (+ (cadr P1) BV F)))
    	(repeat D 
	(command ".donut" 0 F P2 ^C)
       	(setq P2 (polar P2 0 D1))
     	); end of repeat1
       (setq 	P2 (list (+ (car P1) BV F) (+ (cadr P1) (- B BV F) )))
    	(repeat D 
	(command ".donut" 0 F P2 ^C)
       	(setq P2 (polar P2 0 D1))
     	); end of repeat2
       (setq 	P2 (list (+ (car P1) BV F) (+ (cadr P1) BV F)))
       (repeat (- E 2)
      		(setq P2 (polar P2 (/ pi 2)  E1))
	(command ".donut" 0 F P2 ^C)
       ); end of repeat3
 	(setq 	P2 (list (+ (car P1) (- A BV F)) (+ (cadr P1) BV F)))
	(repeat (- E 2)
      		(setq P2 (polar P2 (/ pi 2)  E1))
	(command ".donut" 0 F P2 ^C)
       ); end of repeat3
(setvar "osmode" oldosmode)
); end of ve mc cot

Bác có thể chỉ cho e thí dụ e muốn đường bao ngoài có tên là layer DB,còn cốt đai thì là layer CD, chấm thép là layer THEP ,thì phải làm sao,e sử dụng các cách mà không áp dụng được cho lisp này.Mong sự giúp đỡ của các bác.

<<

Mình sửa cho bạn này. Lớp bảo vệ bằng nhau thì đường kính thép sẽ bằng nhau.

;; free lisp from cadviet.com
(defun c:MCD (/ A B C BV D E D1 E1 F...
>>

Mình sửa cho bạn này. Lớp bảo vệ bằng nhau thì đường kính thép sẽ bằng nhau.

;; free lisp from cadviet.com
(defun c:MCD (/ A B C BV D E D1 E1 F P1 P2 S)
(setq oldosmode (getvar "osmode"))
(setvar "osmode" 0)
(setq 
A (getreal "\nBe rong mc DAM:")
B (getreal "\nBe dai mc DAM:")
S (getreal "\nBe day san:")
BV (getreal "\nLop bv mc DAM:")
D (getint "\nS.luong thep ngang mc DAM:")
E (getint "\nS.luong thep doc mc DAM:")
P1 (getpoint "\nDiem chen:")
F (* bv 0.7)
D1 (/ (- A (* 2 BV) (* F 2)) (- D 1))
E1 (/ (- B (* 2 BV) (* F 2)) (- E 1))
); end of setq
(command ".rectangle" "f" (* bv 0.5) (list (+ (car P1) BV) (+ (cadr P1) BV)) 
(list (+ (car P1) (- A BV)) (+ (cadr P1) (- B BV))) "" "f" "0" ""
".change" "L" "" "P" "C" 1 ""
".pline" (Polar P1 0 (/ A 2)) "W" 0 0 
P1
(setq P11 (list (car P1) (+ (cadr P1) (- B S))))
(setq P11 (list (- (car P11) (* 2 S)) (cadr P11)))
(list (car P11) (- (cadr P11) (* 0.4 S)))
(setq P11 (list (car P11) (+ (cadr P11) (* 0.4 S))))
(setq P11 (list (- (car P11) (* 0.4 S)) (cadr P11)))
(setq P11 (list (+ (car P11) (* 0.8 S)) (+ (cadr P11) (* 0.2 S))))
(setq P11 (list (- (car P11) (* 0.4 S)) (cadr P11)))
(list (car P11) (+ (cadr P11) (* 0.8 S)))
(setq P11 (list (car P11) (+ (cadr P11) (* 0.4 S))))
(setq P11 (list (+ (car P11) (* 2 S) (/ A 2)) (cadr P11)))
""
".mirror" "L" "" (Polar P1 0 (/ A 2)) P11 ""
".pedit" "l" "j" "p" "l" "" ""

); end of command
(setq P2 (list (+ (car P1) BV F) (+ (cadr P1) BV F)))
(repeat D 
(command ".donut" 0 F P2 ^C)
(setq P2 (polar P2 0 D1))
); end of repeat1
(setq P2 (list (+ (car P1) BV F) (+ (cadr P1) (- B BV F) )))
(repeat D 
(command ".donut" 0 F P2 ^C)
(setq P2 (polar P2 0 D1))
); end of repeat2
(setq P2 (list (+ (car P1) BV F) (+ (cadr P1) BV F)))
(repeat (- E 2)
(setq P2 (polar P2 (/ pi 2) E1))
(command ".donut" 0 F P2 ^C)
); end of repeat3
(setq P2 (list (+ (car P1) (- A BV F)) (+ (cadr P1) BV F)))
(repeat (- E 2)
(setq P2 (polar P2 (/ pi 2) E1))
(command ".donut" 0 F P2 ^C)
); end of repeat3
(setvar "osmode" oldosmode)
)

;; free lisp from cadviet.com

(defun c:MCC (/ A B C BV D E D1 E1 F P1 P2)
       (vl-load-com)
(setq oldosmode (getvar "osmode"))
       (setvar "osmode" 0)
       (setq 
	A (getreal "\nBe rong mc cot:")
	B (getreal "\nBe dai mc cot:")
	BV (getreal "\nLop bv mc cot:")
	D (getint "\nS.luong thep ngang mc cot:")
	E (getint "\nS.luong thep doc mc cot:")
	P1 (getpoint  "\nDiem chen:")
               F (* BV 0.7)
		D1 (/ (- A (* 2 BV) (* F 2)) (- D 1))
	E1 (/ (- B (* 2 BV) (* F 2)) (- E 1))
       ); end of setq
(command ".rectangle" "f" "0" P1 (list (+ (car P1) A) (+ (cadr P1) :undecided: ) ""
	".offset" BV (ssget P1) (list (+ (car P1) BV) (+ (cadr P1) BV)) ""
       )
       (setq ver (acet-geom-vertex-list (entlast)))
       (entdel (entlast))
       (command ".rectangle" "f" (* bv 0.7) (car ver) (caddr ver)
        ".change" (entlast) "" "P" "C" 1 ""
       ); end of command
       (setq 	P2 (list (+ (car P1) BV F) (+ (cadr P1) BV F)))
    	(repeat D 
	(command ".donut" 0 F P2 ^C)
       	(setq P2 (polar P2 0 D1))
     	); end of repeat1
       (setq 	P2 (list (+ (car P1) BV F) (+ (cadr P1) (- B BV F) )))
    	(repeat D 
	(command ".donut" 0 F P2 ^C)
       	(setq P2 (polar P2 0 D1))
     	); end of repeat2
       (setq 	P2 (list (+ (car P1) BV F) (+ (cadr P1) BV F)))
       (repeat (- E 2)
      		(setq P2 (polar P2 (/ pi 2)  E1))
	(command ".donut" 0 F P2 ^C)
       ); end of repeat3
 	(setq 	P2 (list (+ (car P1) (- A BV F)) (+ (cadr P1) BV F)))
	(repeat (- E 2)
      		(setq P2 (polar P2 (/ pi 2)  E1))
	(command ".donut" 0 F P2 ^C)
       ); end of repeat3
(setvar "osmode" oldosmode)
); end of ve mc cot

Bác có thể chỉ cho e thí dụ e muốn đường bao ngoài có tên là layer DB,còn cốt đai thì là layer CD, chấm thép là layer THEP ,thì phải làm sao,e sử dụng các cách mà không áp dụng được cho lisp này.Mong sự giúp đỡ của các bác.

<<

;**************CHUYEN TEXT TU CAD SANG EXCEL******************************
(defun c:c2e ( / hangdau)
  (defun sosanh
	(e1 e2 / p1 p2)
    (setq p1 (car e1)
	  p2 (car e2)    )
    (if	(equal (cadr p1) (cadr p2) fuzz)
      (< (car p1) (car p2)) 
     (> (cadr p1) (cadr p2))    )  ) 
 (setq    ss	    (ssget '((0 . "TEXT")))        lst	    (ss2ent ss)    lst  
   (mapcar '(lambda (e) (cons (cdr (assoc 10 (entget...
>>

;**************CHUYEN TEXT TU CAD SANG EXCEL******************************
(defun c:c2e ( / hangdau)
  (defun sosanh
	(e1 e2 / p1 p2)
    (setq p1 (car e1)
	  p2 (car e2)    )
    (if	(equal (cadr p1) (cadr p2) fuzz)
      (< (car p1) (car p2)) 
     (> (cadr p1) (cadr p2))    )  ) 
 (setq    ss	    (ssget '((0 . "TEXT")))        lst	    (ss2ent ss)    lst  
   (mapcar '(lambda (e) (cons (cdr (assoc 10 (entget e))) (cdr (assoc 1 (entget e))))) lst)   
   caotext (cdr (assoc 40 (entget (ssname ss 0))))    fuzz    (* caotext 1.0)    lst
	    (vl-sort lst 'sosanh)    index   1    oldy nil    fn      (getfiled "Chon file de save" "" "csv" 1) 
   fid     (open fn "w")  )  
  (foreach e lst    (if	(equal oldy (cadr (car e)) fuzz)  
   (progn        	(princ "," fid)
	(setq index (1+ index))      )  
          (progn	(if hangdau	  (progn	    (setq index 1)	
	    (princ "\n" fid)	    	  )	
  (setq hangdau t)	 )      )    )   
 (princ (cdr e) fid)  
  (setq oldy (cadr (car e)))  )
  (close fid))(defun ss2ent (ss / sodt index lstent) 
 (setq    sodt  (if ss	    (sslength ss)	    0	  )    index 0  )
  (repeat sodt    (setq ent	
 (ssname ss index)	  index
	 (1+ index)	  lstent (cons ent lstent)    )  ) 
 (reverse lstent)

Xin chào các bác!

Em có đoạn lisp như trên copy từ diễn đàn về. Nhưng khi em sử dụng để xuất text sang Excel thì những dòng text nào em có dấu phẩy "," thì tự động dòng text sau dấu phẩy bị tách sang cột khác. Các bác có thể điều chỉnh đoạn lisp trên để không bị tình trạng như thế ạ.

Em xin cảm ơn các bác ạ

- yêu cầu 1 : cập nhật.

- yêu cầu 2 : Rải cả điểm đầu và cuối của đường dẫn.

Về mặt...

>>

- yêu cầu 1 : cập nhật.

- yêu cầu 2 : Rải cả điểm đầu và cuối của đường dẫn.

Về mặt lập trình, việc thêm tùy chọn "Rải cả điểm đầu và cuối của đường dẫn (Yes/No):" LISP có thể đáp ứng đuợc. Nhưng theo quan điểm cá nhân tôi, thêm tùy chọn này chỉ làm rối thêm Lisp (trong t/hợp có giao điểm thưc giữa đuờng dẫn và đối tựong lấy giao điểm tại điểm đầu hay điểm cuối).

Do đó trong t/hợp bạn phải dùng Lisp này và muốn "Rải cả điểm đầu và cuối của đường dẫn", vui lòng "vẽ thêm 1 line nối điểm đầu và cuối của đường dẫn" truớc khi chạy lisp này (dĩ nhiên sau đó nhớ xóa line này đi).

(defun c:ATIC(/ ent ov pts ss  h num eEnt pick txt); ATIC -> Add Text at Intersect with Curve
 ;;  By : Gia_Bach, www.CadViet.com 2011    ;;  
 (vl-load-com)
 (command "undo" "be")
 (setq ov (getvar "cmdecho") )
 (setvar "cmdecho" 0)
 (if (and (setq eEnt (entsel "\nChon Curve :"))
   (setq ent (car eEnt) pick (trans (cadr eEnt) 1 0))
   (wcmatch (cdr (assoc 0 (entget ent))) "*LINE,ARC")
   (princ "\nChon doi tuong lay giao diem :")
   (setq ss (ssget (list (cons 0 "*LINE,ARC,CIRCLE,ELLIPSE"))))
   (setq pts (ent_ss_interpts (setq ent (vlax-ename->vla-object ent) ) ss))
   (>(vl-list-length pts)0)	      )
   (progn
     (or *h* (setq *h* 1))
     (initget 6)
     (setq h (getdist (strcat "\nChieu cao chu <" (rtos *h*) "> :")))
     (if h (setq *h* h))
     (or *num* (setq *num* 1))
     (setq num (getint (strcat "\nGia tri bat dau <" (itoa *num*) "> :")))
     (if num (setq *num* num) )
     (or spc (setq spc (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-Acad-Object)))))      
     (foreach pt (if (> (vlax-curve-getDistAtPoint ent (vlax-curve-getClosestPointTo ent pick))
		 (/ (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))2))
	    (reverse pts) pts)
(setq txt (vla-AddText spc (itoa *num*) (vlax-3D-point pt) *h*)
      *num* (1+ *num*))
(vla-put-alignment txt 10)
(vla-put-TextAlignmentPoint txt (vlax-3D-point pt)))
     (setvar "cmdecho" ov)
     (command "undo" "e")      )
   (alert "Khong tim duoc giao diem!"))
 (princ))

(defun ent_ss_interpts (ent ss / e i intpts lst_pt)
 ;;  By : Gia_Bach, www.CadViet.com 2011    ;;  
 (defun list->3pair (old / new)
   (while (setq new (cons (list (car old) (cadr old) (caddr old)) new)
	 old (cdddr old)))
   (reverse new)      )  
 (setq i -1)
 (while (setq e (ssname ss (setq i (1+ i))))
   (if (and
  (not (equal ent (setq eObj (vlax-Ename->Vla-Object e))))
  (setq intpts (vlax-invoke ent 'IntersectWith eObj 0)) )
     (foreach pt (list->3pair intpts)
(if (not (vl-position pt lst_pt))
  (setq lst_pt (cons pt lst_pt)) )))      )
 (vl-sort lst_pt
   '(lambda (x y)
      (< (vlax-curve-getParamAtPoint ent (vlax-curve-getClosestPointTo ent x))
	 (vlax-curve-getParamAtPoint ent (vlax-curve-getClosestPointTo ent y)))))    )

Cảm ơn anh gia_bach,lisp của an đã làm tốt yêu cầu của em rồi.Nhưng em mong anh có thể kết hợp thêm với lisp của anh Duy vì lúc rải đối tượng em có 2 lựa chọn: 1 là khoảng cách và 2 là tìm giao điểm của các đường giao như lisp của anh.Mong anh và anh Duy cùng các anh khác trên diễn đàn kết hợp 2lisp này giùm em với anh.Em lại được voi đòi tiên rồi.hihi.Cảm ơn anh gia_bach và anh duy nhiều

<<

 

Mình gửi bạn lisp xuất sang file text,mình thường dùng đề lấy cao độ khi làm san nền ( một số video hướng dẫn san nền mình...

>>

 

Mình gửi bạn lisp xuất sang file text,mình thường dùng đề lấy cao độ khi làm san nền ( một số video hướng dẫn san nền mình cũng dùng lisp này)

(defun doichu ()
  (setvar "cmdecho" 0)
  (setvar "cmdecho" 0)
  (setvar "osmode" 0)
(if_file2)
  ;(setq s (getstring "\nFilename <Khong-Ten>: "))
;(if (= s nul) (setq s "Khong-Ten"))
(setq fn (open filename2 "w"))
  (setq i 0)
  (setq j 1)
  (prompt "\n")
  (prompt "\Chän C¸c §iÓm Cao §é : ")
  (setq ss  (ssget (list (cons 0 "Text"))))
  (if ss
            	(progn
                   	(repeat (sslength ss)   
	(setq ent (entget (ssname ss i)))    
	(setq nd (cdr (assoc 1 ent)))
	(setq ss1 (cdr (assoc 72 ent)))
	(setq ss2 (cdr (assoc 73 ent)))
 	(if (and (= ss1 0) (= ss2 0))
    	(setq td (cdr (assoc 10 ent)))
    	(setq td (cdr (assoc 11 ent)))
 	)
	;(setq td1 (cdr (assoc 10 ent)))
   (setq Y (cadr td))
   (setq X (car td))
   (setq z (caddr td))
   (write-line (strcat (itoa j)
     	" "
     	(rtos X 2 3)
     	" "
     	(rtos Y 2 3)
     	" "
     	(rtos z 2 3)
     	" "
     	nd
     	) fn)
	(setq i (+ i 1))
   (setq j (+ j 1))
    	)
	)
	)
  (close fn)
  (setvar "osmode" 191)
  (prompt "\n****	Chóc B¹n Thµnh C«ng ***")
  (princ) 
)
;********************************
;*********
(defun c:xtd ()
  	(doichu)     
  )
;;***************************Mo file
(defun if_file1 (/ name1)
  (if (= filename1 nil)
	(progn
           	(setq name1 (getfiled "Më TËp Tin Chøa Sè LiÖu"
                        	(strcat "d:/canhan/TUAN/luu/" "solieu") "txt" 2))
           	(if name1 (setq filename1 (strcase name1)))
  	)
	(progn
	(setq name1 (getfiled "Më TËp Tin Chøa Sè LiÖu"
                        	filename1 "txt" 2))
           	(if name1 (setq filename1 (strcase name1)))
	)
	)
           	)
;****************************Ghi file
(defun if_file2 (/ name2)
  (if (= filename2 nil)
	(progn
           	(setq name2 (getfiled "Më TËp Tin Chøa Sè LiÖu"
                        	(strcat "d:/canhan/TUAN/luu/" "solieu") "txt" 1))
           	(if name2 (setq filename2 (strcase name2)))
  	)
	(progn
	(setq name2 (getfiled "L­u TËp Tin Sè LiÖu"
                        	filename2 "txt" 1))
           	(if name2 (setq filename2 (strcase name2)))
	)
	)
           	)

Vậy bác có cái nào làm ngược lại không bác? tức từ file txt (giống như file bác xuất ra) và import các điểm vào bản vẽ có hiện cái cột thứ 5 cao độ lên ấy bác.

<<

2 giờ trước, jangboko đã nói:

Chào các bạn. Mình có vấn đề...

>>

2 giờ trước, jangboko đã nói:

Chào các bạn. Mình có vấn đề với tỷ lệ với các đối tượng chứa annotative. Mong các bạn giúp đỡ.

- lệnh "AIOBJECTSCALEREMOVE" có tác dụng remo tỷ lệ hiện hành trong đối tượng chứa annotative ( ví dụ ở môi trường model mình đang để tỷ lệ annotative là 30. Khi sử dụng lệnh " AIOBJECTSCALEREMOVE " nó sẽ remo tỷ lệ 30 trong đối tượng được chọn). Mình nhờ các bạn viết hộ mình 1 lisp có tác dụng ngược lại. Có nghĩa là nó sẽ remo tất cả các tỷ lệ trong đối tượng đó, trừ tỷ lệ hiện hành. 

- Cám ơn các bạn, cám ơn diễn đàn :D

Không biết đúng ý bạn không. ^_^

(nguồn http://www.cadtutor.net/forum/showthread.php?53069-Annotative-troubles&amp;p=359702&amp;viewfull=1#post359702)

Code here:

(defun c:ObjectScaleCurOnly (/ ss n scLst OSC:GetScales)
  (print "Select the objects you wish to modify: ")
  (if (or (setq ss (ssget "I")) (setq ss (ssget)))
    (progn
      ;; Define helper function to get scales attached to an entity
      (defun OSC:GetScales (en / ed xn xd cdn cdd asn asd cn cd sn sd cannoscale)
        (setq ed (entget en))
        (if (and
              ;; Get the XDictionary attached to the object
              (setq xn (vl-position '(102 . "{ACAD_XDICTIONARY") ed))
              (setq xn (cdr (nth (1+ xn) ed)))
              (setq xd (entget xn))
              ;; Get the Context Data Management dictionary attached to the XDictionary
              (setq cdn (vl-position '(3 . "AcDbContextDataManager") xd))
              (setq cdn (cdr (nth (1+ cdn) xd)))
              (setq cdd (entget cdn))
              ;; Get the Annotation Scales dictionary attached to the CD
              (setq asn (vl-position '(3 . "ACDB_ANNOTATIONSCALES") cdd))
              (setq asn (cdr (nth (1+ asn) cdd)))
              (setq asd (entget asn))
              ;; Get the 1st scale attached
              (setq cn (assoc 3 asd))
              (setq cn (member cn asd))
            )
          ;; Step through all scales attached
          (while cn
            (if (and (= (caar cn) 350) ;It it's pointing to a scale record
                     ;; Get the record's data
                     (setq cd (entget (cdar cn)))
                     ;; Get the Context data class
                     (setq sn (assoc 340 cd))
                     (setq sd (entget (cdr sn)))
                     (setq sn (assoc 300 sd))
                     ;; Check if the scale is already in the list
                     (not (vl-position (cdr sn) scLst))
                )
              ;; Add it to the list
              (setq scLst (cons (cdr sn) scLst))
            )
            (setq cn (cdr cn))
          )
        )
      )

      ;; Find a list of scales used in selection
      (setq n (sslength ss))
      (while (>= (setq n (1- n)) 0)
        (OSC:GetScales (ssname ss n))
      )

      ;; Add the current scale to the selection
      (setq cannoscale (getvar "CANNOSCALE"))
      (command "._ObjectScale" ss "" "_Add" cannoscale "")

      ;; Remove all other scales attached
      (command "._ObjectScale" ss "" "_Delete")
      (foreach n scLst
        (if (wcmatch (strcase n) (strcat "~" (strcase cannoscale)))
          (command n)
        )
      )
      (command "")
    )
  )

  (princ)
)

 

<<

Oà...! Copy lisp ở trên về phải bổ sung thêm 3 hàm nữa...

(defun C:VZZ  (/ zxp KC KC1 NAME PT vpObj tyle)
 (if (setq zxp (getreal (STRCAT "- Nhap ty le zoom: 1:")))
  (progn (if (eq (vla-get-DisplayLocked
                  (setq vpObj (vlax-ename->vla-object (acet-currentviewport-ename))))
                 :vlax-true)
          (vla-put-DisplayLocked vpObj :vlax-False))
         (cond ((and...
>>

Oà...! Copy lisp ở trên về phải bổ sung thêm 3 hàm nữa...

(defun C:VZZ  (/ zxp KC KC1 NAME PT vpObj tyle)
 (if (setq zxp (getreal (STRCAT "- Nhap ty le zoom: 1:")))
  (progn (if (eq (vla-get-DisplayLocked
                  (setq vpObj (vlax-ename->vla-object (acet-currentviewport-ename))))
                 :vlax-true)
          (vla-put-DisplayLocked vpObj :vlax-False))
         (cond ((and (= (getvar "TILEMODE") 0) (> (getvar "CVPORT") 1))
                (Add-ScaleList (setq tyle (strcat "1:" (rtos zxp 2 0))))
                (setvar "cannoscale" tyle)
                (setq zxp (strcat "1/" (rtos zxp 2 0) "xp"))
                (command "zoom" zxp))
               ((and (= (getvar "TILEMODE") 0) (= (getvar "CVPORT") 1))
                (setq PT (cadr (grread 't 15))
                      KC 999999999999999999)
                (foreach ssn  (ss->list (ssget "c"
                                               (get-coordinate-screen "BR")
                                               (get-coordinate-screen "TL")
                                               '((0 . "VIEWPORT"))))
                 (if (> KC (setq KC1 (distance PT (dxf 10 ssn))))
                  (setq KC   KC1
                        name ssn)))
                (command "mspace")
                (if name
                 (setvar "cvport" (dxf 69 name)))
                (vla-put-DisplayLocked
                 (vlax-ename->vla-object name)
                 :vlax-false)
                (Add-ScaleList (setq tyle (strcat "1:" (rtos zxp 2 0))))
                (setvar "cannoscale" tyle)
                (setq zxp (strcat "1/" (rtos zxp 2 0) "xp"))
                (command "zoom" zxp)
                (princ))
               (t (Prompt (STRCAT "** lenh nay su dung trong Layout **"))))))
 (princ))
(defun ss->list  (ss / i l)
 (if ss
  (repeat (setq i (sslength ss))
   (setq l (cons (ssname ss (setq i (1- i))) l)))))
(defun dxf (code ent) (cdr (assoc code (entget ent))))
(defun dxf-etg-m  (code etg / lst)
 (foreach asoc  etg
  (if (= code (car asoc))
   (setq lst (append lst (list (cdr asoc))))))
 lst)
(defun Add-ScaleList  (tyle / dic lst)
 (setq lst '("A0" "A1" "A2" "A3" "A4" "A5" "A6" "A7" "A8" "A9" "B0" "B1" "B2" "B3" "B4" "B5" "B6"
             "B7" "B8" "B9" "C0" "C1" "C2" "C3" "C4" "C5" "C6" "C7" "C8" "C9" "D0" "D1" "D2" "D3"
             "D4" "D5" "D6" "D7" "D8" "D9" "E0" "E1" "E2" "E3" "E4" "E5" "E6" "E7" "E8" "E9" "F0"
             "F1" "F2" "F3" "F4" "F5" "F6" "F7" "F8" "F9" "G0" "G1" "G2" "G3" "G4" "G5" "G6" "G7"
             "G8" "G9"))
 (if (setq dic (dictsearch (namedobjdict) "ACAD_SCALELIST"))
  (if (not
       (member Tyle
               (mapcar '(lambda (x) (cdr (assoc 300 (entget x))))
                       (dxf-etg-m 350 dic))))
   (entmod
    (append dic
            (list (cons 3 (cadr (member (cdadr (reverse dic)) lst)))
                  (cons 350
                        (entmakex
                         (list '(0 . "SCALE")
                               '(102 . "{ACAD_REACTORS")
                               '(102 . "}")
                               '(100 . "AcDbScale")
                               '(70 . 0)
                               (cons 300 tyle)
                               '(140 . 1.0)
                               (cons 141 (atoi (substr tyle 3 (strlen tyle))))
                               '(290 . 0))))))))))
(defun get-coordinate-screen  (coner / Y1 X1)
 (cond ((= (strcase coner) "TL")
        (polar (polar (getvar "viewctr")
                      (* 0.5 pi)
                      (setq Y1 (* 0.5 (getvar "viewsize"))))
               pi
               (/ (* Y1 (car (setq X1 (getvar "screensize")))) (cadr X1))))
       ((= (strcase coner) "TR")
        (polar (polar (getvar "viewctr")
                      (* 0.5 pi)
                      (setq Y1 (* 0.5 (getvar "viewsize"))))
               0
               (/ (* Y1 (car (setq X1 (getvar "screensize")))) (cadr X1))))
       ((= (strcase coner) "BL")
        (polar (polar (getvar "viewctr")
                      (* -0.5 pi)
                      (setq Y1 (* 0.5 (getvar "viewsize"))))
               pi
               (/ (* Y1 (car (setq X1 (getvar "screensize")))) (cadr X1))))
       ((= (strcase coner) "BR")
        (polar (polar (getvar "viewctr")
                      (* -0.5 pi)
                      (setq Y1 (* 0.5 (getvar "viewsize"))))
               0
               (/ (* Y1 (car (setq X1 (getvar "screensize")))) (cadr X1))))))

Hề hề hề,

Bạn dùng thử cái này coi đã đúng ý chưa nhé. Kết quả vẫn còn một số râu thừa do lệnh extrim của...

>>

Hề hề hề,

Bạn dùng thử cái này coi đã đúng ý chưa nhé. Kết quả vẫn còn một số râu thừa do lệnh extrim của express. Mình chưa tìm ra cách xử lý. Bạn có thể xóa thủ công nó một tí. Hy vọng rằng nó có ích cho bạn.

(defun c:sht (/ tt lsp lsp0 lse al e0 e1 e2 e3 e4 en lsp1 ss ssl ss1 p pd )
(VL-LOAD-COM)
(command "undo" "be")
(setq tt (car (entsel "\n Chon tim tuyen"))
         lsp (acet-geom-vertex-list tt)
         lsp0 (vl-remove (last lsp) (cdr lsp))
         ;;; e0 (entlast)  
         lse (list tt)  )
(foreach pt lsp0
    	(command "break" tt pt pt)
    	(setq lse (cons (entlast) lse)
              	tt (entlast)  )
)
(setq lse (reverse lse))

(foreach tt lse
(setq al (* 180 (/ (angle (setq pd (vlax-curve-getstartpoint tt)) (vlax-curve-getendpoint tt)) pi))  )
(command "offset" 50 tt (list (+ (car pd) 50) (+ (cadr pd) 50)) "")
(setq e1 (entlast))
(command "offset" 50 tt (list (- (car pd) 50) (- (cadr pd) 50)) "")
(setq e2 (entlast))
(command "pline" (vlax-curve-getstartpoint e1) (vlax-curve-getstartpoint e2) "")
(setq e3 (entlast))
(command "pline" (vlax-curve-getendpoint e1) (vlax-curve-getendpoint e2) "")
(setq e4 (entlast))
(command "pedit" e3 "j" e1 e4 e2 "" "")
(setq en (entlast)
         lsp1 (acet-geom-vertex-list en))
(command "zoom" "e")
(setq ss (ssget "cp" lsp1))
(setq ssl (acet-ss-to-list ss))
(foreach e ssl
     (if (and (member e lse) (not (equal e tt)))
         (setq ssl (vl-remove e ssl))
     )
)
(setq ss (acet-list-to-ss ssl))
(command "copy" ss "" pd (setq p (getpoint pd "\n Chon diem dat")))
(load "extrim.lsp")
(etrim (setq e0 (entlast)) (list (+ (car p) 1000) (+ (cadr p) 1000)))
(command "erase" en  e0 "")
(setq ss1 (ssadd))
(while (setq en1 (entnext en)) (setq ss1 (ssadd en1 ss1) en en1)  )
(command "rotate" ss1 "" p (- al) )
;;;;(command "erase" (entlast) "")
(command "zoom" "p")
)
(command "pedit" (car lse) "j" (acet-list-to-ss (cdr lse)) "" "")

(command "undo" "e")
(princ)
)

Chúc bạn vui.

PS: Sau một hồi mày mò, mình đã khắc phục được các râu thừa đồng thời cũng giải quyết joint lại cái polyline tim tuyến để không làm thay đổi bản vẽ ban đầu của bạn.

Hãy lưu ý vài điểm sau đây khi sử dụng lisp này:

1/- Đường tim tuyến phải là đường Lwpolyline và phải được vẽ trước bạn nhé (Bạn phải dùng lệnh pline của CAD để vẽ đường tim tuyến này). Sở dĩ vậy vì trong lisp có sử dụng lệnh break mà thằng này lại có cái cách làm khác nhau giữa Lwpolyline và Polyline bạn ạ.

Điều này có khác với lisp của bác DoanVanHa vì bác ấy cho bạn pick điểm để tạo polyline.

2/- Khoảng cách offset mặc định là 50 như bạn yêu cầu, Nếu cần khoảng cách khác thì bạn phải thay đổi các giá trị 50 này trong các dòng lệnh offset cho phù hợp. Khi đó bạn cũng cần lưu ý thay đổi cái khoảng cách nhập điểm trong lệnh etrim kẻo nó cắt nhầm đó.(các giá trị 1000. Điều này có khác một chút với bác DoanVanHa vì bác ấy chọn một điểm luôn có thể đảm bảo là nằm ngoài do chắc rằng chả bao giờ bạn lại muốn đặt cái hình kết quả ở trong vùng bản vẽ cũ cả, nó sẽ rất khó nhòm.

3/- Để đảm bảo các đoạn hình cắt ra được nối lại liên tục thì bạn lưu ý khi lisp yêu cầu chọn điểm đặt bạn hãy sử dụng truy bắt điểm là end và zoom lớn đoạn liền trước nó rồi pick vào đầu mút bên phải của đoạn thẳng tim đường.(trừ lần chọn điểm đầu tiên)

 

Mình đã cập nhật các thay đổi vào lisp bên trên, bạn hảy thử dùng và cho biết ý kiến nhé. Nếu cần sửa đổi gì hãy post lên nhé.

Hề hề hề,..

Bác Bình ơi! Tốt rồi. Nếu bác thêm tí mắm muối nữa thì càng tuyệt vời hơn:

- Đưa (load "extrim.lsp") lên đầu kẻo load hoài.

- Hướng vẽ: nếu pline trục đã vẽ từ phải qua trái thì ngược ngược khó coi.

- Điểm đặt bác nên chọn 1 lần thôi, lần sau có thể suy ra được mà!

- Khi đó bật tắt osnap luôn.

Thân thương!

<<

Lệnh XOAY để xoay quanh điểm chèn. Lệnh XOAY1 để xoay quanh tâm. Copy code, đừng download vì fr hay lỗi.

(vl-load-com)
(defun C:XOAY(/ goc)    ; Xoay quanh ®iÓm chÌn
 (command "undo" "be")
 (ssget (list (cons 0 "TEXT,MTEXT")))
 (vlax-for obj (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))
  (if (< 90 (/ (* 180 (setq goc (vla-get-Rotation obj))) pi) 270)
   (vla-put-Rotation obj (+ pi...
>>

Lệnh XOAY để xoay quanh điểm chèn. Lệnh XOAY1 để xoay quanh tâm. Copy code, đừng download vì fr hay lỗi.

(vl-load-com)
(defun C:XOAY(/ goc)    ; Xoay quanh ®iÓm chÌn
 (command "undo" "be")
 (ssget (list (cons 0 "TEXT,MTEXT")))
 (vlax-for obj (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))
  (if (< 90 (/ (* 180 (setq goc (vla-get-Rotation obj))) pi) 270)
   (vla-put-Rotation obj (+ pi goc))))
 (command "undo" "e"))
(defun C:XOAY1(/ ss ent)    ; Xoay quanh t©m *TEXT
 (command "undo" "be")
 (setq ss (ssget (list (cons 0 "TEXT,MTEXT"))) i 0)
 (repeat (sslength ss)
  (if (< 90 (/ (* 180 (vla-get-Rotation  (vlax-ename->vla-object (setq ent (ssname ss i))))) pi) 270)
   (command "rotate" ent "" (TAM_ENT ent) 180))
  (setq i (1+ i)))
 (command "undo" "e"))
;----- Hµm lÊy t©m (vµ 2 gãc ll ur) cña 1 ent bÊt kú.
(defun TAM_ENT (ent / ll ur)
 (vla-getboundingbox (vlax-ename->vla-object ent) 'll 'ur)
 (setq ll (vlax-safearray->list ll) ur (vlax-safearray->list ur) pt (mapcar '* (mapcar '+ ll ur) '(0.5 0.5 0.5))))

9 giờ trước, beeboy đã nói:

Oh, mình xin cám ơn mấy bác đã...

>>

9 giờ trước, beeboy đã nói:

Oh, mình xin cám ơn mấy bác đã chỉ.

 

Giúp mình sửa  lisp dùng để khóa, mở khóa layer (Lock/Unlock Layer/Unlock All Layer)

Nhưng trong quá trình sử dụng mình phát hiện có điểm bất tiện là: mỗi lần nhập lệnh thì lisp chỉ (khóa/mở khóa) được 1 đối tượng/mỗi lần nhập lệnh

Nhờ mọi người giúp mình sửa lisp trở nên tiện lợi hơn: cụ thể là: mỗi lần nhập lệnh sẽ pick được nhiều đối tượng. (chọn đc nhiều đối tượng/mỗi lần nhập lệnh)

Thử cái này xem ^_^

(defun c:lock_m  (/ n ss)
  (prompt "\nTo Lock their Layer(s),")
  (setq ss (ssget)) 
  (repeat (setq n (sslength ss))
    (command "_.layer" "_lock" (cdr (assoc 8 (entget (ssname ss (setq n (1- n)))))) "")
    ) ; repeat
  )

(defun c:unlock_m  (/ n ss)
  (prompt "\nTo Lock their Layer(s),")
  (setq ss (ssget)) 
  (repeat (setq n (sslength ss))
    (command "_.layer" "_unlock" (cdr (assoc 8 (entget (ssname ss (setq n (1- n)))))) "")
    ) ; repeat
  )

 

<<

Lisp đánh số theo thứ tự này Tue_NV viết đúng theo yêu cầu của bạn

gồm 2 trường hợp :

Nếu bạn chọn D : xảy ra trường hợp 1

Trường hợp...

>>

Lisp đánh số theo thứ tự này Tue_NV viết đúng theo yêu cầu của bạn

gồm 2 trường hợp :

Nếu bạn chọn D : xảy ra trường hợp 1

Trường hợp 1. Số đầu tăng 1 đơn vị, chuỗi kí tự cuối cố định

Ví dụ : 1a ; 2a; 3a

Command: dstt

Ban muon danh so tang dan o vi tri dau hay cuoi : D

 

Danh so bat dau :1

 

Danh ki tu ket thuc :a

 

Nếu bạn chọn C : xảy ra trường hợp 2

Trường hợp 2. chuỗi kí tự đầu cố định, Số cuối tăng 1 đơn vị,

Ví dụ : 1.1.1-->1.1.2

Command: dstt

Ban muon danh so tang dan o vi tri dau hay cuoi :C

Danh ki tu bat dau : 1.1.

 

Danh so ket thuc :1

Các trường hợp khác của bạn tự suy luận sẽ ra cách đánh số thứ tự (không có vấn đề gì cả) vì Lisp trên Tue_NV đã viết theo trường hợp tổng quát rồi

Bạn chú ý rằng TextStyle lấy theo style hiện hành đấy nhé :

Code đây :

;; copyright by Tue_NV
(defun c:dstt(/ ans dau cuoi po po1 ent i)
(setvar "cmdecho" 0)
(initget "D C")
(setq ans (getkword "\n Ban muon danh so tang dan o vi tri dau hay cuoi  :"))
(if (= ans "D")
   (progn
(setq dau (getint "\n Danh so bat dau  :") i 1)
(setq cuoi (getstring 5"\n Danh ki tu ket thuc :"))
(setq po (getpoint (strcat "\n Cho diem chen cua so : " (itoa dau) cuoi)))		
(wtxt (strcat (itoa dau) cuoi) po)
     (while po
(setq po1 (getpoint po (strcat "\n Cho diem chen cua so : " (itoa (+ dau i)) cuoi)))
(command "copy" "L" "" po po1) 
(setq ent (entget(entlast)))
(setq ent (subst (cons 1 (strcat (itoa (+ dau i)) cuoi)) (assoc 1 ent) ent))
(entmod ent)
(setq i (1+ i))
(setq po po1)
     );while
   )
)

(if (= ans "C")
   (progn
(setq dau (getstring 5"\n Danh ki tu bat dau :"))
(setq cuoi (getint "\n Danh so ket thuc  :") i 1)	
(setq po (getpoint (strcat "\n Cho diem chen cua so : " dau (itoa cuoi))))		
(wtxt (strcat dau (itoa cuoi)) po)
     (while po
(setq po1 (getpoint po (strcat "\n Cho diem chen cua so : " dau (itoa (+ cuoi i)) )))
(command "copy" "L" "" po po1) 
(setq ent (entget(entlast)))
(setq ent (subst (cons 1 (strcat dau (itoa (+ cuoi i)) )) (assoc 1 ent) ent))
(entmod ent)
(setq i (1+ i))
(setq po po1)
     );while
   )
)
(princ)
)
;
(defun wtxt (txt p / sty d h)
(setq sty (getvar "textstyle")
d (tblsearch "style" sty)
h (cdr (assoc 40 d)))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 11 p) 
(cons 72 1) (cons 73 2)
(if (> h 0) (cons 40 h) (assoc 40 d)) (assoc 41 d))
)
)

Trường hợp bạn sử dụng chức năng download Lisp file của DD mà không được thì hãy nhấn nút Reply bài viết này của Tue_NV -> chép hết code về sử dụng nhé.

Mình đã test thử và kết quả ----> có vài điều này mình muốn góp ý để hoàn Tue_NV hoàn thiện hơn.

-Sau khi thực hiện lệnh nó không thay số cũ (vốn có) mà nó đè luôn lên, mình lại phải mất công xóa cái cũ đi.

-Để thực hiện được mình lại phải copy một cái vòng tròn có sẵn một số bất kỳ trước, sau đó mới thực hiện được lệnh!

-Tue_NV có thể viết thêm cái vòng tròn vào để cho tiện hơn được không?

Vậy Tue_NV có thể phát triển để cho nó dễ sử dụng hơn không?

Hi vọng, Tue_NV sẽ phát triển cái lisp này để nó được hoàn thiện một cách Tuyệt vời hơn!

Cảm ơn Tue_Vn nhiều nhiều!

<<

 

Thử xem!

(defun duy:taobk_mtdcv ()
  (entmake '((0 . "BLOCK") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 ....
>>

 

Thử xem!

(defun duy:taobk_mtdcv ()
  (entmake '((0 . "BLOCK") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbBlockReference") (2 . "duy_tv_muitenduongcv") (10 0.0 0.0 0.0) (70 . 0)))
  (entmake '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbPolyline") (90 . 4) (70 . 1) (43 . 0.0) (38 . 0.0) (39 . 0.0) (10 0.0 0.0) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 0.0 0.079048750845185) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 1.0 0.079048750845185) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 1.0 0.0) (40 . 0.0) (41 . 0.0) (42 . 0.0)))
  (entmake '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbPolyline") (90 . 4) (70 . 1) (43 . 0.0) (38 . 0.0) (39 . 0.0) (10 0.0 0.144923408667705) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 0.0 0.223972159512890) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 1.0 0.223972159512890) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 1.0 0.144923408667705) (40 . 0.0) (41 . 0.0) (42 . 0.0)))
  (entmake '((0 . "HATCH") (100 . "AcDbEntity") (8 . "0") (100 . "AcDbHatch") (10 0.0 0.0 0.0) (210 0.0 0.0 1.0) (2 . "SOLID") (70 . 1) (71 . 0) (91 . 1) (92 . 1) (93 . 7) (72 . 1) (10 1.0 0.474294301946547 0.0) (11 1.0 0.312761773046283 0.0) (72 . 1) (10 1.0 0.312761773046283 0.0) (11 0.0 0.312761773046283 0.0) (72 . 1) (10 0.0 0.312761773046283 0.0) (11 0.0 0.474294301946547 0.0) (72 . 1) (10 0.0 0.474294301946547 0.0) (11 -0.309210583527104 0.474294301946547 0.0) (72 . 1) (10 -0.309210583527104 0.474294301946547 0.0) (11 0.500000000000000 0.907304787768128 0.0) (72 . 1) (10 0.500000000000000 0.907304787768126 0.0) (11 1.309210583527104 0.474294301946545 0.0) (72 . 1) (10 1.309210583527104 0.474294301946547 0.0) (11 1.0 0.474294301946547 0.0) (97 . 0) (75 . 0) (76 . 1) (98 . 1) (10 21.99031319514620 -88.48062166520982 0.0) (450 . 0) (451 . 0) (460 . 0.0) (461 . 0.0) (452 . 1) (462 . 1.0) (453 . 2) (463 . 0.0) (63 . 5) (421 . 255) (463 . 1.0) (63 . 7) (421 . 16777215) (470 . "LINEAR")))
  (entmake '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbPolyline") (90 . 8) (70 . 1) (43 . 0.0) (38 . 0.0) (39 . 0.0) (10 1.0 0.474294301946547) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 1.0 0.312761773046283) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 0.0 0.312761773046283) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 0.0 0.474294301946547) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 -0.309210583527104 0.474294301946547) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 0.500000000000000 0.907304787768126) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 0.500000000000000 0.907304787768126) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 1.309210583527104 0.474294301946547) (40 . 0.0) (41 . 0.0) (42 . 0.0)))
  (entmake '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0")))
  (princ)
) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:xd_diem<traiphai (diemchuan diemchuanm diemxd / diemchuan diemchuanm diemxd)
(cond
((> (* (- (car diemchuanm) (car diemchuan)) (- (cadr diemxd) (cadr diemchuan))) (* (- (cadr diemchuanm) (cadr diemchuan)) (- (car diemxd) (car diemchuan))) ) (setq kqtp "trai") )
((< (* (- (car diemchuanm) (car diemchuan)) (- (cadr diemxd) (cadr diemchuan))) (* (- (cadr diemchuanm) (cadr diemchuan)) (- (car diemxd) (car diemchuan))) ) (setq kqtp "phai") )
((= (* (- (car diemchuanm) (car diemchuan)) (- (cadr diemxd) (cadr diemchuan))) (* (- (cadr diemchuanm) (cadr diemchuan)) (- (car diemxd) (car diemchuan))) ) (setq kqtp "trung") )
)
kqtp)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:mtd ()
(command "undo" "be") 
(cond
((= nill (tblsearch "block" "duy_tv_muitenduongcv")) (duy:taobk_mtdcv) )
((/= nill (tblsearch "block" "duy_tv_muitenduongcv")) )
)

 (while  (setq diemchenmtdm (getpoint "\nDiem thu nhat. Hoac ENTER de ket thuc !"))
(setq diemchenmtdh (getpoint diemchenmtdm "\nDiem thu hai"))
 (command ".insert" "duy_tv_muitenduongcv" "_non" diemchenmtdm  (distance diemchenmtdm diemchenmtdh)  (distance diemchenmtdm diemchenmtdh) diemchenmtdh)

(setq diemchuanh (getpoint diemchenmtdm "\nHuong mui ten"))
(setq huongmtd (duy:xd_diem<traiphai diemchuanh diemchenmtdm  diemchenmtdh))
(cond
((= huongmtd "trai")   )
((= huongmtd "phai")   (command ".mirror" (entlast) "" "_non" diemchenmtdm "_non" diemchenmtdh "y"))
((= huongmtd "trung")   (command ".mirror" (entlast) "" "_non"diemchenmtdm "_non" diemchenmtdh "") (princ "\nDiem dinh huong trung voi duong thang nen ve hai huong luon nhe !") )
)

)
(command "undo" "end")
(princ)
)

cảm ơn bác đã giúp, Bác có thể giúp em sửa lại cho lisp làm việc theo cơ chế scale với tham số R, Nghĩa là khi chọn đểm đầu tiên đặt 1 cạnh của mũi tên, chọn điểm thứ 2 đặt cạnh thứ 2 của mũi tên, sau đó khi di chuyển chuột hình mũi tên sẽ scale theo ( giống khi ta sử dụng lệnh scale với tham số R, em diễn đạt hơi tối nghĩa mong bác thông cảm) 

<<

Download lisp

Filename: 407639_mtd.lsp

 

(defun c:jp (/ ope ss)
  (setq ope (getvar "PEDITACCEPT"))
  (if (setq ss (ssget '((0 . "ARC,*POLYLINE,LINE"))))
   ...
>>

 

(defun c:jp (/ ope ss)
  (setq ope (getvar "PEDITACCEPT"))
  (if (setq ss (ssget '((0 . "ARC,*POLYLINE,LINE"))))
    (progn
      (setvar "PEDITACCEPT" 1)
      (command "_.pedit" "_M" ss "" "_J" "" "")))
  (setvar "PEDITACCEPT" ope)
  (princ)
  )

Lisp này dùng như thế nào bạn/anh/chi ơi :D? Mình dùng lệnh jp rồi chọn đối tượng, nhưng sau đó enter cái là mất luôn. Bạn/anh/chi có thể hướng dẫn cái líp này đc không?

<<

Hề hề hề,

Chưa hiễu yêu cầu của bạn,

Nếu bạn muốn dùng lisp thì khổ lắm lisp chửa có hỗ trợ viết text tiếng Việt

Còn bạn muốn vẽ chữ...

>>

Hề hề hề,

Chưa hiễu yêu cầu của bạn,

Nếu bạn muốn dùng lisp thì khổ lắm lisp chửa có hỗ trợ viết text tiếng Việt

Còn bạn muốn vẽ chữ trên bản vẽ thì bạn đã làm khá tốt đó thôi.

 

Trong các mã DXF của text, Có mã DXF 7 là để xác định cái Style của text . Bạn có thể tạo trước các style theo tiếng việt của bạn rồi khi tạo text bạn thêm thằng (cons 7 "Cái style bạn khoái") vào. Khi đó lưu ý rằng bạn phải nhập nội dung text theo đúng cái kiểu gõ mà bạn dùng trong style của bạn nó mới cho được hiển thị tiếng Việt bạn nhé. Dưng mà trong code thì cái text ấy nó chả giống ai bạn cũng hổng được phàn nàn đâu đấy. Hề hề hề.

 

Chúc bạn chóng giỏi hỉ....

 

Với trường hợp viết text unicode. Em có lisp sau làm theo ý anh phamthanhbinh.

(defun C:txt ()
(setq cont_uni "Chào Cad Vi?t. Tôi là h?c hoài v?n d?t")
(command "-style" "TEXT_UNICODE" "Arial" "" "" "" "" "")
(entmake (list (cons 0 "TEXT") (cons 1 cont_uni) (cons 10 (list 0 0 0)) (cons 40 2) (cons 7 "TEXT_UNICODE")))
)

Chào Cad Vi?t. Tôi là h?c hoài v?n d?t trong đoạn code làm theo ý anh em đánh bằng Vietkey bảng mã Unicode.

Kết quả không như ý

 

Nếu viết như sau thì cho kết quả đúng :

(defun C:txt1 ()
(setq cont_uni "Chào Cad Vi\\U+1EC7t. Tôi là h\\U+1ECDc hoài v\\U+1EABn d\\U+1ED1t.")
(command "-style" "TEXT_UNICODE" "Arial" "" "" "" "" "")
(entmake (list (cons 0 "TEXT") (cons 1 cont_uni) (cons 10 (list 0 5 0)) (cons 40 2) (cons 7 "TEXT_UNICODE")))
)

Vấn đề là Chào Cad Vi\\U+1EC7t. Tôi là h\\U+1ECDc hoài v\\U+1EABn d\\U+1ED1t có quy luật như thế nào. Làm thế nào để biết phải ghi các ký tự Vi\\U+1EC7t

h\\U+1ECDc v\\U+1EABn d\\U+1ED1t

 

Có thể em chưa hiểu hết ý anh phamthanhbinh. Mong được anh giải thích chỗ này. Cảm ơn lời chúc của anh. Hi!

<<

Bổ sung phần Highlight đối tuợng đuợc chọn và dùng getdist để nhập kh/cách.

Thanks to duy782006.

 

(defun c:mmo(/ ang dis pt ss)
 (defun *error*...
>>

Bổ sung phần Highlight đối tuợng đuợc chọn và dùng getdist để nhập kh/cách.

Thanks to duy782006.

 

(defun c:mmo(/ ang dis pt ss)
 (defun *error* (msg)
   (if ss (ssredraw ss 4))
   (if (not(wcmatch (strcase msg) "*BREAK,*EXIT*,*CANCEL*"))
     (princ (strcat "\n** Error: " msg " **")))
   (princ))
 (defun ssredraw (ss mode / i ename)
   (setq i -1)
   (while (setq ename (ssname ss (setq i (1+ i))))
     (redraw (ssname ss i) mode)
   )
 )

 (or *dis* (setq *dis* 200))
 (or *ang* (setq *ang* 0))

 (princ "\nChon doi tuong muon di chuyen :")
 (while (setq ss (ssget))
   (ssredraw ss 3)
   (setq ang (getangle (strcat "\nNhap goc muon di chuyen <" (angtos *ang*) ">: ")))
   (if ang (setq *ang* ang))

   (initget 2)
   (setq dis (getdist (strcat "\nNhap khoang cach <" (rtos *dis*) ">: ")))
   (if dis (setq *dis* dis))

   (ssredraw ss 4)
   (command "move" ss "" (setq pt (getvar "lastpoint")) (polar pt *ang* *dis*))
   (princ "\nChon doi tuong muon di chuyen :")
   )
 (princ)
 )

Nhờ anh giúp em bổ sung phần copy tâng theo số lượng đối tượng khi được chọn, líp hỏi góc, khoảng cách theo X, số lượng cần tạo theo phương X: khoảng cách theo Y, số lượng cần tạo theo phương Y: ( GIỐNG NHƯ ARAY )

MONG ĐƯỢC ANH GIÚP

<<