Jump to content
InfoFile
Tác giả: whatcholingon
Bài viết gốc: 200484
Tên lệnh: p2s
Lisp vẽ một SPL trên một PL cho trước

Nếu muốn làm mịn đi thì loại bỏ các điểm ở giữa, bạn sử dụng thằng này. Độ làm mịn càng lớn thì số đỉnh của Pline bị loại...

>>

Nếu muốn làm mịn đi thì loại bỏ các điểm ở giữa, bạn sử dụng thằng này. Độ làm mịn càng lớn thì số đỉnh của Pline bị loại bỏ càng lớn. Ở máy của mình lấy ví dụ tầm 30 là đẹp :) Lần sau chịu khó trình bày kỹ hơn chút nữa hén, do mình hơi dốt nên dễ hiểu nhầm

(defun c:p2s(/ ss lstPro MakeSPline ST:Geom-Vertext-List  lstPro)
(command "undo" "be")
(setq a (getint "\nDo lam min :"))
(prompt "\nChon Pline(s) :")
(cond ( (ssget (list (cons 0 "*POLYLINE")))
 (vl-load-com)
 (setq  lstPro '(Linetype LinetypeScale Layer Color))
 (defun lstRe (lst n / rt sublst);(1 2 3 4)
  (defun sublst(lst it)(repeat (1- it) (setq lst (cdr lst))))
  (while lst
(setq rt (cons (car lst) rt) lst (sublst lst n))
  )  (reverse (vl-remove nil rt))
 )
 (defun MakeSPline (listpoint Linetype LTScale Layer Color  / Lst)
  (setq lst (list '(0 . "SPLINE")'(100 . "AcDbEntity")
	(cons 8 (if Layer Layer (getvar "Clayer")))
	(cons 6 (if Linetype Linetype "bylayer"))
	(cons 48 (if LTScale LTScale 1))
	(cons 62 (if Color Color 256))
	'(100 . "AcDbSpline")
   	(cons 71 3)
	(cons 74 (length listpoint))))
(foreach PP listpoint (setq Lst (append Lst (list (cons 11 PP)))))  
  (entmakex Lst)
 );end
 (defun ST:Geom-Vertext-List (e / typ poly) ;vlaObject
  (setq typ (vlax-get e 'ObjectName))
  (cond ((wcmatch typ "AcDbLine")(list (vlax-get e 'StartPoint)(vlax-get e 'EndPoint)))
(T
(   (lambda ( f /)
 	(if (setq poly (vl-position typ '("AcDbPolyline" "AcDb2dPolyline" "AcDb3dPolyline")))    
  	(f (vlax-get e 'coordinates))
 	)
 	)
(lambda ( l )
 	(cond
  	((and l (= poly 0)) (cons (list (car l) (cadr l)) (f (cddr l))))
  	((and l (= poly 1)) (cons (list (car l) (cadr l)) (f (cdddr l))))
  	((and l (= poly 2)) (cons (list (car l) (cadr l) (caddr l)) (f (cdddr l))))
 	)
)
)
)
  )
 )
(vlax-for x (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))
 (apply
  'MakeSPline
(append
(list (lstRe (ST:Geom-Vertext-List x) a))
(mapcar '(lambda(a)(vlax-get x a)) lstPro)    
)
 )
 (vla-erase x)
)
)
)
(command "undo" "en")
)

 

Thanhs!

Bạn khiêm tốn quá ! mình muốn dốt như bạn mà còn chẳng được nữa là.

Về diễn giải hay trình bày một cái gì đó thì mình kém lắm. (văn học mình học cực dốt mà)

Mọi người thông cảm.


<<

Filename: 200484_p2s.lsp
Tác giả: nhatphong
Bài viết gốc: 183836
Tên lệnh: test
nhờ làm lisp vẽ tường....

Quick code :

(defun c:test()
(vl-load-com)
(or #d (setq #d 1))
(setq #d (cond ((getdist (strcat "\nKhoang cach Offset < "...
>>

Quick code :

(defun c:test()
(vl-load-com)
(or #d (setq #d 1))
(setq #d (cond ((getdist (strcat "\nKhoang cach Offset < " (vl-princ-to-string #d) " > :")))(#d)))
(princ "\n Chon doi tuong :")
(if (setq ss (ssget (list (cons 0 "Ellipse,Lwpolyline,Spline,Line,Circle,Arc,Pline"))))
(foreach item (mapcar 'vlax-ename->vla-object (acet-ss-to-list ss))
(vla-offset item #d)
(vla-offset item (- #d))
)
))

thank bạn lisp này thêm tham số Xline cũng được như cái kia :D


<<

Filename: 183836_test.lsp
Tác giả: locxd
Bài viết gốc: 205264
Tên lệnh: ft
Lisp căn lề text: Left, Center, Right và Fit (giống word)

Trước đây mình có thấy trong diễn đàn đã cung cấp công cụ căn lề text theo 3 kiểu Left, Center, Right. Tuy nhiên công cụ này ko...

>>

Trước đây mình có thấy trong diễn đàn đã cung cấp công cụ căn lề text theo 3 kiểu Left, Center, Right. Tuy nhiên công cụ này ko viết bằng autolisp và chỉ chạy được các bản cad 2004, 2005 và 2006 nên mình viết một lisp tương tự để chạy được trên tất cả các bản cad.

- Lisp yêu cầu chọn tất cả các text (Dtext va MText) cần căn lề.

- Chọn một text làm chuẩn để căn lề các text đã chọn theo text đó

- Ngoài chức năng căn lề theo 3 vị trí. Left, Center, Right thì lisp này cung cấp thêm chức năng căn lề theo kiểu Fit, - kéo dãn các dòng cho dài bằng nhau (giống word) và dài bằng text chọn làm chuẩn.

canletxt.jpg

(defun c:ft()(command "undo" "begin")(setq oldos (getvar "osmode"))(setq olcol (getvar "CEColor"))(setq olstyle (getvar "textstyle"))(prompt "\nchon cac text can can le ...")(setq txt (ssget '((0 . "*TEXT"))))(setq mau (entget (car (entsel "\nChon text chuan"))))(setq TB  (textbox mau) LC  (car TB) RC (cadr TB) di (distance LC RC) i 0)(setq x1 (cdr(assoc 10 mau)))(setq x2 (list (+ (car x1) (* di 0.5)) (cadr x1)))(setq x3 (list (+ (car x1) di) (cadr x1)))(setq canle (cond (canle) ("Left")))(initget "Left Center Right Fit")(setq canle (cond ((getkword (strcat "\Vi tri can le <" canle ">"))) (canle)))(repeat (sslength txt)(setq txt_ent (entget (ssname txt i)))(setq txt_val (cdr(assoc 1 txt_ent)))(setq txt_st (cdr(assoc 7 txt_ent)))(setq txt_lay (cdr(assoc 8 txt_ent)))(setq txt_h (cdr(assoc 40 txt_ent)))(setq txt_fctr (cdr(assoc 41 txt_ent)))(setq txt_clr (cdr(assoc 62 txt_ent)))(setq y1 (cdr(assoc 10 txt_ent)))(if (cdr(assoc 43 txt_ent)) (setq txt_fctr 1 y1 (list (car y1) (- (cadr y1) txt_h))))(setq pt1 (list (car x1) (cadr y1)))(setq pt2 (list (car x2) (cadr y1)))(setq pt3 (list (car x3) (cadr y1)))(command "-style" txt_st "" "" txt_fctr "" "" "" "" "clayer" txt_lay "color" txt_clr "osmode" 0)(if (eq canle "Left") (command "text" pt1 txt_h 0 txt_val))(if (eq canle "Center") (command "text" "C" pt2 txt_h 0 txt_val))(if (eq canle "Right") (command "text" "R" pt3 txt_h 0 txt_val))(if (eq canle "Fit") (command "text" "F" pt1 pt3 txt_h txt_val))(setq i (+ i 1))(command "color" "bylayer"));repeat(setvar "textstyle" olstyle)(setvar "CECOLOR" olcol)(setvar "osmode" oldos)(command "erase" txt "")(prompt"\n by Thaistreetz - huuthais@yahoo.com\n")(command "undo" "end"));defun

Hiện tại thì mình đã khá hài lòng với lisp này nếu chỉ dùng để căn lề text. Tuy nhiên mình muốn thêm cho nó chức năng giãn dòng cho đều cũng với cách nhập số liệu như trên nhưng đang mắc về thuật giải. Xin nhờ mọi người giúp mình hoàn thiện lisp này với.

 

Edit: đã fix lỗi

 

Bạn ơi cho hỏi mình sử dụng lệnh ft để canh các text cùng toạ độ X, canh lề trái mà sao khi thực hiện, các text biến thành số 0 và bị lệnh góc so với phương X. mình đang cần sử dụng chức năng này, bạn có thể trả lời email cho mình ko? <locxd78@gmail.com>. Thanks


<<

Filename: 205264_ft.lsp
Tác giả: Oohlala
Bài viết gốc: 352089
Tên lệnh: cua
Lisp cửa đi

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

 
(setq oldosmode (getvar "osmode")
      ORTHO (getvar "ORTHOMODE"))
(defun D1 () 
     ...
>>

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

 
(setq oldosmode (getvar "osmode")
      ORTHO (getvar "ORTHOMODE"))
(defun D1 () 
       (command ".line" p2 (polar p3 ang2 r) "")
       (command ".line" p4 p5 "")
       (if (or (and (> (car p2) (car p1)) 
                    (> (cadr p2) (cadr p3))
               ) 
               (and (< (car p2) (car p1)) 
                    (< (cadr p2) (cadr p3))
               ) 
               (and (> (cadr p1) (cadr p2)) 
                    (> (car p2) (car p3))
               )
               (and (< (cadr p1) (cadr p2)) 
                    (< (car p2) (car p3))
               )
           )
           (setq ang 90)
           (setq ang -90)
       ) ; end of if
 
       (command ".arc"  "C" p3 (polar p3 ang2 r) "A" ang "")
      
); END OF D1
;(alert "checkpoint1")
(defun D2 ()
       (command ".line" p2 (polar p3 ang2 (/ r 2)) ""
                ".line" p5 (polar p4 ang2 (/ r 2)) ""
       )
        (if (or (and (> (car p2) (car p1)) 
                    (> (cadr p2) (cadr p3))
               ) 
               (and (< (car p2) (car p1)) 
                    (< (cadr p2) (cadr p3))
               ) 
               (and (> (cadr p1) (cadr p2)) 
                    (> (car p2) (car p3))
               )
               (and (< (cadr p1) (cadr p2)) 
                    (< (car p2) (car p3))
               )
           )
           (setq ang 90)
           (setq ang -90)
       ) ; end of if
       (command ".arc"  "C" p3 (polar p3 ang2 (/ r 2)) "A" ang "")
       (setq m (ssget "L"))
       (command ".mirror" m "" (polar p2 ang1 (/ r 2)) (polar p3 ang1 (/ r 2)) "")
) ;End of D2
 
(defun D4 ()
       (setq ss0 (ssadd))
       (command ".line" p2 (polar p3 ang2 (/ r 4)) "")
       (ssadd (entlast) ss0)
        (if (or (and (> (car p2) (car p1)) 
                    (> (cadr p2) (cadr p3))
               ) 
               (and (< (car p2) (car p1)) 
                    (< (cadr p2) (cadr p3))
               ) 
               (and (> (cadr p1) (cadr p2)) 
                    (> (car p2) (car p3))
               )
               (and (< (cadr p1) (cadr p2)) 
                    (< (car p2) (car p3))
               )
           )
           (setq ang 90)
           (setq ang -90)
       ) ; end of if
       (command ".arc"  "C" p3 (polar p3 ang2 (/ r 4)) "A" ang "")
       (ssadd (entlast) ss0)
       (command ".line" (setq tm (polar p3 ang1 (/ r 4))) (polar tm ang2 (/ r 4)) "")
       (ssadd (entlast) ss0)
       (command ".arc"  "C" tm (polar tm ang2 (/ r 4)) "A" ang "")
       (ssadd (entlast) ss0)      
  
       (command ".mirror" ss0 "" (polar p2 ang1 (/ r 2)) (polar p3 ang1 (/ r 2)) "")
)
 
; Than chuong trinh chinh
(defun c:cua (/ )
(command "undo" "be")
       (initget "D1 D2 D4")
       (setq res (getkword "\D1 1CANH _ D2 2CANH _ D4 4CANH ? <D1>:"))
       (if (not res) (setq res "D1"))
; Nhap so lieu 
       (setvar "osmode" 33)
       (setq p1 ( getpoint "\nDIEM THU 1, GOC TUONG:"))
       (setvar "osmode" 512 )
       (setvar "ORTHOMODE" 1)
       (setq p2 ( getpoint p1 "\nDIEM THU 2:"))    
       (setvar "lastpoint" p2)
       (setvar "osmode" 128)
 ;(alert "checkpoint6")          
       (setq p3 ( getpoint p2 "DIEM THU 3:")
             ang1 (angle p1 p2)
             ang2 (angle p2 p3)
             r (getreal "\nBe rong cua:")
             p4 (polar p3 ang1 r)
             p5 (polar p2 ang1 r)
             p23 (polar p2 ang2 (/ (distance p2 p3) 2))
             p45 (polar p5 ang2 (/ (distance p5 p4) 2))
       )
       (setvar "osmode" 0)
       (command ".break" p2 p5 
                ".break" p3 p4)
       (if (= res "D1") (D1))
       (if (= res "D2") (D2))
       (if (= res "D4") (D4))
       (setvar "osmode" oldosmode)
(SETVAR "ORTHOMODE" ORTHO) 
(command "undo" "e")
   (princ)     
); end of programmer
 

Có lisper chắc phải có csharper và vbaper chứ hả?  :)  :)

bạn ơi sao mình dùng lsp này khi nhập lệnh D1, D2 thì toàn báo là unknown command 


<<

Filename: 352089_cua.lsp
Tác giả: Nguyen Trung Kien
Bài viết gốc: 67028
Tên lệnh: cso
LISP cộng têxt toàn bộ bản vẽ thêm 1 hằng sô

Đây bạn :

(defun c:cso()
(setq olddim (getvar "dimzin"))
(setvar "DimZin" 0)

(setq en (ssget '((0 . "TEXT"))))
(setq tp (getint "\n So chu so thap phan :"))

(setq n (sslength en)...
>>
Đây bạn :

(defun c:cso()
(setq olddim (getvar "dimzin"))
(setvar "DimZin" 0)

(setq en (ssget '((0 . "TEXT"))))
(setq tp (getint "\n So chu so thap phan :"))

(setq n (sslength en) i 0)

(if (null newo) (setq newo 1))

(setq new1 (getreal (strcat "\nNhap so can cong <" (rtos newo) ">: ")))

(if (null new1) (setq new1 newo) (setq newo new1))

(while (< i n)

(setq ename (entget (ssname en i)))

(setq li (cdr (assoc 1 ename)))
(setq lis (+ (atof li) new1))

(setq ename (subst (cons 1 (rtos lis 2 tp)) (assoc 1 ename) ename))

(entmod ename)
(setq i (+ i 1))
)
(setvar "dimzin" olddim)
(princ)
)
;;;;

Tui là gà mới vào nghề nên chẳng hiểu gì cả, bác Pro nào có thể giải thích rõ hơn để anh em gà còn có cơ hội thành gà già. Thank u! :s_big:


<<

Filename: 67028_cso.lsp
Tác giả: hoa tam that
Bài viết gốc: 79324
Tên lệnh: oo
Lệnh offset đặc biệt
thử cái này đi. chắc bạn sẽ hài lòng...

(defun c:oo(/ data_m)

(defun import_data(/ i)
(setq data_m (ssget))
(if (= nil distan_m) (setq distan_m 110.0))
(princ "Distance...
>>
thử cái này đi. chắc bạn sẽ hài lòng...

(defun c:oo(/ data_m)

(defun import_data(/ i)
(setq data_m (ssget))
(if (= nil distan_m) (setq distan_m 110.0))
(princ "Distance (")
(princ distan_m)
(princ "):")
(setq i (getreal ))
(if (not (= nil i)) (setq distan_m i))
)

(defun process(/ ent check)

(defun p_check()
(setq check 0)
(if (= "LINE" (cdr (assoc 0 ent))) (setq check 1))
(princ)
)

(defun p_d_offset(/ p1 p2 p3 p4)

(defun makeline(/ e2 e5)
;	(princ ent)
;	(setq e5 nil)
;	(setq e5 (cdr (assoc 5 ent)))
;	(princ e5)
;	(if (= nil e5) (setq e5 ))

(setq la (list (cons 0 "LINE")
	(cons 5 (cdr (assoc 5 ent)) )
	(cons 8 (cdr (assoc 8 ent)) )
	(cons 10 p3)
	(cons 11 p4)
))
;	(princ la)
(entmake la)
(princ)
)

(setq p1 (cdr (assoc 10 ent)) p2 (cdr (assoc 11 ent)) )
(if (not (= p1 p2)) (progn
	(if (< (abs (- (nth 0 p1) (nth 0 p2))) 0.000001) (progn
		(setq p3 (list (+ (nth 0 p1) distan_m) (nth 1 p1) (nth 2 p1) ) )
		(setq p4 (list (+ (nth 0 p2) distan_m) (nth 1 p2) (nth 2 p2) ) )
		(makeline)
		(setq p3 (list (- (nth 0 p1) distan_m) (nth 1 p1) (nth 2 p1) ) )
		(setq p4 (list (- (nth 0 p2) distan_m) (nth 1 p2) (nth 2 p2) ) )
		(makeline)
	))
	(if (< (abs (- (nth 1 p1) (nth 1 p2))) 0.000001) (progn
		(setq p3 (list (nth 0 p1) (+ (nth 1 p1) distan_m) (nth 2 p1) ) )
		(setq p4 (list (nth 0 p2) (+ (nth 1 p2) distan_m) (nth 2 p2) ) )
		(makeline)
		(setq p3 (list (nth 0 p1) (- (nth 1 p1) distan_m) (nth 2 p1) ) )
		(setq p4 (list (nth 0 p2) (- (nth 1 p2) distan_m) (nth 2 p2) ) )
		(makeline)
	))

))
(princ)
)

(if (not (= nil data_m)) (progn
	(setq i 0)
	(while (< i (sslength data_m)) (progn
		(setq ent (entget (ssname data_m i)))
		(p_check)
		(if (= 1 check) (p_d_offset))
		(setq i (+ i 1))
	))
))
(princ)
)
(import_data)
  (ai_undo_push)
(process)
  (ai_undo_pop)
(princ)
)

 

chỉ áp dụng được đường thẳng không áp cho đường xiên được thật là chưa vui hết đâu


<<

Filename: 79324_oo.lsp
Tác giả: M@trixs
Bài viết gốc: 162508
Tên lệnh: oo
Lệnh offset đặc biệt

Không khó khăn lắm :) Của bạn đây. Chúc bạn vui vẻ

(defun c:oo (/ ss objlst dist entlst1 entlst2 kwrd)
(grtext -1 "Free from...
>>

Không khó khăn lắm :) Của bạn đây. Chúc bạn vui vẻ

(defun c:oo (/ ss objlst dist entlst1 entlst2 kwrd)
(grtext -1 "Free from CADviet @ketxu")
(setq dist (getdist "\nKhoang cach offset: "))
(princ "\nChon doi tuong offset ")
(setq ss (ssget '((0 . "LWPOLYLINE,LINE,ARC,CIRCLE,ELLIPSE,SPLINE"))))
(if ss
(progn
(setq objlst (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
(initget (+ 2 4) "Yes No")
(setq kwrd (getkword "\nXoa doi tuong goc hay khong  : "))
(if (null kwrd)
(setq kwrd "No")
)
(foreach obj objlst
(vla-offset obj dist)
(setq entlst1 (cons (vlax-ename->vla-object (entlast)) entlst1)) 
(vla-offset obj (* dist -1))
(setq entlst2 (cons (vlax-ename->vla-object (entlast)) entlst2))
(mapcar '(lambda (x) (vla-put-layer x (getvar "clayer"))) entlst1)
(mapcar '(lambda (x) (vla-put-layer x (getvar "clayer"))) entlst2)
(if (eq kwrd "Yes")
(vla-erase obj)
)
)
)
)
(princ)
)

 

Lệnh này hay quá..... Nhưng có ai giúp mình thêm dòng code cho nó ghi nhớ giá trị Ofset mình vừa nhập không ???

 

Giúp mình với nhé, mình nghĩ chắc nhiều người cũng cần. Chân thành cảm ơn !!


<<

Filename: 162508_oo.lsp
Tác giả: Tue_NV
Bài viết gốc: 57293
Tên lệnh: scissors
Cad có lênh này không?

* Với AutoCAD thì dùng Break at point có trên thanh Modify:

+ Chọn đối tượng

+ Chọn giao điểm

* Với LISP:

+ Lệnh SCISSORS

+...

>>
* Với AutoCAD thì dùng Break at point có trên thanh Modify:

+ Chọn đối tượng

+ Chọn giao điểm

* Với LISP:

+ Lệnh SCISSORS

+ Chọn giao điểm

+ Chọn đối tượng

(Bác nào có thể giúp sửa Lisp này để có thể select được nhiều đối tượng. Thx)

Lisp sưu tầm:

(defun C:SCISSORS( / pt1 bpt1 bpt2 ss1 dist1 ent1 centrecercle)
 ;;make it quiet
 (setvar "cmdecho" 0)

 ;;first, get the breaking point
 (setq pt1 (getpoint "Give me the break point... ")) ;;point where to break

 ;;now, check if there's more than one object under that point
 (setq ss1 (selectfrompoint pt1))

 ;;if there's more than 1 object under point, ask to select, else use existing point
 (if (> (sslength ss1) 1)
  (progn ;;then
  (princ "DISAMBIGUATION : pick the object to break...")
  (setq ent1 (entsel))
  (setq ent1n (car ent1)) ;; e-name of ent1
  (setq bpt1 (cadr ent1)) ;; point on ent to break
  )
  (progn ;;else
  (setq ent1n (ssname ss1 0));;store into an entity (can be useful further)
  (setq bpt1 pt1) ;; point on ent to break
  )
 )

 ;;but if it's a circle (thus usually unbreakable)...
 (if
   (= (cdr (assoc 0 (entget ent1n))) "CIRCLE")
   ;;then replace the circle by 2 arcs joining at the break point
   (progn
    (princ "It's a circle !")
    (setq centrecercle (cdr (assoc 10 (entget ent1n))))
    (command "_arc" "_c" centrecercle pt1 "_a" "180")
    (command "_arc" "_c" centrecercle pt1 "_a" "-180")
    (entdel ent1n)
   )
   ;;else perform a normal break
   (progn
   (command "_break" bpt1 "_f" pt1 pt1)
   )
)

 ;;restore cmdecho
 (setvar "cmdecho" 1)
 ;;end quietly
 (princ)
)

;;--- this function makes a selection set of entities beneath a point 
(defun selectfrompoint (bpt1 / dist1 ss1)
 (setq dist1 (/ (getvar "viewsize") 200)) ;; set a distance equal to 1/200-th of view height
 (setq ss1 ;;select by fence around point
  (ssget "_F"
   (list
   (list (+ (car bpt1) dist1) (+ (cadr bpt1) dist1) 0)
   (list (- (car bpt1) dist1) (- (cadr bpt1) dist1) 0)
   )
  )
 );; setq ss1
 ss1
)

Đây là Lisp Tue_nv đã viết và chỉnh sửa lại một chút :

- Lệnh Brt

- Chọn đường cắt bằng cách chọn 2 điểm

- Chọn đối tượng

- Lisp sẽ break tại điểm giao của đường cắt với đối tượng

Giống như cách chọn đối tượng theo kiểu F(Fence)

(Defun c:brt(/ aL bL cL dL eL sL ss n i)
(vl-load-com) 
(prompt "\n Chon duong cat bang cach chon diem thu nhat va diem thu hai :")
(setq aL (getpoint "\n Chon diem thu nhat :"))
(setq bL (getpoint aL "\n Chon diem thu hai :"))

(Prompt "\n Chon doi tuong Line can break tai 1 diem :")
(Setq ss (ssget '((0 . "LINE,LWPOLYLINE"))))
(Setq n (sslength ss) 
i 0)
(while ((setq sL (ssname ss i))
(setq cL (vlax-curve-getStartPoint sL))
(setq dL (vlax-curve-getEndPoint sL))

(setq eL (inters aL bL cL dL T))

(if (= eL nil) (setq i (1+ i)))
(if (/= eL nil) 
(progn
(Command "_Break" sL eL "@")
(setq i (1+ i))
)
)
)
(sssetfirst ss ss)
(Princ)
)

Các bạn có thể tham khoả thêm bài viết : Hoi ve lenh Break

Chúc thành công :(


<<

Filename: 57293_scissors.lsp
Tác giả: angelofmine
Bài viết gốc: 190977
Tên lệnh: pl2
lisp kết hợp PL & UCS

Bạn đã biết vì sao bài của bạn bị mod xoá rồi ư?

Đây là lisp cho bạn (chú ý kích thước trên bản vẽ khác kết quả dim...

>>

Bạn đã biết vì sao bài của bạn bị mod xoá rồi ư?

Đây là lisp cho bạn (chú ý kích thước trên bản vẽ khác kết quả dim nhé)

(defun C:PL2( / p1 len p2)
(initget 1) (setq p1 (getpoint "\nChon diem bat dau: "))
(setq len (atof (cdr (assoc 1 (entget (car (entsel "\nChon Text de lay chieu dai: ")))))))
(setq p2 (polar p1 (/ pi -2) len))
(entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))
(acet-sysvar-set (list "osmode" 0 "cmdecho" 0))
(command "ucs" p2 "")
(acet-sysvar-restore)
(command "pline"))
;----- CHU Y: Gia tri dim tren ban ve cho thay: muon co ket qua dung can phai nhan/chia chieu dai cho 1 he so.

 

Trước hết cảm ơn Bác đã giành thời gian giúp em.

Em chạy lisp của bác nhưng nó báo lỗi:

 

 

Command: pl2

 

Chon diem bat dau:

Chon Text de lay chieu dai: ; error: no function definition: ACET-SYSVAR-SET

Bác xem lại giúp em


<<

Filename: 190977_pl2.lsp
Tác giả: proconeng86
Bài viết gốc: 297086
Tên lệnh: tmp
lisp tính tổng số đai trong dim

 

Sửa thêm:

 

(defun c:tmp()
  (defun GeD(v / l en)
    (setq l nil)
    (vlax-for item (vla-item...
>>

 

Sửa thêm:

 

(defun c:tmp()
  (defun GeD(v / l en)
    (setq l nil)
    (vlax-for item (vla-item (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object)))
    (cdr (assoc 2 (entget v))))
      (if (= "MTEXT" (cdr (assoc 0 (entget (setq en (vlax-vla-object->ename item))))))
(setq l en))
    ) l
  )
  (Prompt "\nChon Dim:")
  (setq l nil)
  (foreach x (acet-ss-to-list (ssget '((0 . "DIMENSION"))))
    (setq txt  (cdr (assoc 1 (entget (Ged x))))
 sl (atoi (substr txt (+ 2 (vl-string-search "[" txt))
  (- (vl-string-search "%" txt) (vl-string-search "[" txt) 1)))
 fi (atoi (substr txt (+ 4 (vl-string-search "%" txt))
  (- (vl-string-search "a" txt) (vl-string-search "%" txt) 3)))
 l (if (not (assoc fi l))
     (cons (cons fi sl) l)
     (subst (cons fi (+ sl (cdr (assoc fi l)))) (assoc fi l) l)))
  )
  (setq st "")
  (foreach x l (setq st (strcat st "\n" (itoa (cdr x)) (chr 216) (itoa (car x)))))
  (alert st)
  (princ)
)
 

 

Lisp này là chuẩn rồi. Cám ơn bạn Tot77 nhiều nhé  :)  :)  :)


<<

Filename: 297086_tmp.lsp
Tác giả: hugo75
Bài viết gốc: 159188
Tên lệnh: sline
Lisp vẽ Pline mũi tên 2 đầu

Lâu lâu rồi thấy có bác nào hỏi cái này, hôm nay e lục trong máy thấy có, post lên cho bác nào cần dùng.

P/S : tối thiểu vào 3 điểm...

>>

Lâu lâu rồi thấy có bác nào hỏi cái này, hôm nay e lục trong máy thấy có, post lên cho bác nào cần dùng.

P/S : tối thiểu vào 3 điểm nhé ^^

Untitled.jpg

(defun c:sline (/ loop p1 p2)   
 (grtext -1 "Free from Cadviet.com @Ketxu")
 (if (not asize) (setq asize 1))      
 (if (not PThk)  (setq PThk 0.01))                 
 (defun GETR (val msg / tm)
   (setq tm (getreal (strcat msg " <" (rtos val 2 4) ">: ")))
   (cond ((= (type tm) 'REAL) (eval tm))
         ((= tm nil) (eval val))
         (t (princ "\007 *error* Nh\U+1EADp sai lo\U+1EA1i d\U+1EEF li\U+1EC7u") (eval val)) ) )
 (defun loop ()
   (cond ((setq p2 (getpoint p1 "\n\U+0110i\U+1EC3m ti\U+1EBFp theo : ")) (command p2) 
                                    (setq p0 p1) (setq p1 p2) (loop))
         ( t (command "u" (polar p1 (angle p1 p0) asize)
                      "w" (/ asize 3) 0.0 p1 ""))))
 (setq asize (getr asize "\nK\U+00EDch th\U+01B0\U+1EDBc m\U+0169i t\U+00EAn :"))
 (setq PThk  (getr PThk "\n B\U+1EC1 r\U+1ED9ng PLine :"))
 (setq p1 (getpoint "\n\U+0110i\U+1EC3m b\U+1EAFt \U+0111\U+1EA7u : "))
 (command "pline" p1 "w" 0.0 0.0)
 (setq p2 (getpoint p1 "\n\U+0110i\U+1EC3m ti\U+1EBFp theo : "))
 (command "w" 0.0 (/ asize 3) (polar p1 (angle p1 p2) asize) 
          "w" PThk PThk p2)
 (setq p1 p2)
 (loop)  
 (eval "Done")
)

Nhờ bác thêm giùm chức năng nếu các điểm tiếp theo nằm trên cùng đường thẳng thì tại mỗi điểm khi ta click thì sẽ vẽ 1 vòng tròn đường kính bằng 50.

Còn các điểm tiếp theo không nằm trên đường thẳng thì không có vòng tròn này.Cảm ơn bác nhiều.


<<

Filename: 159188_sline.lsp
Tác giả: hiepga123
Bài viết gốc: 244129
Tên lệnh: ha
lisp chia đoạn thẳng không bằng nhau(theo yêu cầu người dùng)

 

Lisp đây!

 

;; Cat Line thanh tung doan do user nhap vao. Vi du: Line dai 1000 thi nhap vao...
>>

 

Lisp đây!

 

;; Cat Line thanh tung doan do user nhap vao. Vi du: Line dai 1000 thi nhap vao 100,300,250,350. 
;; Chi break khi tong cac doan bang chieu dai cua line. Thu tu break theo thu tu ve line.
;; Doan Van Ha - CadViet.com - ngay 4/8/2013.
(defun C:HA ( / ent str lst pd pc goc pt i HA:Break1 #String->List)
 (vl-load-com) (command "undo" "be") (setq cmd (getvar 'cmdecho) osm (getvar 'osmode))
 (defun HA:Break1 (ent pt Gap / pt1)
  (setq pt1 (vlax-curve-getPointAtDist ent (+ (vlax-curve-getdistatparam ent (vlax-curve-getparamatpoint ent (vlax-curve-getclosestpointto ent pt))) Gap)))
  (command "._break" ent "_non" pt "_non" pt1))
 (defun #String->List (txt / n)
  (while (setq n (vl-string-search "," txt))
   (setq txt (strcat (substr txt 1 n) " " (substr txt (+ 2 n)))))
  (setq lst (read (strcat "(" txt ")"))))
 (setq ent (car (entsel "\nChon Line can chia: ")))
 (setq str (getstring "\nNhap cac khoang cach (vi du: 100,300,250,350): "))
 (if (equal (apply '+ (setq lst (#String->List str))) (vla-get-length (vlax-ename->vla-object ent)) 1E-8)
  (progn
   (setvar 'cmdecho 0) (setvar 'osmode 0)
   (setq pd (cdr (assoc 10 (entget ent)))
         pc (cdr (assoc 11 (entget ent)))
    goc (angle pd pc)
    pt (polar pd goc (car lst))
i 0)
   (repeat (1- (length lst)) 
    (HA:Break1 ent pt 0.)
(setq ent (entlast)
     pt (polar pt goc (nth (setq i (1+ i)) lst))))))
 (setvar 'cmdecho 0) (setvar 'osmode 0) (command "undo" "e"))
 

chia giả và hiện các dấu hoa thị tại các điểm chia dc k Bác!

cảm ơn Bác nhiều


<<

Filename: 244129_ha.lsp
Tác giả: Tue_NV
Bài viết gốc: 236275
Tên lệnh: ha
Lệnh Trim mở rộng

Xuất phát từ nhu cầu Trim cần có nhiều lựa chọn hơn nữa so với lệnh Trim gốc của Cad, tôi viết lisp này để phục vụ bà con...

>>

Xuất phát từ nhu cầu Trim cần có nhiều lựa chọn hơn nữa so với lệnh Trim gốc của Cad, tôi viết lisp này để phục vụ bà con lối xóm.

...........................

;Co 3 kieu Trim:
;1). Trim theo Phia: pick diem phia nao thi Trim phia do (tuong tu offset).
;2). Trim doan Ngan: Trim phan ngan.
;3). Trim doan Dai: Trim phan dai.
;Khong Trim cac truong hop: doi tuong la duong kin; giao nhau tai hon 1 diem; giao nhau bieu kien.
(defun C:HA( / ent0 ent ent2 ss typ p ento lstg len1 len2)
 (vl-load-com) (command "undo" "be") (setq cmd (getvar "cmdecho")) (setvar "cmdecho" 0)
 (if
  (and
   (setq ent0 (car (entsel "\nChon 1 doi tuong dao cat: ")))
   (princ "\nChon cac doi tuong bi cat...")
   (setq ss (ssget '((0 . "Line,Polyline,Lwpolyline,Spline,Arc")))))
  (progn
   (initget "P N D")
   (setq typ (getkword "\nChon kieu Trim <P>: "))
   (if (not typ) (setq typ "P"))
   (if (= typ "P")
    (progn
(initget 65)
     (setq p (getdist (GetP (vlax-curve-getStartPoint ent0) (vlax-curve-getEndPoint ent0) (/ (HA:LenCur ent0) 2) ent0) "\nPick chon phia can Trim: "))
     (command "offset" 1E-3 ent0 p "")
     (setq ento (entlast))))
   (foreach ent1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    (setq lstg (HA:Giao (vlax-ename->vla-object ent0) (vlax-ename->vla-object ent1) acExtendNone))
    (if (and (= (length lstg) 1) (not (equal (car lstg) (vlax-curve-getStartPoint ent1) 1E-3)) (not (equal (car lstg) (vlax-curve-getEndPoint ent1) 1E-3)))
     (progn
      (setq ent (entlast))
      (command ".break" ent1 "_non" (car lstg) "_non" (car lstg))
      (setq ent2 (car (HA:GetNewEnts ent)))
      (setq len1 (HA:LenCur ent1) len2 (HA:LenCur ent2))
      (cond
       ((or (and (= typ "N") (> len1 len2)) (and (= typ "D") (< len1 len2))) (entdel ent2))
  ((or (and (= typ "N") (< len1 len2)) (and (= typ "D") (> len1 len2))) (entdel ent1))
       ((= typ "P")
        (if (HA:Giao (vlax-ename->vla-object ento) (vlax-ename->vla-object ent1) acExtendNone)
    (entdel ent1)
    (entdel ent2)))))))
   (if ento (entdel ento))))
 (command "undo" "e") (setvar "cmdecho" cmd) (princ))
(defun GetP (pg ph kc cur / dg dh dp)
 (setq dg (vlax-curve-getDistAtPoint cur pg))
 (setq dh (vlax-curve-getDistAtPoint cur ph))
 (if (> dh dg)
  (setq dp (+ dg kc))
  (setq dp (- dg kc)))
 (vlax-curve-getPointAtDist cur dp))
(defun HA:GetNewEnts (ename / new) (while (setq ename (entnext ename)) (if (entget ename) (setq new (cons ename new)))) new)
(defun HA:LenCur(ent)
 (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))
(defun HA:Giao(obj1 obj2 mode / l r)
 (setq l (vlax-invoke obj1 'intersectwith obj2 mode))
 (repeat (/ (length l) 3)
  (setq r (cons (list (car l) (cadr l) (caddr l)) r) l (cdddr l)))
 r)
 

 

Hàm này : (defun HA:GetNewEnts (ename / new) (while (setq ename (entnext ename)) (if (entget ename) (setq new (cons ename new)))) new)

gặp (setq ss (ssget '((0 . "Line,Polyline,Lwpolyline,Spline,Arc")))))

bởi "entnext" của POLYLINE ra Vertext. 

nên thay, nên thay -> Nếu gặp đối tượng là POLYLINE:  Lisp sẽ lỗi ngay.............. 


<<

Filename: 236275_ha.lsp
Tác giả: Tue_NV
Bài viết gốc: 129266
Tên lệnh: cht
lisp thay đổi cỡ chữ hàng loạt trong bản vẽ
Lệnh là Qselect bạn ạ.Yêu cầu của chi_pheo k biết là đổi tất cả, đổi theo style, hay đổi theo text chọn :s_big:.

Nếu chọn text trên màn hình thì có thể dùng cách bác...

>>
Lệnh là Qselect bạn ạ.Yêu cầu của chi_pheo k biết là đổi tất cả, đổi theo style, hay đổi theo text chọn :s_big:.

Nếu chọn text trên màn hình thì có thể dùng cách bác Tuệ nói, hoặc :

;free lisp from cadviet.com @ ketxu
(defun c:cht()	
(setq newhyt (getreal "Nhap chieu cao : "))
(if (= newhyt nil) (setq newhyt (getvar "TEXTSIZE")))
(setq sset1 (ssget (list (cons 0 "TEXT"))))
(setq counter 0)
(repeat (sslength sset1)
	(setq txt (ssname sset1 counter))
	(setq txtdata (entget txt))		
	(setq hyt (assoc 40 txtdata))		
	(setq txtdata (subst (cons 40 newhyt) hyt txtdata))		
	(entmod txtdata)
	(entupd txt)		
	(setq counter (1+ counter))
)
)

Yêu cầu của chi_pheo k biết là đổi tất cả, đổi theo style, hay đổi theo text chọn :).

Reply: Cái này đâu cần phải sử dụng Lisp nhỉ?

Đổi theo kiểu gì chăng nữa thì chỉ 1 lệnh Scaletext là xong

 

Các pro à! Có lệnh viết tắt ko? Chứ viết dài thế thì nhập lệnh lâu lắm. mà có lúc còn viết sai nữa chứ. Mà ko có lệnh tắt thì muốn thay đổi để có lệnh tắt thì phải thay đổi ở đâu ạh!

Bạn vào Tool->Customize -> vào Edit Program Parameter (acad.pgp) để tạo lệnh tắt

Cách làm : 1 số bài viết đã trình bày trên Diễn đàn. Bạn chịu khó tìm kiếm nhé


<<

Filename: 129266_cht.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 231753
Tên lệnh: kk
nhờ viết lisp gán cao độ cho đường đồng mức và ghi ra text

 

Lisp sửa theo yêu cầu của bạn đây:

 

Lisp sửa theo yêu cầu của bạn đây: http://www.cadviet.com/upfiles/3/71162_21lisp_gan_cao_do_cho_pline_va_ghi_ra_text_rev1.lsp

Ghóp ý thêm một chút nhé:

1. Trong bản vẽ thường cỡ chữ dùng để ghi chú đồng mức được cố định nên bạn chỉ nhập lần đầu thôi, còn từ lần thứ 2 trở đi thì không cần phải nhập nữa. Nếu cỡ chữ thay đổi liên tục (cái này hơi hiếm) thì bạn cho mình biết để sửa lại code.

2. Khi bạn chọn điểm chèn thì không nhất thiết phải chọn chính xác vị trí trên đường đồng mức cần ghi. Cứ chọn gần đó thôi và Lisp sẽ ghi Text vào đường đồng mức gần nhất với khoảng cách bằng 1/2 cao chữ. Và để tránh trường hợp chữ ngược chữ xuôi theo hướng đi của đường đồng mức thì mình đặt Text luôn luôn ở bên phải của đường đồng mức và xoay chữ sao cho không bị ngược trên bản vẽ chuẩn North Up.

3. Thêm 1 tính năng nữa đó là tự động tính bước nhảy của đường đồng mức giữa 2 lần nhập liên tiếp. Ví dụ lần đầu tiên bạn nhập cao độ đường đồng mức là 2, lần thứ hai là 4 thì từ lần thứ 3 trở đi Lisp sẽ tự động điền giá trị độ cao là 6, 8, 10 .... vào ô nhập. Đồng ý thì chỉ việc nhấn OK, không thì nhập giá trị khác. Tuy nhiên nếu bạn thao tác một cách có quy luật thì không phải mất công nhập số từ bàn phím nhiều lần.

;GAN CAO DO CHO DUONG DONG MUC VA GHI RA TEXT
;=======KANGKUNG 14/04/2013 - REV1===========
(defun C:kk( / i index pt pt1 pt2 taphop lst huong)
  (command "UNDO" "BE")
  (setq os(getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setq taphop (ssget '((0 . "POLYLINE,LWPOLYLINE"))))
  (if (and (/= docao nil) (= (length list_caodo) 2))
    (setq docao(read(lisped (rtos (+ (- (nth 1 list_caodo) (nth 0 list_caodo)) docao) 2 2))))
    (if (/= docao nil)
      (setq docao(read(lisped (rtos docao 2 2))))
      (setq docao(read(lisped "Nhap do cao duong dong muc vao day")))
      )
    )
  (if (< (length list_caodo) 2)
    (setq list_caodo(append list_caodo (list docao)))
    (setq list_caodo(append (list (nth 1 list_caodo)) (list docao)))
    )
  (if (= Height nil)
    (setq Height(read(lisped "Nhap cao chu vao day")))
    )
  (setq index 0)
  (while (< index (sslength taphop))
    (vla-put-elevation (vlax-ename->vla-object (ssname taphop index)) docao)
    (vla-put-color (vlax-ename->vla-object (ssname taphop index)) 2)
    (setq index (1+ index))
    )
  (while (setq pt(getpoint "\n Pick diem chen TEXT: " ))
    (huongtext)
    (entmake (list '(0 . "TEXT") (cons 10 pt2) (cons 40 Height) (cons 1 (rtos docao 2 2)) (cons 50 huong)))
    )
  (setvar "OSMODE" os)
  (command "UNDO" "END")
  (princ)
  )
(defun huongtext()
  (setq i 0)
  (setq lst(list))
  (while (< i (sslength taphop))
    (setq dt(ssname taphop i))
    (setq pt1(vlax-curve-getClosestPointTo dt pt))
    (if (and (<= pi (angle pt1 pt)) (<= (angle pt1 pt) (* 2 pi)))
      (setq pt2(polar pt1 (angle pt pt1) (/ Height 2)))
      (setq pt2(polar pt1 (angle pt1 pt) (/ Height 2)))
      )
    (if (= (vlax-curve-getDistAtPoint dt (vlax-curve-getClosestPointTo dt pt)) (vla-get-length (vlax-ename->vla-object dt)))
      (setq huong(angle ( vlax-curve-getPointAtDist dt (+ (vlax-curve-getDistAtPoint dt (vlax-curve-getClosestPointTo dt pt)) -0.001)) (vlax-curve-getClosestPointTo dt pt) ))
      (setq huong(angle (vlax-curve-getClosestPointTo dt pt) ( vlax-curve-getPointAtDist dt (+ (vlax-curve-getDistAtPoint dt (vlax-curve-getClosestPointTo dt pt)) 0.001))))
      )
    (if (and (> huong (/ pi 2)) (< huong (/ (* 3 pi) 2))) (setq huong(- huong pi)))
    (setq lst(append lst (list (list (distance pt pt1) huong pt2))))
    (setq i(1+ i))
    )
  (setq lst(vl-sort lst '(lambda (e1 e2) (< (car e1) (car e2)))))
  (setq huong(cadr(nth 0 lst)))
  (setq pt2(caddr(nth 0 lst)))
  )
(princ "\n              KangKung - 14/04/2013\n")
(princ "\n           Nhap KK de chay chuong trinh\n")

Hề hề hề,

Bác KangKung cho hỏi thăm đường một chút.

Cái hàm (lisped .....) này có thể tham khảo ở đâu ạ.?? Mình tìm hoài trong help và help developer đều không thấy. mặc dầu khi xài thì thấy nó giống như cái lệng ddedit nhưng chưa hiểu rõ về nó lắm. Rất mong bác giải thích thêm. Xin chân thành cám ơn.


<<

Filename: 231753_kk.lsp
Tác giả: tinya1225
Bài viết gốc: 142389
Tên lệnh: tl
Đo kích thước nhiều line

Bùm bùm em xin đưa ra 1 lsp có trên diễn đàn để tính chiều dài các thể loại

(defun Length1(e) (vlax-curve-getDistAtParam...
>>

Bùm bùm em xin đưa ra 1 lsp có trên diễn đàn để tính chiều dài các thể loại

(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
;;;--------------------------------------------------------------------
(defun C:TL( / ss L e)
(setq
ss (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))
L 0.0
)
(vl-load-com)
(while (setq e (ssname ss 0))
(setq L (+ L (length1 e)))
(ssdel e ss)
)
(alert (strcat "Total length = " (rtos L)))
)

Tên lệnh TL

ngon quá. Thanks bạn rùi nhé ^^. cố gắng phát huy nha.


<<

Filename: 142389_tl.lsp
Tác giả: saycaphe
Bài viết gốc: 202825
Tên lệnh: ha
Xin lisp xuất toàn bộ text trong bản vẽ vào file text

Lisp xuất toàn bộ Text/Mtext trên bản vẽ ra file txt cùng tên với bản vẽ.

;Doan Van Ha - CADViet.com - Ngay...
>>

Lisp xuất toàn bộ Text/Mtext trên bản vẽ ra file txt cùng tên với bản vẽ.

;Doan Van Ha - CADViet.com - Ngay 13/6/2012
;Muc dich: Xuat tat ca *Text tren ban ve ra file txt cung ten voi ban ve.
(defun C:HA( / lst fn pw)
(princ "\Chon cac Text/Mtext can xuat ra file...")
(setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "*TEXT")))))))
(setq fn (strcat (getvar "dwgprefix") (vl-string-subst "txt" "dwg" (getvar "dwgname"))))
(setq pw (open fn "w"))
(foreach ent lst
 (write-line (cdr (assoc 1 (entget ent))) pw))
(close pw)
(princ))

Cảm ơn bác nhiều lắm :D


<<

Filename: 202825_ha.lsp
Tác giả: cungkeng
Bài viết gốc: 77951
Tên lệnh: ft
Lisp căn lề text: Left, Center, Right và Fit (giống word)
Trước đây mình có thấy trong diễn đàn đã cung cấp công cụ căn lề text theo 3 kiểu Left, Center, Right. Tuy nhiên công cụ này ko viết bằng autolisp và chỉ chạy...
>>
Trước đây mình có thấy trong diễn đàn đã cung cấp công cụ căn lề text theo 3 kiểu Left, Center, Right. Tuy nhiên công cụ này ko viết bằng autolisp và chỉ chạy được các bản cad 2004, 2005 và 2006 nên mình viết một lisp tương tự để chạy được trên tất cả các bản cad.

- Lisp yêu cầu chọn tất cả các text (Dtext va MText) cần căn lề.

- Chọn một text làm chuẩn để căn lề các text đã chọn theo text đó

- Ngoài chức năng căn lề theo 3 vị trí. Left, Center, Right thì lisp này cung cấp thêm chức năng căn lề theo kiểu Fit, - kéo dãn các dòng cho dài bằng nhau (giống word) và dài bằng text chọn làm chuẩn.

canletxt.jpg

(defun c:ft()
(command "undo" "begin")
(setq oldos (getvar "osmode"))
(setq olcol (getvar "CEColor"))
(setq olstyle (getvar "textstyle"))
(prompt "\nchon cac text can can le ...")
(setq txt (ssget '((0 . "*TEXT"))))
(setq mau (entget (car (entsel "\nChon text chuan"))))
(setq TB  (textbox mau) LC  (car TB) RC (cadr TB) di (distance LC RC) i 0)
(setq x1 (cdr(assoc 10 mau)))
(setq x2 (list (+ (car x1) (* di 0.5)) (cadr x1)))
(setq x3 (list (+ (car x1) di) (cadr x1)))
(setq canle (cond (canle) ("Left")))
(initget "Left Center Right Fit")
(setq canle (cond ((getkword (strcat "\Vi tri can le <" canle ">"))) (canle)))
(repeat (sslength txt)
(setq txt_ent (entget (ssname txt i)))
(setq txt_val (cdr(assoc 1 txt_ent)))
(setq txt_st (cdr(assoc 7 txt_ent)))
(setq txt_lay (cdr(assoc 8 txt_ent)))
(setq txt_h (cdr(assoc 40 txt_ent)))
(setq txt_fctr (cdr(assoc 41 txt_ent)))
(setq txt_clr (cdr(assoc 62 txt_ent)))
(setq y1 (cdr(assoc 10 txt_ent)))
(if (cdr(assoc 43 txt_ent)) (setq txt_fctr 1 y1 (list (car y1) (- (cadr y1) txt_h))))
(setq pt1 (list (car x1) (cadr y1)))
(setq pt2 (list (car x2) (cadr y1)))
(setq pt3 (list (car x3) (cadr y1)))
(command "-style" txt_st "" "" txt_fctr "" "" "" "" "clayer" txt_lay "color" txt_clr "osmode" 0)
(if (eq canle "Left") (command "text" pt1 txt_h 0 txt_val))
(if (eq canle "Center") (command "text" "C" pt2 txt_h 0 txt_val))
(if (eq canle "Right") (command "text" "R" pt3 txt_h 0 txt_val))
(if (eq canle "Fit") (command "text" "F" pt1 pt3 txt_h txt_val))
(setq i (+ i 1))
(command "color" "bylayer")
);repeat
(setvar "textstyle" olstyle)
(setvar "CECOLOR" olcol)
(setvar "osmode" oldos)
(command "erase" txt "")
(prompt"\n by Thaistreetz - huuthais@yahoo.com\n")
(command "undo" "end")
);defun

Hiện tại thì mình đã khá hài lòng với lisp này nếu chỉ dùng để căn lề text. Tuy nhiên mình muốn thêm cho nó chức năng giãn dòng cho đều cũng với cách nhập số liệu như trên nhưng đang mắc về thuật giải. Xin nhờ mọi người giúp mình hoàn thiện lisp này với.

 

Edit: đã fix lỗi


<<

Filename: 77951_ft.lsp
Tác giả: tuannguyen314169
Bài viết gốc: 48993
Tên lệnh: c2p
Chia đất!!!
Bài toán của anh có thể giải quyết bằng lisp "chia đất" này. Trình tự thực hiện như sau, tham khảo file ssg đã chạy ví dụ:

 

>>
Bài toán của anh có thể giải quyết bằng lisp "chia đất" này. Trình tự thực hiện như sau, tham khảo file ssg đã chạy ví dụ:

 

http://www.cadviet.com/upfiles/TinhDT159B.zip

 

1. Là hình nguyên thuỷ theo bản vẽ của anh

 

2. Copy 1/2 hình, dùng lisp ConvertToPline (cái này ssg đã post ở đâu đó rồi, tiện thể post lại ở đây), lệnh C2P. Khi chương trình hỏi "Delete source object? Y/N" thì chọn "Y", xoá luôn cái spline cho đỡ lằng nhằng!

;;;***********************************************************
;;;CONVERT TO PLINES PROGRAM WITH FULL COMMENTS!
;;;Convert all objects: Line, Pline, Spline, Arc, Circle, Ellipse_
;;;to Plines. Length of 1 segment is specified by user
;;;Copy & Paste to Notepad, Saveas *.lsp, Appload then Type C2P to run
;;;Happy New Year 2008!
;;;Written by ssg - January 2008 - www.cadviet.com 
;;;***********************************************************

;;;-------------------------------------------------------------
(defun makepl ( e d1 / ps pe d d2 p2) ;;;Make pline along curve e. Length of 1 segment = d1
(vl-load-com) ;;;Load Visual LISP extensions before use vlax-xxxx functions
(setq
   ps (vlax-curve-getStartPoint e) ;;;Start point
   pe (vlax-curve-getEndPoint e) ;;;End point
   d (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)) ;;;Length of curve e
   d2 d1 ;;;Init variable distance
)
(command "pline") ;;;Call pline command
(command ps) ;;;Start point
(while (<= d2 d) ;;;While not over end point pe
   (setq p2 (vlax-curve-getPointAtDist e d2)) ;;;Variable point at d2 = length along curve
   (command p2) ;;;Continue pline command from current point to p2
   (setq d2 (+ d2 d1)) ;;;Increase distance d2 by d1
) ;;;End while
(command pe "") ;;;Pline to pe and finish command
)
;;;-------------------------------------------------------------
(defun C:C2P( / d1 ss oldos i e ans) ;;;Convert to Plines
(if (not d0) (setq d0 0.5)) ;;;Init dividual distance, global variable
(setq d1 (getreal (strcat "\nLength of 1 segment <" (rtos d0) ">:"))) ;;;Input distance
(if d1 (setq d0 d1) (setq d1 d0)) ;;;Reset or get distance
(setq
   ss (ssget '((0 . "LINE,LWPOLYLINE,SPLINE,ARC,CIRCLE,ELLIPSE"))) ;;;Selection set
   oldos (getvar "osmode") ;;;Save osmode
   i 0 ;;;Init counter
)
(setvar "osmode" 0) ;;;Disable osmode
(repeat (sslength ss) ;;;Repeat for all entities in ss
   (setq e (ssname ss i)) ;;;Set e for entity with ordinal i in selection set ss
   (makepl e d1) ;;;Use makepl function. Make pline along e
   (setq i (1+ i)) ;;;Increase counter
)
(initget "Y N") ;;;Init keywords
(setq ans (getkword "\nDelete source objects?  :")) ;;;Get answer from user
(if (= ans "Y") (command "erase" ss "")) ;;;Erase source objects if ans = "y" or "Y"
(setvar "osmode" oldos) ;;;Reset osmode
(princ) ;;;Silent quit
)
;;;-------------------------------------------------------------

Thực hiện lần lượt cho 2 spline. Kết quả: 2 đường spline biến thành 2 pline riêng biệt

 

3. Lấy đối xứng, gọi lệnh Pedit với tuỳ chọn j (joint) -> toàn bộ thành 1 pline khép kín duy nhất. Tính được:

- Diện tích toàn phần S = 1286.9223

- Diện tích giới hạn bởi đường y=18 (không phải y=23.5 như anh đã nêu, có lẽ nhầm?): S1 = 915.9525

- Hệ số k = S1/S = 0.711739

 

4. Vẽ 1 line có góc nghiêng tuỳ ý, cắt pline kín ở 2 điểm, dùng cái lisp "chia đất" (lisp đầu tiên của topic này), chạy lệnh DL.

Đường chia dừng lại ở vị trí có S1 = 915.9528 -> sai số rất nhỏ so với các tính toán kỹ thuật thông thường

 

Tương tự như vậy, anh có thể thực hiện với nhiều đường chia có góc nghiêng theo ý muốn.

Đúng là y=18 (mớn nước)chứ không phải y=23.5 (mép boong). nhưng S1=916.0026 chứ không phải là 915.9528 ssg xem lại giúp mình. Cảm ơn


<<

Filename: 48993_c2p.lsp
Tác giả: kienccs
Bài viết gốc: 419282
Tên lệnh: sw
Hoán đổi vị trí hai đối tượng cho nhau

Lệnh là SW:

 

(defun c:sw()
(princ "\nChon doi tuong 1: ")
(setq ss1 (ssget)
p1 (getpoint "\nDiem chuan...
>>

Lệnh là SW:

 

(defun c:sw()
(princ "\nChon doi tuong 1: ")
(setq ss1 (ssget)
p1 (getpoint "\nDiem chuan 1")
)
(princ "\nChon doi tuong 2: ")
(setq ss2 (ssget)
p2 (getpoint "\nDiem chuan 2")
)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(command ".move" ss1 "" p1 p2)
(command ".move" ss2 "" p2 p1)
(setvar "osmode" oldos)
(princ)
)

Em muốn hoán đổi vị trí 2 text cho nhau, dùng lệnh này cũng đc nhưng phải làm nhièu thao tác qua,mà em cần phải hoán đổi vị trí text rất nhiều. Em muốn chỉ cần chon 2 text là nó tự chuyển vị trí cho nhau. Bac nào có thể sửa lại cho em đc không?Cam ơn các bác!!


<<

Filename: 419282_sw.lsp

Trang 243/330

243