Jump to content
InfoFile
Tác giả: Phiphi-
Bài viết gốc: 64723
Tên lệnh: st1
Viết Lisp theo yêu cầu
Bạn xài cái này thử xem.

(defun tdchen(ent / k eget dchen)
  (setq k (cdr (assoc 72 (setq eget (entget ent))))									 
 dchen (if (zerop k)             
	(cdr (assoc 10 eget))
      ...
>>
Bạn xài cái này thử xem.

(defun tdchen(ent / k eget dchen)
  (setq k (cdr (assoc 72 (setq eget (entget ent))))									 
 dchen (if (zerop k)             
	(cdr (assoc 10 eget))
               (cdr (assoc 11 eget)))
  )	
  dchen			  
)

(defun c:st1 ( / oldos lst1 ss ki ki1 lst ddau dcuoi eget)
 (setq oldos (getvar "osmode"))
 (setvar "osmode" 0)
 (setq lst1 '(("L" acAlignmentLeft)
      ("C" acAlignmentCenter)
      ("R" acAlignmentRight)
      ("M" acAlignmentMiddle )
      ("TL" acAlignmentTopLeft)
      ("TC" acAlignmentTopCenter)
      ("TR" acAlignmentTopRight)
      ("ML" acAlignmentMiddleLeft )
      ("MC" acAlignmentMiddleCenter)
      ("MR" acAlignmentMiddleRight)
      ("BL" acAlignmentBottomLeft)
      ("BC" acAlignmentBottomCenter )
      ("BR" acAlignmentBottomRight )))

 (prompt "Chon Text:")
 (setq ss  (ssget '((0 . "TEXT"))))

 (initget 1 "C L M R TL TC TR ML MC MR BL BC BR")
 (setq ki  (getkword "Enter an option :")
ki1 (eval (cadr (assoc ki lst1)))        
lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
lst (vl-sort lst '(lambda (e1 e2) (> (caddr (assoc 10 (entget e1))) 
                                     (caddr (assoc 10 (entget e2))))))										 
ddau (car (tdchen (car lst)))								 
 )

 (command "undo" "begin")
 (foreach e lst   
(setq eget (entget e)
      dcuoi (cons ddau (cdr (tdchen e))) 
      eget (subst (cons 72 ki1) (assoc 72 eget) eget)
      eget (if (zerop ki1)
	         (subst (cons 10 dcuoi) (assoc 10 eget) eget)
		 (subst (cons 11 dcuoi) (assoc 11 eget) eget))
)	
   (entmod eget)  
 )
 (command "undo" "end")
 (setvar "osmode" oldos)
 (Princ)
)

Nhờ Bác q288 kết hợp Lisp dưới đây với Lisp trên. Tkx.

(defun c:stext (/ sst lstent egoc pgoc xgoc yht zgoc linespc ee tt)
(if (not tyledong)
(setq tyledong 1.5)
)
(princ "\nSap xep text © CADViet.com")
(setq sst (ssget '((0 . "TEXT")))
lstent (ss2ent sst)
tmp (getreal (strcat "\nVao ty le dong khoang cach dong <"
(rtos tyledong 2 2)
">: "
)
)
tyledong (cond
(tmp tmp)
(t tyledong)
)
lstent (vl-sort lstent
'(lambda (e1 e2)
(> (cadr (cdr (assoc 10 (entget e1))))
(cadr (cdr (assoc 10 (entget e2))))
)
)
)
egoc (car lstent)
lstent (cdr lstent)
pgoc (cdr (assoc 10 (entget egoc)))
xgoc (car pgoc)
yht (cadr pgoc)
zgoc (caddr pgoc)
hgoc (cdr (assoc 40 (entget egoc)))
linespc (* hgoc (+ 1.0 tyledong))

)
(foreach ee lstent
(setq tt (entget ee)
tt (subst (list 10
xgoc
(setq yht (- yht linespc))
zgoc
)
(assoc 10 tt)
tt
)
)
(entmod tt)
(entupd ee)
)
(princ)
)
(defun ss2ent (ss / sodt index lstent)
(setq
sodt (cond
(ss (sslength ss))
(t 0)
)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent) 
)
(princ
"\nSTEXT - Sap xep text - free lisp from www.cadviet.com"
)
(vl-load-com)


<<

Filename: 64723_st1.lsp
Tác giả: nhatphong
Bài viết gốc: 183816
Tên lệnh: o2
nhờ làm lisp vẽ tường....

THử cái này xem (mình chưa thử với xline nhưng arc, circle, plinespline thì đc)

(Defun c:o2 ()
(vl-load-com)
(command...
>>

THử cái này xem (mình chưa thử với xline nhưng arc, circle, plinespline thì đc)

(Defun c:o2 ()
(vl-load-com)
(command "undo" "be")

(if (= droff nil)
(setq droff1 2.00)
(setq droff1 droff)
)
(setq
droff (GETREAL (strcat "\nNhap do rong offset: <" (rtos droff1 2 2) ">"))
)
(if (= droff nil)
(setq droff droff1)
)



(setq SS (ssget (list (cons 0 "ellipse,lwpolyline,spline,line,circle"))))
(setq i 0)
(setq N (sslength ss))
(while (< i N)
(setq TEXTENT (ssname SS i))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)

(setq diemchuan (vlax-curve-getPointAtDist TEXTENT 0))
(setq diemdinhhuong (vlax-curve-getPointAtDist TEXTENT 0.01))
(setq goc (angle diemchuan diemdinhhuong))
(setq diembentrai (polar diemchuan (- goc (/ pi 2)) droff))
(setq diembenphai (polar diemchuan (+ goc (/ pi 2)) droff))

(command ".offset" droff textent diembentrai textent diembenphai "")

(setq i (1+ i))
(setvar "osmode" luubatdiem)
)

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

sửa cái code

(setq SS (ssget (list (cons 0 "ellipse,lwpolyline,spline,line,circle"))))

thêm cái xline là được

 

(setq SS (ssget (list (cons 0 "ellipse,lwpolyline,spline,line,xline,circle"))))

 

 

thank bạn nhé :D


<<

Filename: 183816_o2.lsp
Tác giả: hoangnam2017
Bài viết gốc: 418548
Tên lệnh: ha
Vẽ Một Hình Tứ Giác Khi Đã Biết Chiều Dài 4 Cạnh Và Diện Tích.

 

Đây là 2 hình thỏa mãn yêu cầu ngộ của bạn:

Cad:

 

Đây là 2 hình thỏa mãn yêu cầu ngộ của bạn:

Cad:

http://www.cadviet.com/upfiles/7/67029_dung_hinh_1.dwg

Lisp:

(defun C:HA(/ a1 a2 a3 a4 a5 step p1 p2 s1 s2 lst)
 (setq a1 4.050 a2 11.260 a3 4.00 a4 11.150 step 1E-6 a5 (+ (- a2 a1) step))
 (while (< (- a2 a1) a5 (+ a3 a4))
  (setq p1 (/ (+ a1 a2 a5) 2))
  (setq p2 (/ (+ a3 a4 a5) 2))
  (setq s1 (sqrt (* p1 (- p1 a1) (- p1 a2) (- p1 a5))))
  (setq s2 (sqrt (* p2 (- p2 a3) (- p2 a4) (- p2 a5))))
  (if (equal (+ s1 s2) 45.01 step) (setq lst (cons a5 lst)))
  (setq a5 (+ a5 step)))
 lst) 
; L=(12.1367 11.6696)
; S=(45.00994873 45.01000977)

Vâng. Em cảm ơn bác nhé. Chuẩn rồi bác. Chúc bác sức khỏe !


<<

Filename: 418548_ha.lsp
Tác giả: hugo75
Bài viết gốc: 241394
Tên lệnh: cpk
Lisp move đối tượng theo giá trị cố định?

 

Ý bạn chủ topic chắc như thế này :

 

(defun c:cpk(/ p pdich ss kcach )
(defun Tue-ss-drag-move (ss p / el...
>>

 

Ý bạn chủ topic chắc như thế này :

 

(defun c:cpk(/ p pdich ss kcach )
(defun Tue-ss-drag-move (ss p / el lp)
;;;copyright by Tue_NV
(setq el (entlast))
(if (and ss p (vl-cmdf "copy" ss "" "non"  p pause) (null (equal (getvar "lastpoint") p)))
   (setq lp (getvar "lastpoint")) (setq lp nil)
)
            (while (setq el (entnext el)) (entdel el))
lp)
 
  (or *kc* (setq *kc* 100.0))
  (setq ss (ssget))
 
  (setq p (getpoint "\n  Enter nhap khoang cach moi \\ Diem goc : "))
  (if (= p nil) (progn
    (setq kcach (getreal (strcat "\n Nhap khoang cach <" (rtos *kc* 2 2) ">:" )))
    (if kcach (setq *kc* kcach) (setq kcach *kc*))
    (setq p (getpoint "\n Diem goc : "))
  ))
(if (setq pdich (Tue-ss-drag-move ss p   )                   )
    (command "move" ss "" "non" p "non" (polar p (angle p pdich) kcach))
)
  (princ)
  )
(defun c:cpk(/ p pdich )
(defun Tue-ss-drag-move (ss p / el lp)
;;;copyright by Tue_NV
(setq el (entlast))
(if (and ss p (vl-cmdf "copy" ss "" "non"  p pause) (null (equal (getvar "lastpoint") p)))
   (setq lp (getvar "lastpoint")) (setq lp nil)
)
(while (setq el (entnext el)) (entdel el))
lp)
 
  (or *kc* (setq *kc* 100.0))
  (setq ss (ssget))
  
  (setq p (getpoint "\n  Enter nhap khoang cach moi \\ Diem goc : "))
  (if (= p nil) (progn
    (setq kcach (getreal (strcat "\n Nhap khoang cach <" (rtos *kc* 2 2) ">:" )))
    (if kcach (setq *kc* kcach) (setq kcach *kc*))
    (setq p (getpoint "\n Diem goc : ")) 
  ))
(if (setq pdich (Tue-ss-drag-move ss p   ) )
    (command "move" ss "" "non" p "non" (polar p (angle p pdich) kcach)) 
)
;;;  (princ)
  )

không phải vậy bác ah.khoảng cần move là 50 định sẵn.

Đánh lệnh.

Chọn đối tượng.

Pick chọn hướng (Hướng là có thể qua trái, phải,lên,xuống.Nếu đối tượng nằm xiên thì cũng có hướng là qua trái,phải,lên,xuống nhưng theo hướng xiên của đối tượng.)

Mong bác sửa giúp.


<<

Filename: 241394_cpk.lsp
Tác giả: thanhdatkts
Bài viết gốc: 155670
Tên lệnh: tb
viết lisp tính chiều dài trung bình của nhiều đoạn thẳng

Kiểu đại loại thế này :

(defun add_mline ()
 (foreach e_record_sub	e_record
   (cond ((= 10 (car e_record_sub))
   (setq pt1	  ...
>>

Kiểu đại loại thế này :

(defun add_mline ()
 (foreach e_record_sub	e_record
   (cond ((= 10 (car e_record_sub))
   (setq pt1	   (cdr e_record_sub)
	 mline_len 0.0
   )
  )
  ((= 11 (car e_record_sub))
   (setq pt2	   (cdr e_record_sub)
	 mline_len (+ mline_len (distance pt2 pt1))
	 pt1	   pt2
   )
  )
   )
 )
 (setq tot_len (+ tot_len mline_len))
 (ssdel e_name ss)
)

(defun C:tb (/ tot_len ss e_name e_record e_type)
(grtext -1 "Free from cadviet.com @ketxu")
(setq k (getvar "dimlfac"))
 (setq tot_len 0.0)
 (setq ss (ssget))
 (setq len (sslength ss))
 (if (null ss)
   (exit)
 )
 (while (> (sslength ss) 0)
   (setq e_name (ssname ss 0))
   (setq e_record (entget e_name))
   (setq e_type (cdr (assoc '0 e_record)))
   (cond ((wcmatch e_type "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")
   (command "lengthen" e_name "")
   (setq tot_len (+ tot_len (getvar "PERIMETER")))
   (ssdel e_name ss)
  )
  ((wcmatch e_type "MLINE") (add_mline))
  (e_type (ssdel e_name ss))
   )
 )
(setq tot_len (* k tot_len))
(setq tbinh (/ tot_len len 1000))
 (alert (strcat "Chieu dai trung binh cac doan vua chon là : "(rtos tbinh 2 2)))
) 

 

bạn ơi muốn thêm đuôi

mà sao mình load list vào đánh lệnh tb thì nó toàn lên cái bảng Insert Table là sao :unsure:


<<

Filename: 155670_tb.lsp
Tác giả: qh2qa06
Bài viết gốc: 309069
Tên lệnh: ddo
Lisp tính cao độ khi biết cao độ và độ dốc

 

Bạn thử cái này.

Nhấp điểm biết cao độ, chọn text cao độ của điểm đó, nhập độ dốc dạng 0.00... (+ lên - xuống), sau...

>>

 

Bạn thử cái này.

Nhấp điểm biết cao độ, chọn text cao độ của điểm đó, nhập độ dốc dạng 0.00... (+ lên - xuống), sau đó nhấp điểm muốn biết độ cao.

 

(defun c:ddo( / a b txt tt1 sole dd1 vt)
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (setq a (getpoint "\nChon diem da biet cao do: ")
txt (car (entsel "\nText cao do tuong ung: "))
tt1 (dxf 1 txt)
sole (if (setq vt (vl-string-search "." tt1)) (- (strlen (substr tt1 vt)) 2) 0)
dd1 (getreal (strcat "\nNhap do doc (+ len; - xuong) <" (rtos (if (not dd) (setq dd 0.01) dd)) ">: ")))
  (if dd1 (setq dd dd1))
  (while (setq b (getpoint a "\nChon diem can tinh cao do: "))
    (entmake (list '(0 . "TEXT") (cons 10 b) (cons 11 b) (cons 40 (dxf 40 txt)) (cons 41 (dxf 41 txt))
  (cons 8 (dxf 8 txt)) (cons 62 (if (dxf 62 txt) (dxf 62 txt) 256))
  (cons 7 (dxf 7 txt)) (cons 72 (dxf 72 txt)) (cons 73 (dxf 73 txt)) '(50 . 0) 
  (cons 1 (rtos (+ (atof (dxf 1 txt)) (* dd (distance a b))) 2 sole))))
  )
  (princ)
)

Mong như mong mẹ về chợ :D

Em cảm ơn anh! 


<<

Filename: 309069_ddo.lsp
Tác giả: Truong_AAn
Bài viết gốc: 219196
Tên lệnh: cline
lisp vẽ center line

Của bạn đây :

(defun c:cline(/ Tue-geom-divpt p1d p1s p2d p2s e1 e2 )
 ;;;write by Tue_NV
 (defun Tue-geom-divpt (p1 p2 k)
   (polar...
>>

Của bạn đây :

(defun c:cline(/ Tue-geom-divpt p1d p1s p2d p2s e1 e2 )
 ;;;write by Tue_NV
 (defun Tue-geom-divpt (p1 p2 k)
   (polar p1 (angle p1 p2) (* (distance p1 p2) k))
 )
 (setq kdh 5);;nhap khoang keo dai o day
 (setq e1 (car (entsel "\n Pick doituong 1 :") ) e2 (car (entsel "\n Pick doituong 2 :") )
   p1d (vlax-curve-getstartpoint e1) p2d (vlax-curve-getClosestPointTo e2 p1d)
   p1s (vlax-curve-getendpoint e1) p2s (vlax-curve-getClosestPointTo e2 p1s)
   ptd (polar (Tue-geom-divpt p1d p2d 0.5) (angle p1s p1d) kdh) pts (polar (Tue-geom-divpt p1s p2s 0.5) (angle p1d p1s) kdh) )
(entmake (list (cons 0 "LINE") (cons 8  (getvar "clayer")) (cons 10 ptd) (cons 11 pts)))
)

Lisp đổi đường tim theo layer hiện hành, có nghĩa là bạn set về layer hiện hành rồi chạy Lisp

 

 

1- Cảm ơn anh Tuệ đã quan tâm và giúp em.

2- Lisp báo lỗi không sử dụng được

106444_capture_49.jpg

3- Em xin lỗi vì đã diễn đạt không rõ ràng nên anh chưa hiểu yêu cầu lisp. em xin phép đính chính lại là thế này. Em có 2 đường thẳng A, B em muốn dựng một đường C ( C chưa có), bây giờ em chọn A, Chọn B thì cad sẽ vẽ C. linetype của C là layer hiện hành

flie cad:

http://www.cadviet.c...106444_ce_2.dwg


<<

Filename: 219196_cline.lsp
Tác giả: quangthanhdu
Bài viết gốc: 220404
Tên lệnh: ghb
Lisp sắp xếp các Text được chọn trong một vùng ra một bảng giá trị?

Hề hề hề,

Bạn dùng thử cái này coi sao nhé.

(defun c:ghb (/ p1 p0 ssl h i)
(vl-load-com)
(command...
>>

Hề hề hề,

Bạn dùng thử cái này coi sao nhé.

(defun c:ghb (/ p1 p0 ssl h i)
(vl-load-com)
(command "undo" "be")
(setq p1 (getpoint "\n Chon diem dat bang"))
(command "text" "j" "mc" (list (+ (car p1) 18) (+ (cadr p1) 4)) 2 0 "BANG GIA TRI")
(while (setq ssl (acet-ss-to-list (ssget (list (cons 0 "text")))))
  	(setq ssl (vl-sort ssl '(lambda (x y) ( > (caddr (assoc 11 (entget x))) (caddr (assoc 11 (entget y))))))
               h (cdr(assoc 40 (entget (car ssl)))) i 1 p0 p1 )
  	(foreach dt ssl
               (command "text" "j" "mc" (list (+ (car p0) (* 3 h)) (- (cadr p0) h)) h 0 (cdr (assoc 1 (entget dt))))
               (command "rectangle" p0 (list (+ (car p0) (* 6 h)) (- (cadr p0) (* 2 h))))
               (setq p0 (list (+ (car p0) (* 6 h)) (cadr p0)))
  	)
  	(setq p1 (list (car p1) (- (cadr p1) (* 2 h))))
)
(command "undo" "e")
(princ)
)

Lưu ý mình lấy text trong bảng có chiều cao của text bạn chọn.và các kích thước của bảng phụ thuộc vào chiều cao này. Nếu bạn muốn hãy tự thay đổi các kích thước này nhé.

Đúng theo ý em rồi! Chân thành cảm ơn Anh, chúc Anh sức khỏe!!! :mellow:


<<

Filename: 220404_ghb.lsp
Tác giả: tientracdia
Bài viết gốc: 217410
Tên lệnh: xtxt
Lisp xuất text theo thứ tự chọn ra excel

Hề hề hề,

Phiền bạn test thử cái lisp này coi đã ưng ý chưa nhé.


(defun c:xtxt...
>>

Hề hề hề,

Phiền bạn test thử cái lisp này coi đã ưng ý chưa nhé.


(defun c:xtxt ()
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq tmp (getfiled "Chon file xuat Text goc" (getvar "dwgprefix") "csv;txt" 1))
(setq fw (open tmp "w"))
(setq p1 (getpoint "\n Chon diem dat bang"))
(setq h (getreal "\n Nhap chieu cao chu: "))
(alert "\n Chon lan luot cac text can xuat trong mot nhom ")
(setq sst (ssget (list (cons 0 "*text"))))
(while sst
(setq sstl (acet-ss-to-list sst)
  			p2 (polar p1 0 (* 8 h))
  			p3 (polar p2 0 (* 8 h))
  			p4 (polar p3 0 (* 8 h))
  			p5 (polar p4 0 (* 8 h))
  			p6 (polar p5 0 (* 8 h))
  			p7 (polar p6 0 (* 8 h))
  			p8 (polar p7 0 (* 8 h))
  			p9 (polar p8 0 (* 8 h))
  			p11 (polar p1 (- (/ pi 2)) (* 4 h))
  			p12 (polar p2 (- (/ pi 2)) (* 4 h))
  			p13 (polar p3 (- (/ pi 2)) (* 4 h))
  			p14 (polar p4 (- (/ pi 2)) (* 4 h))
  			p15 (polar p5 (- (/ pi 2)) (* 4 h))
  			p16 (polar p6 (- (/ pi 2)) (* 4 h))
  			p17 (polar p7 (- (/ pi 2)) (* 4 h))
  			p18 (polar p8 (- (/ pi 2)) (* 4 h))
  			p19 (polar p9 (- (/ pi 2)) (* 4 h))
  			p21 (list (+ (car p1) (* 4 h)) (- (cadr p1) (* 2 h)))
  			k 0
  			txl ""
)
(command "pline" p1 p9 p19 p11 "c")
(command "pline" p2 p12 "" )
(command "pline" p3 p13 "" )
(command "pline" p4 p14 "" )
(command "pline" p5 p15 "" )
(command "pline" p6 p16 "" )
(command "pline" p7 p17 "" )
(command "pline" p8 p18 "" )
(foreach txt sstl
           (setq t1 (cdr (assoc 1 (entget txt)))                      
                     txl (strcat txl t1 ",")  )
           (command "text" "j" "mc" (list (+ (car p21) (* k 8 h)) (cadr p21)) h 0 t1)
           (setq  k (1+ k ) )
)
(write-line txl fw)
(alert "\n Tiep tuc chon lan luot cac text can xuat cho nhom ke tiep")
(setq sst (ssget (list (cons 0 "*text"))))
(setq p1 p11)
)
(close fw)
(setvar "osmode" oldos)
(princ)
)

Chúc bạn vui.

Cám ơn Bạn.

Lisp của bạn khi xuất ra Excel rất chuẩn, mình xin nhờ bạn giúp cho việc : vì số lượng text cần xuất ra excel rất lớn, khi tạm ngưng muốn xuất tiếp tục và ghi nối và file cũ đã xuất trước đó, cho đỡ ghép các file lại với nhau.

Không cần việc xuất ra bảng cad mà chỉ ra và ghi vào file excel thôi

Cám ơn


<<

Filename: 217410_xtxt.lsp
Tác giả: trungkien_hatangdothi
Bài viết gốc: 194810
Tên lệnh: xoay
(Yêu cầu) Xin lisp làm 1 đường thẳng song song với 1 đường thẳng đã chọn

Quick code cho bạn :

(defun c:xoay(/ ST:Geom-Entity-Box-Fast mau Selset tmp)
(vl-load-com)
(defun ST:Geom-Entity-Box-Fast (vla-obj /   ll...
>>

Quick code cho bạn :

(defun c:xoay(/ ST:Geom-Entity-Box-Fast mau Selset tmp)
(vl-load-com)
(defun ST:Geom-Entity-Box-Fast (vla-obj /   ll lr ur ul rt)  
(vla-getboundingbox vla-obj 'll 'ur)
(cons (mapcar '(lambda (x y) (* (+ x y) 0.5)) (setq ll (vlax-safearray->list ll))(setq ur (vlax-safearray->list ur))) (angle ll ur))
)
(if (and 	(princ "\nChon doi tuong mau :")
           (setq mau (ST:Geom-Entity-Box-Fast (vlax-ename->vla-object (ssname (ssget ":S" (list (cons 0 "*LINE,LEADER"))) 0))))
           (princ "\nChon cac doi tuong can quay :")
           (ssget (list (cons 0 "*LINE,LEADER")))
           (setq SelSet (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object))))
   )
   (vlax-for object Selset
       (vla-rotate object (vlax-3d-point (car (setq tmp (ST:Geom-Entity-Box-Fast object)))) (- (cdr mau)(cdr  tmp)))
   )
   (vla-delete Selset)
)
)

 

Nếu muốn dùng cho tất cả các đối tượng (k riêng gì Pline, Line, Leader thì bạn xóa tất cả dòng này trong lisp đi

(list (cons 0 "*LINE,LEADER"))

 

- Thank bác kẹt xu nhé (ko hiểu sao ko like this được), đúng cái lisp e cần, đơn giản gọn nhẹ mà rất nhanh, bác có thể giúp e thêm chút nữa được ko

+ ở đây khi e làm với đường Le , vì nó có mũi tên nên có lúc sau khi hoàn thành lệnh thì chiều mũi tên xoay ko đúng như mình muốn, bác chèn giúp e thêm vào khi dùng lệnh này với Le (mũi tên) thì sẽ có thêm tùy chọn chọn 2 điểm trên đường mẫu để xác định hướng mũi tên ạ.


<<

Filename: 194810_xoay.lsp
Tác giả: langtumaulanh
Bài viết gốc: 368325
Tên lệnh: ctm
Xin mọi người giúp đỡ Lisp Center mark.

@ttmt_jses:

Bạn dùng thử lisp đánh center mark cho hàng loạt đường tròn. Lệnh CTM:

>>

@ttmt_jses:

Bạn dùng thử lisp đánh center mark cho hàng loạt đường tròn. Lệnh CTM:

;;;----------------------------------------------------
(defun ctm1(e / k d p0 r p1 p2 p3 p4)
(setq
k 1.2
d (entget e)
p0 (cdr (assoc 10 d))
r (cdr (assoc 40 d))
p1 (polar p0 pi (* k r))
p2 (polar p0 0 (* k r))
p3 (polar p0 (* pi 0.5) (* k r))
p4 (polar p0 (* pi 1.5) (* k r))
)
(command "line" p1 p2 "")
(command "line" p3 p4 "")
)
;;;----------------------------------------------------
(defun C:CTM( / ss oldos e)
(setq ss (ssget '((0 . "CIRCLE"))))
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(while (setq e (ssname ss 0))
(ctm1 e)
(ssdel e ss)
)
(setvar "osmode" oldos)
(princ)
)
;;;----------------------------------------------------
Đường center có chiều dài bằng 1.2 lần đường kính đường tròn. Muốn thay đổi thì sửa trị số 1.2 ở dòng thứ 3 trong code.

 

 

@Tue_NV: Cái "tại sao" bạn nêu mình biết rồi. Bạn làm thử nghiệm này:

1. Chọn Size của center mark (đặt là c), chọn Type "Line"

2. Vẽ các đường tròn có r trong khoảng 0 đến 2c, đánh center mark -> nhận xét

3. Thử nghiệm như trên với các đường tròn có r > 2c -> nhận xét và kết luận...

Gửi bạn ssg và các bạn trong diễn đàn mình thấy lisp của bạn rất hay! vấn đề ở đây mình cần là 2 đường center mark xoay đi 45 đô ( dạng dấu X)các bạn giúp mình giải quyết vấn đề này với nhá! Cảm ơn các bạn rất nhiều!


<<

Filename: 368325_ctm.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 171023
Tên lệnh: tlt
Nhờ sửa LISP ghi độ dốc đường thẳng

Mình có lisp này đã chỉnh sửa nhưng chưa theo ý muốn.

Lisp có chức năng ghi độ dốc đưởng thẳng: " Lisp đã ghi được...

>>

Mình có lisp này đã chỉnh sửa nhưng chưa theo ý muốn.

Lisp có chức năng ghi độ dốc đưởng thẳng: " Lisp đã ghi được độ dốc bằng cách chọn điểm đầu, điểm cuối, điểm ghi " nhưng chưa làm được như sau :

1. Chưa có thông số nhập vào chiều cao text.

2. Chưa ghi được chữ nằm trên (song song, cách đường thẳng 1 đoạn x) đường thẳng.

Mong bác nào giúp em khắc phục vấn đề trên để lisp hoàn thiện.

Em mò mãi chưa ra vì mới học lisp

Thân !

Cám ơn sự giúp đỡ.

(defun c:TLT ()

  (setq p (getpoint "\nChon diem dau: " ))
  (setq p1 (getpoint "\nChon diem cuoi: " p))
  (cond ((null tphan) (setq tphan 2)))
  (setq dau1 (car p))
  (setq cuoi1 (cadr p))
  (setq dau2 (car p1))
  (setq cuoi2 (cadr p1))
  (setq lx (abs (- dau1 dau2)))
  (setq ly (abs (- cuoi1 cuoi2)))
  (setq i (/ lx ly))

  (command "layer" "S" "0" "")
  (setq pt1 (getpoint "\nChon diem ghi do doc: " ))
  	(setq dau1 (+ 5 (car pt1)))
  	(setq cuoi1 (cadr pt1))
 	(setq pt1 (list dau1 cuoi1))
  	(setq goc (/ (* (atan i) -180) pi ))


  	(setq chuoi (strcat "1/" (rtos i 2 tphan)))
  	(command "text" "J" "M" pt1 2 goc chuoi )

)
 ;het gtl

Hề hề hề,

Lisp chưa làm được điều bạn muốn vì bạn không chỉ cho nó làm thế nào.

1/- trong lisp của bạn chiều cao chữ bắt buộc phải là 2 chứ bạn không thể tự nhập do dòng code : (command "text" "J" "M" pt1 2 goc chuoi )

2/- cái góc của text và vị trí đặt text cũng tương tự là do dòng code này quyết định.

Để có thể làm cho nó chạy theo ý bạn muốn bạn sẽ phải thay đổi dòng code này thành:

(command "text" "J" "M" pt1 h goc chuoi ) trong đó điểm pt1 bạn cần xác định lại tương ứng với vị trí bạn muốn . Hãy lưu ý rằng cái khoảng cách từ pt1 tới đường thẳng sẽ phụ thuộc vào góc tạo bởi đường thẳng đó với trục x được xác định bởi hàm angle.

Chiều cao h bạn phải xác định bằng cách cho người dùng tự nhập, có thể sử dụng hàm getreal hay getdist......

góc text goc phải được xác định theo hai điểm đầu và cuối mà bạn đã nhập ở trên bằng hàm angle và sau đó bạn phải chuyển từ số đo theo radian sang số đo theo độ.

 

Hy vọng rằng bạn sẽ tự chỉnh được cái lisp theo ý bạn qua những góp ý trên. Nều gặp trở ngại gì, hãy post lên nhé....

Chúc bạn thành công.


<<

Filename: 171023_tlt.lsp
Tác giả: cd2k44
Bài viết gốc: 154750
Tên lệnh: atic
Lisp rải đối tượng theo đơờng dẩn.

Vì bạn không đưa file CAD, nên còn có nhiều điều chưa rõ về Format Text của bạn.

vd : Text có định dạng số và...

>>

Vì bạn không đưa file CAD, nên còn có nhiều điều chưa rõ về Format Text của bạn.

vd : Text có định dạng số và chữ lẫn lộn "No : 3" hay "Km +4.530" ...

 

Truớc mắt bạn dùng thử LISP ghi Text tại giao điểm của các đường thẳng, cung tròn, Pline, đuờng tròn, elíp với đường dẫn.

+ text rải sẽ tăng dần đều với buớc là 1.

+ tuơng tự lệnh Divide của CAD, phụ thuộc vào điểm pick khi chọn đường dẫn, chiều tăng của Text sẽ đi từ điểm đầu tới điểm cuối hoặc nguợc lại.

(defun c:ATIC(/ ent ov pts ss vl h num); ATIC -> Add Text at Intersect with Curve
 ;;  By : Gia_Bach, www.CadViet.com 2011    ;;  
 (vl-load-com)
 (command "undo" "be")
 (setq vl '("osmode" "orthomode" "cmdecho") ; Sys Var list
ov (mapcar 'getvar vl))              ; Get Old values
 (mapcar 'setvar vl '(545 0 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* (* (getvar "dimtxt")(getvar "dimscale"))))
     (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 <" (rtos *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)
(vla-AddText spc (rtos *num*) (vlax-3D-point pt) *h*)
(setq *num* (1+ *num*)))
     (mapcar 'setvar vl 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.Nhờ anh chỉnh lại lisp giùm em như sau:

1. Text của em chỉ có số thôi.định đạng của nó là middelcenter và không cần lấy giá trị sau dấu thập phân nha anh ( chương trình của anh đang chạy ra 1.0000 em chỉ cần 1 ( cái này nếu ko chỉnh thì em có thể chỉnh lại trong unit của cad cũng được)).Ý của em là điểm giữa của text trùng với giao điểm của các đồi tượng khác với đường dẫn

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

Em gửi anh file kết quà mong muốn của em.Cảm ơn anh nhiều

http://www.cadviet.com/upfiles/3/drawing1_11.rar


<<

Filename: 154750_atic.lsp
Tác giả: hhhhgggg
Bài viết gốc: 62512
Tên lệnh: cd
khi Cắt Dim để lại phần chân Dim dài bằng nhau !!!
Lời đầu tiên, Tue_NV xin góp ý chân thành với bạn hhhhgggg : Khi viết bài bạn nên nhìn nhận vấn đề một cách...
>>
Lời đầu tiên, Tue_NV xin góp ý chân thành với bạn hhhhgggg : Khi viết bài bạn nên nhìn nhận vấn đề một cách tổng quát và nói rõ vấn đề vì có thể mọi người không hiểu theo ý bạn và từ đó làm mất thời gian của chính mình và làm mất thời gian của người khác là điều không nên và phải tránh

 

Cứ như bài viết này, Tue_NV muốn giúp bạn mà chẳng biết làm thế nào nữa

http://www.cadviet.com/forum/index.php?showtopic=11138

Tue_NV đã chỉnh sửa lại Code trên. Hy vọng nó có ích cho mọi người.

 

Tên lệnh Cd

1. Lisp yêu cầu chọn DIM

2. Lisp yêu cầu : nhập khoảng cách đường dóng.

3. Lisp thực hiện công việc : cắt chân dim đã chọn với khoảng cách đường dóng do user nhập vào.

Lisp này có 1 điểm hay mà Tue_NV rất thích là ở bước thứ 2 : Nhập khoảng cách đường dóng

 

Khoảng cách đường dóng này mang ý nghĩa tương đối.

Khoảng cách đường dóng có thể là số dương (>0), có thể là số âm (<0) và có thể bằng 0

Và khoảng cách có thể pick 2 điểm trên màn hình. Lisp sẽ lấy khoảng cách 2 điểm pick trên màn hình làm khoảng cách đường dóng. Và khoảng cách khi ta pick 2 điểm này sẽ mang giá trị dương ( + )

 

Bạn hãy chạy thử và nghiệm ra điều mà Tue_NV nói.

Các bạn hãy cho ý kiến, nếu có gì chưa được thì Tue_NV sẽ sửa lại. Hy vọng nó có ích cho mọi người

(DEFUN C:CD (/ KC KCo CMD SS LTH DEM PT DS KDL N70 GOCX GOCY PT13 PT14 PTI PT13I PT14I
PT13N PT14N O13 O14 N13 N14 OSM OLDERR PT10 PT11)
(prompt "\n KS VO QUANG TUE")
(print)
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
(SETQ OLDERR *error*
*error* myerror)
(PRINC " Moi Chon duong kich thuoc :")
(SETQ SS (SSGET'((0 . "DIMENSION"))))
(SETVAR "CMDECHO" 0)
(If (not KCo) (setq KCo 100))
(SETQ KC (GETDIST (strcat "\n Khoang cach cut dim : <" (rtos KCo 2 0) ">")))
(if (null KC) (setq KC KCo) (setq KCo KC))

(COMMAND "UCS" "W")
(SETQ LTH (SSLENGTH SS))
(SETQ DEM 0)
(WHILE (< DEM LTH)
(PROGN
(SETQ DS (ENTGET (SSNAME SS DEM)))
(SETQ KDL (CDR (ASSOC 0 DS)))
(IF (= "DIMENSION" KDL)
(PROGN
(SETQ PT10 (CDR (ASSOC 10 DS)))
(SETQ PT11 (CDR (ASSOC 11 DS)))
(SETQ PT13 (CDR (ASSOC 13 DS)))
(SETQ PT14 (CDR (ASSOC 14 DS)))
(SETQ N70 (CDR (ASSOC 70 DS)))
(IF (OR (= N70 32) (= N70 33) (= N70 160) (= N70 161))
(PROGN
(SETQ GOCY (ANGLE PT10 PT14))
(SETQ GOCX (+ GOCY (/ PI 2)))
)
)
(SETVAR "OSMODE" 0)
(setq PT (POLAR PT10 GOCY KC))
(SETQ PTI (POLAR PT GOCX 2))
(SETQ PT13I (POLAR PT13 GOCY 2))
(SETQ PT14I (POLAR PT14 GOCY 2))
(SETQ PT13N (INTERS PT PTI PT13 PT13I NIL))
(SETQ PT14N (INTERS PT PTI PT14 PT14I NIL))
(SETQ O13 (ASSOC 13 DS))
(SETQ O14 (ASSOC 14 DS))
(SETQ N13 (CONS 13 PT13N))
(SETQ N14 (CONS 14 PT14N))
(SETQ DS (SUBST N13 O13 DS))
(SETQ DS (SUBST N14 O14 DS))
(ENTMOD DS)
)
)
(SETQ DEM (+ DEM 1))
)
)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
(SETVAR "OSMODE" OSM)
(setq *error* OLDERR) ; Restore old *error* handler
(PRINC)
)

OK ! Với cái lisp này thì người duyệt dù khó tính đến mấy cũng phải hài lòng về bản vẽ, Nó sẽ làm bản vẽ trở nên Pro hơn nhìu !!! Cảm ơn bác Tuệ nhé !!!


<<

Filename: 62512_cd.lsp
Tác giả: txquychk51
Bài viết gốc: 403799
Tên lệnh: tt%C2%A0
Nhờ Mọi Người Sửa Hộ Lisp Leader.

 

Điểm C chỉ là để lấy khoảng cách và góc hợp giữa đoạn thẳng nối A-C với khúc đầu của leader. Hướng rải...

>>

 

Điểm C chỉ là để lấy khoảng cách và góc hợp giữa đoạn thẳng nối A-C với khúc đầu của leader. Hướng rải luôn theo hướng mũi tên leader, nếu góc ở trên < 90 thì rải giật lùi và ngược lại.

(defun c:tt  (/ ang apt dis ele ent i lea len lsc lsm lsp pt pt1 pt2)
 (vl-load-com)
 (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
 (if (and (setq ele (ssget "_+.:E:S" '((0 . "LEADER"))))
          (setq ent (ssname ele 0)
                lsp (vl-remove-if-not '(lambda (x) (member (car x) '(10))) (entget ent))
                lsc (vlax-get-property (vlax-ename->vla-object ent) 'ScaleFactor))
          (setq pt1 (cdr (car lsp)))
          (setq dis (getdist "\nKhoang cach giua cac Leader: " pt1))
          (setq pt2 (getpoint "\nDiem ket thuc: " pt1)))
  (progn (setq lsm (vl-remove-if '(lambda (x) (member (car x) '(-1 5 10 330 340))) (entget ent))
               ang (angle pt1 (cdr (cadr lsp)))
               len (distance pt1 pt2)
               i   0)
         (setq apt (angle pt1 pt2))
         (if (or (< (- apt ang) (* 0.5 pi)) (> (- apt ang) (* 1.5 pi)))
          (setq ang ang)
          (setq ang (+ ang pi)))
         (repeat (fix (/ len dis))
          (setq pt (polar pt1 ang (* dis (setq i (1+ i)))))
          (setq lea (entmakex (append lsm (subst (cons 10 pt) (assoc 10 lsp) lsp))))
          (vlax-put-property (vlax-ename->vla-object lea) 'ScaleFactor lsc))))
 (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
 (princ))

e đã thử và thành công. e cảm ơn bác nhé :)


<<

Filename: 403799_tt%C2%A0.lsp
Tác giả: hovidu
Bài viết gốc: 391011
Tên lệnh: foo
Tìm Và Thay Thế Đối Tượng Trong Cad

Hàng loạt như thế này thì code lisp là ngon xơi nhất. Nếu không thì cũng phải làm khoảng 3 bước

Bạn đọc kỹ bài của bác Anti...

>>

Hàng loạt như thế này thì code lisp là ngon xơi nhất. Nếu không thì cũng phải làm khoảng 3 bước

Bạn đọc kỹ bài của bác Anti lazy, có lý đó :)

Lần này chữa cháy cho bạn bằng code ngắn, test thử trên máy mình ok

(defun c:foo()
	(foreach e (acet-ss-to-list (ssget '((0 . "LINE")(8 . "S5"))))
		(entmake (list '(0 . "INSERT")
						(cons 2 "S5")
						(cons 10 (apply 'acet-geom-midpoint (acet-geom-extents e)))											
				)
		)
		(entdel e)
	) (princ)
)

 Thank bạn nhé

Mình cũng muốn mày mò nhưng dạo này bận quá. 

Bỏ USD ra để mua mấy cái nhỏ nhỏ này cũng không đáng.

 

PS: Bạn vào dùng bộ gõ của diễn đàn có bị hiện tượng khi gõ 2 lần dấu thì con trỏ tự động nhảy về đầu dòng không? Mấy lần mình phải gõ trên word rồi paste vào đây rồi.

Ví dụ gõ "USD" phải gõ "U S S D" thì gõ đến chữ S thứ 2 con trỏ nhảy về đầu dòng.


<<

Filename: 391011_foo.lsp
Tác giả: jangboko
Bài viết gốc: 405973
Tên lệnh: tt
Lisp Cộng Trừ Text

Của bạn đây:

(defun c:tt (/ els ent i new sst str val)

(or #delta# (setq #delta# 0.))

(if (and...

>>

Của bạn đây:

(defun c:tt (/ els ent i new sst str val)

(or #delta# (setq #delta# 0.))

(if (and (princ "\nQuet chon Text...!")

(setq sst (ssget '((0 . "*TEXT"))))

(setq #delta# (cond ((getreal (strcat "\nNhap so gia <" (rtos #delta# 2 2) ">: ")))

(#delta#))))

(repeat (setq i (sslength sst))

(setq ent (ssname sst (setq i (1- i)))

els (entget ent)

str (cdr (assoc 1 els)))

(and (setq val (distof str))

(setq new (+ val #delta#))

(setq els (subst (cons 1 (rtos new 2 2)) (assoc 1 els) els))

(entmod els))))

(princ))

toẹt vời ông mặt zời, cảm ơn bạn nhiều


<<

Filename: 405973_tt.lsp
Tác giả: thanhduan2407
Bài viết gốc: 103900
Tên lệnh: aic
Array đối tượng trong vùng
Chào bạn thanhduan, anh Duy

Tue_NV viết 1 đoạn code trên thuật toán mà bạn thanhduan đưa ra :

(defun c:aic(/ ms pl minp maxp minpp name kc ssa ans line minp2)
...
>>
Chào bạn thanhduan, anh Duy

Tue_NV viết 1 đoạn code trên thuật toán mà bạn thanhduan đưa ra :

(defun c:aic(/ ms pl minp maxp minpp name kc ssa ans line minp2)
 (vl-load-com)
 (command "undo" "be")
 (setvar "attreq" 0)
 (setq oldos (getvar "osmode"))
 (setvar "osmode" 0)
 (setq ms (vla-get-modelspace (vla-get-activedocument(vlax-get-acad-object))))
 (setq pl (vlax-ename->vla-object (car(entsel "\n Chon Polyline kin :"))))
 (vla-getboundingbox pl 'minp 'maxp)
 (setq minp (safearray-value minp))
 (setq maxp (safearray-value maxp))
 (setq name (getstring "\n Nhap ten Block / enter de chon doi tuong : ") ssa '())
 (if (= name "") (setq name (cdr(assoc 2 (entget (car(entsel "\n Chon Block :")))))))
 (setq kc (getdist "\n Khoang cach hang :"))
 (setq minpp (mapcar '- minp (list (distance maxp minp) (distance maxp minp) 0)))

 (vl-cmdf "insert" name minp 1 1 0.0)
       (setq dtd (vlax-ename->vla-object (entlast)))
 (setq minp2 (mapcar '+ minp (list (/ kc 2) (/ kc 2) 0.0)))
   (vl-cmdf "insert" name minp2 1 1 0.0)
       (setq dts (vlax-ename->vla-object (entlast)))
     (setq ssa
(append (list dtd)
        (vlax-invoke dtd 'ArrayRectangular
	  	(1+ (fix (/ (- (cadr maxp) (cadr minp)) kc)))
		(1+ (fix (/ (- (car maxp) (car minp)) kc)))
	  	1 kc kc 0
  	)
	(list dts)
	(vlax-invoke dts 'ArrayRectangular
	  	(1+ (fix (/ (- (cadr maxp) (cadr minp)) kc)))
		(1+ (fix (/ (- (car maxp) (car minp)) kc)))
	  	1 kc kc 0
  	)
)
    );setq

 (initget "N T")
 (setq ans (getkword "\n Ban muon xoa cac doi tuong ngoai hay trong Polyline < N / T > :"))
 (foreach x ssa
   (setq line (vla-addline ms (vlax-3d-point minpp)
	 	       (vla-get-insertionpoint x)
       )
   )
   (if (= (strcase ans) "N")
     (progn
   	(if (= (rem (length (vlax-invoke pl 'intersectwith line 0)) 2) 0)
     		(vla-erase x)
       )	
     )
   )
   (if (= (strcase ans) "T")
     (progn
   	(if (= (rem (length (vlax-invoke pl 'intersectwith line 0)) 2) 1)
     		(vla-erase x)
       )	
     )
   )    

   (vla-erase line)
)
 (setvar "osmode" 0)
 (command "undo" "end")
)

Bạn thanhduan, anhDuy thử nhé

Chúc các bác 1 ngày cuối tuần vui vẻ :(

Thật tuyệt vời. Cảm ơn bác Tue_NV. Cảm ơn tất cả mọi người. Em sẽ nghiên cứu phương thức của bác. Chỗ nào không hiểu em sẽ hỏi bác. Một lần nữa cảm ơn bác.


<<

Filename: 103900_aic.lsp
Tác giả: prute
Bài viết gốc: 203702
Tên lệnh: test
offset tự động

Quick code, bạn khử biến đi nhé. Đây chỉ là 1 ví dụ mình đưa ra thôi, vì khái niệm bên trong rất khó, nhất là trong các trường hợp đối...

>>

Quick code, bạn khử biến đi nhé. Đây chỉ là 1 ví dụ mình đưa ra thôi, vì khái niệm bên trong rất khó, nhất là trong các trường hợp đối tượng của bạn phức tạp, giao nhau, hoặc ngoằn nghèo

Ở đây mình chỉ lấy list 3 đối tượng gồm có : gốc, offset -dist, offset + dist, và xóa đi 2 thằng to hơn, giữ lại thằng nhỏ nhất (theo diện tích) - để phù hợp với nhu cầu offset vào "trong" của bạn. Trường hợp method offset sinh ra nhiều hơn 1 đối tượng thì không còn chuẩn nữa, nếu bạn là lispser thì hãy cố gắng xử lý vấn đề này xem sao :)

(defun c:test ()
(cond ((ssget '((0 . "CIRCLE,ELLIPSE,POLYLINE,LWPOLYLINE,SPLINE")))
 (or *dist (setq *dist 100))
 (setq *dist (cond ((getdist (strcat "\nDistance <" (rtos *dist 2 2) ">")))(*dist))
 isClosed (lambda(x)(cond  ((and  (= (vla-get-ObjectName x) "AcDbEllipse")(zerop (vla-get-StartAngle x))))
		((and  (wcmatch (vla-get-ObjectName x) "AcDb*line")
  		(equal  (car (setq sth (acet-geom-vertex-list (vlax-vla-object->ename x))))
    		(last sth)
    		0.01
  		)
     	)
		)
 	)
)
)
 (vlax-for obj (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))
(if (isclosed obj)
  (mapcar 'vla-delete
(cdr
 (vl-sort
  (list (car(vlax-invoke obj 'Offset *dist)) obj  (car (vlax-invoke obj 'Offset (- *dist))))
  '(lambda(x y)(< (vlax-get x 'Area)(vlax-get y 'Area)))
 )
)
  )
 )
 ))(T (princ "\nNo thing to do"))
)(princ)
)

lisp này em chạy thử thì thấy đường tròn không được


<<

Filename: 203702_test.lsp
Tác giả: huunhantvxdts
Bài viết gốc: 197826
Tên lệnh: cong
Giao diện hộp thoại trong AutoLisp

Đây là một ví dụ

File Lisp

(defun C:CONG()
(setq DCL_ID (load_dialog "CONG"))
(if (not (new_dialog "CONG" DCL_ID))...
>>

Đây là một ví dụ

File Lisp

(defun C:CONG()
(setq DCL_ID (load_dialog "CONG"))
(if (not (new_dialog "CONG" DCL_ID)) (exit))
(if (not a) (setq a "0.00"))
(set_tile "a" a)
(if (not B) (setq b "0.00"))
(set_tile "b" B)
(action_tile "a" "(setq a $value) (KIEM_TRA_LOI)")
(action_tile "b" "(setq b $value) (KIEM_TRA_LOI)")
(action_tile "cong" "(set_tile \"c\" (rtos (+ (distof (get_tile \"a\")) (distof (get_tile \"b\")))))")
(start_dialog)
(unload_dialog DCL_ID)
(princ))
(defun KIEM_TRA_LOI()
(set_tile "error" "")
(if
 (/= (type (distof a)) 'real)
 (progn
  (set_tile "error" "Cho em xin mot so thuc !")
  (mode_tile "a" 2)))
(if
 (/= (type (distof B)) 'real)
 (progn
  (set_tile "error" "Cho em xin mot con so !")
  (mode_tile "b" 2))))

File Dcl

CONG : dialog { label = "Cong 2 so";
 : boxed_row {
: edit_box { label = "a" ; key = "a" ; edit_width = 6; }
: edit_box { label = "b" ; key = "b" ; edit_width = 6; }
: edit_box { label = "c" ; key = "c" ; edit_width = 6; }
 }
 : boxed_row {
: button { label = "Cong" ; key = "cong"; }
: button { label = "Cancel" ; key = "cancel" ; is_default = true ; is_cancel = true; }
 }
 errtile;
}

Làm sao chạy được

mình down về bỏ vào 1 thư mục ở ổ C sau đó mở cad2008 load lisp vào

nhưng khi chạy nó báo lỗi nên chẳng thây gì cả

mong mọi người giúp đỡ.

mình đang tìm hiểu về nó


<<

Filename: 197826_cong.lsp

Trang 255/330

255