Jump to content
InfoFile
Tác giả: Tot77
Bài viết gốc: 295879
Tên lệnh: ist
viết chữ theo đường thẳng bất kỳ bằng auto Lisp

Các bác cứ réo bác HA làm chi, lisp này có từ năm 2009, bác HA có "phê" thêm năm 2012, từ đó tới giờ chẳng ai đụng tới nữa.

Bác HA có vẻ không thích sửa lisp của người khác, thôi thì tôi sửa dùm cho các bác "làm phước" vậy.

(defun c:ist(/ chu os ent obj ndai p1 p2 pm ang caoc)
  (setq chu (getstring t "Chen chu :")
caoc (getreal (strcat "\nCao chu <" (rtos (getvar...
>>

Các bác cứ réo bác HA làm chi, lisp này có từ năm 2009, bác HA có "phê" thêm năm 2012, từ đó tới giờ chẳng ai đụng tới nữa.

Bác HA có vẻ không thích sửa lisp của người khác, thôi thì tôi sửa dùm cho các bác "làm phước" vậy.

(defun c:ist(/ chu os ent obj ndai p1 p2 pm ang caoc)
  (setq chu (getstring t "Chen chu :")
caoc (getreal (strcat "\nCao chu <" (rtos (getvar "USERR1")) ">:"))
os (getvar "OSMODE"))
  (prompt "\nChon duong de chen :")
  (setq ent (ssget '((0 . "LINE"))) n -1)
  (setvar "OSMODE" 0)
  (if (not caoc) (setq caoc (getvar "USERR1")) (setvar "USERR1" caoc))
  (repeat (sslength ent)
    (setq obj  (vlax-ename->vla-object (ssname ent (setq n (1+ n))))
 ndai (/ (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj)) 2)
 pr   (vlax-curve-getParamAtDist obj ndai)  
 p1   (vlax-curve-getPointAtParam obj (- pr 0.1))
 p2   (vlax-curve-getPointAtParam obj (+ pr 0.1))
 pm   (vlax-curve-getPointAtParam obj pr)
 ang  (if (< (car p1) (car p2)) (angle p1 p2) (angle p2 p1))
)
(command "text" "j" "BC" pm caoc (* 180 (/ ang pi)) chu)
  )
  (setvar "OSMODE" os)
)

<<

Filename: 295879_ist.lsp
Tác giả: phuong44e1
Bài viết gốc: 296265
Tên lệnh: gb2
Chương 8 - Tạo đối tượng

Chào bạn Ketxu,
Mình cũng đang mày mò để viết mấy cái lisp cho công việc của mình nhưng nó bị mắc mà hai ngày rồi mình không tài nào hiêu nổi tại sao. Vấn đề của mình là thế này mong bạn Ketxu giúp đỡ mình nhé.
Mình có bản vẽ và trên đó có nhiều Block và muốn là dùng 1 lệnh để chọn hết tất cả các block đó thì khi đó nó sẽ tự động ghi ra text (với nội dung là block name...

>>

Chào bạn Ketxu,
Mình cũng đang mày mò để viết mấy cái lisp cho công việc của mình nhưng nó bị mắc mà hai ngày rồi mình không tài nào hiêu nổi tại sao. Vấn đề của mình là thế này mong bạn Ketxu giúp đỡ mình nhé.
Mình có bản vẽ và trên đó có nhiều Block và muốn là dùng 1 lệnh để chọn hết tất cả các block đó thì khi đó nó sẽ tự động ghi ra text (với nội dung là block name hoặc block attribute) nằm tại đúng vị của từng Block đó.
Cụ thể trình tự thế này:
Mình chọn (bằng quét qua cửa sổ ) 10 block bất kỳ khi đó tại vị trí của các Block đó sẽ được ghi ra 10 cái text
Nội dung của các Text đó là 1 số thứ tự tăng dần kèm sau đó là nội dung của Block name hoặc block attribute.
 
Mình cũng đã viết rồi nhưng không hiểu sao nó chỉ có thể ghi dc cho một block mặc dù mình chon nhiều Block. Mất nguyên hai ngày rồi mà vẫn ko thể tìm hiểu dc lý do của nó là gì, mong bạn Ketxu giúp mình nhé.
 
Đây là code mà mình đã viết:

(defun c:GB2() ; 
(vl-load-com)                                                                            
  (setq ss (ssget (list (Cons 0 "*INSERT"))))                                                                  
  (repeat (setq i (sslength ss))
          (Setq ent (entget (ssname ss (setq i (1- i))))                         
                stt (rtos (- (sslength ss) i) 2 0)                  
                cao 600
                dtb (cdr (assoc 10 ent))
                bln (cdr (assoc 2 ent))))
(command "style" "" "" "0" "1" "0" "n" "n")
(command "Text" "J" (if(and (> ang 90.0) (< ang 270.0)) "MC" "MC") dtb cao 0 (strcat stt ":" bln))
(princ))

<<

Filename: 296265_gb2.lsp
Tác giả: hantinh
Bài viết gốc: 210479
Tên lệnh: sd
sửa giúp lsp chia dim

Mình đã xem lại đungs là thiếu 1 đôi số nhw bạn thanh bình nói đã sửa lại. Nhưng nó vẫn hok có chịu chạy.
bạn nào hiểu lý do lại sao bảo minh với

(defun C: SD (/sel newpt ent edata elist)
(if (and
(setq sel (entsel "\nSelect Dimension to Split."))
(setq newpt (getpoint "\Select newDim Point"))
)
(progn
(setq ent (car sel)
edat (entget ent)
elist...
>>
Mình đã xem lại đungs là thiếu 1 đôi số nhw bạn thanh bình nói đã sửa lại. Nhưng nó vẫn hok có chịu chạy.
bạn nào hiểu lý do lại sao bảo minh với

(defun C: SD (/sel newpt ent edata elist)
(if (and
(setq sel (entsel "\nSelect Dimension to Split."))
(setq newpt (getpoint "\Select newDim Point"))
)
(progn
(setq ent (car sel)
edat (entget ent)
elist (vl-remove-if
'(lambda (pair)
(member
(car pair)
(list -1 2 5 102 310 300 330 331 340 350 360 410)
)
)
edata
)
)
(entmod
(subst (cons 14 newpt)
(assoc 14 elist)
edata
)
)
(entmakex
(subst
(cons 13 newpt)
(assoc 13 elist)
elist
)
)
)
)
(princ "SplitDims")
)

<<

Filename: 210479_sd.lsp
Tác giả: Tot77
Bài viết gốc: 296311
Tên lệnh: ical
Tính toán trên cùng 1 textbox

Dùng cái lisp này cũng được. Chỉ cần enter thôi, còn nhấn ok là thoát. Sau khi tính muốn dùng kết quả để tính tiếp thì cứ enter.

(defun c:ical (/ name file str id sup)
  (defun tinh(st / vt)
    (if (and st (/= st "") (not (vl-string-search "=" st)))
      (set_tile "cal" (strcat st "=" (rtos (cal st))))
      (if (setq vt (vl-string-search "=" st)) (set_tile "cal" (substr st (+ 2 vt)))))
  )
 ...
>>

Dùng cái lisp này cũng được. Chỉ cần enter thôi, còn nhấn ok là thoát. Sau khi tính muốn dùng kết quả để tính tiếp thì cứ enter.

(defun c:ical (/ name file str id sup)
  (defun tinh(st / vt)
    (if (and st (/= st "") (not (vl-string-search "=" st)))
      (set_tile "cal" (strcat st "=" (rtos (cal st))))
      (if (setq vt (vl-string-search "=" st)) (set_tile "cal" (substr st (+ 2 vt)))))
  )
  (setq str 
  "ICAL : dialog {label = \"ICal\" ;
        : column {
        : row {
          : edit_box { key = \"cal\"; alignment = centered; edit_width = 50; value = \"\"; }
        }  ok_only ;
   }}  "
  )
 
  (setq file (open (setq name (strcat (substr (setq sup (vla-get-SupportPath (vla-get-Files
(vla-get-Preferences (vlax-get-acad-object))))) 1 (vl-string-search ";" sup)) "\\ICAL.DCL")) "w"))
  (write-line str file)
  (close file)
 
  (setq id (load_dialog name))
  (new_dialog "ICAL" id)  
  (action_tile "cal" "(tinh $value)")
  (action_tile "accept" "(done_dialog)")
  (mode_tile "cal" 2)
  (start_dialog)
  (if (< 0 id) (unload_dialog id))  
)
 
;;sqrt(2)*(3^7+4)-5+6*cos(30)/sin(60)-tang(45)*ln(2)

<<

Filename: 296311_ical.lsp
Tác giả: Tot77
Bài viết gốc: 296310
Tên lệnh: erc
lisp xóa tất cả các đối tượng trong 1 vùng kín

Bạn dùng lisp của bác Thiệp dưới đây, sau khi bắt đối tượng xong bạn muốn move, copy hay xóa thì tùy bạn.

 
(defun c:erC (/ sc cur p0 P1 L1 d L n ssgDEL glength)
  (princ "\nFree lisp from www.cadviet.com")
  (command "undo" "be")
  (setvar "osmode" 0)
  (setq sc 2009
cur (car (entsel "\nchon duong: "))
glength (lambda (e) (command ".lengthen" e "") (getvar "perimeter"))
d (/ (glength cur) sc)
l1 0.0
p0...
>>

Bạn dùng lisp của bác Thiệp dưới đây, sau khi bắt đối tượng xong bạn muốn move, copy hay xóa thì tùy bạn.

 
(defun c:erC (/ sc cur p0 P1 L1 d L n ssgDEL glength)
  (princ "\nFree lisp from www.cadviet.com")
  (command "undo" "be")
  (setvar "osmode" 0)
  (setq sc 2009
cur (car (entsel "\nchon duong: "))
glength (lambda (e) (command ".lengthen" e "") (getvar "perimeter"))
d (/ (glength cur) sc)
l1 0.0
p0 (vlax-curve-getStartPoint cur)
L (list p0)
  )
  (redraw cur 4)
  (repeat sc
    (setq l1 (+ l1 d)
 p1 (vlax-curve-getPointAtDist cur l1)
    )
    (setq L (append L (List p1)))
  )
  (setq ssgDEL (ssget "WP" L))  
  (command "undo" "end")
  (princ  "\nChuc cac ban may man va thanh cong - Thiep 0918841230" )
  (sssetfirst nil ssgDel)
  (princ)
)
(vl-load-com)

<<

Filename: 296310_erc.lsp
Tác giả: thanhduan2407
Bài viết gốc: 296486
Tên lệnh: gdcpl
Cao độ của đường LWPOLYLINE

Bạn làm cách này được không nhé.

Từ các đường đồng mức có cao độ. Bạn dùng lisp dưới đây để ghi cao độ của Pline. 

Bạn sẽ nhập khoảng cách giữa các cao độ trên cùng 1 Pline.

Như vậy mỗi đường đồng mức ta đều có số liệu cao độ rồi. 

Từ số liệu này ta có thể chạy tạo lại đường đồng mức 1 m dễ dàng.

Code của bạn đây

>>

Bạn làm cách này được không nhé.

Từ các đường đồng mức có cao độ. Bạn dùng lisp dưới đây để ghi cao độ của Pline. 

Bạn sẽ nhập khoảng cách giữa các cao độ trên cùng 1 Pline.

Như vậy mỗi đường đồng mức ta đều có số liệu cao độ rồi. 

Từ số liệu này ta có thể chạy tạo lại đường đồng mức 1 m dễ dàng.

Code của bạn đây

(defun c:GDCPL( / olmode ss KCL h en CDPline n i Pnt1)
(vl-load-com)
(setvar "CMDECHO" 0)
(setq olmode (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq ss (ssget  (list (cons 0 "POLYLINE,LWPOLYLINE"))))
(setq KCL (getreal "\n Nhap khoang cach can ghi cao do:  "))
(setq h (getreal "\n Nhap chieu cao Text cao do:  "))

(foreach en (acet-ss-to-list ss)
  	(progn
		(setq CDPline (Length1  en))
		(setq n (fix (/ CDPline KCL)))
		(setq i 1)
		(while (<= i n)
			(setq pnt1 (vlax-curve-getPointAtDist en (* i KCL)))
			(MakeText pnt1 (rtos (caddr Pnt1) 2 2) h 0 "L") 
		  	(setq i (1+ i))
		)
	  )
)
(setvar "osmode" olmode)
(princ)
)
(defun Length1 (e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
  
(defun MakeText (point string Height Ang justify / Lst); Ang: Radial
(setq Lst (list '(0 . "TEXT")
								(cons 10 point)
								(cons 40 Height)
								(cons 1 string)
								(if Ang (cons 50 Ang))
								
								
		)
	justify (strcase justify)
)
(cond ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))
			((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))
			((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))
			((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))))
			((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))))
			((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))))	
			((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))))
			((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))))
			((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))))
			((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))))
			((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))))
			((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1))))))
(entmakex Lst)
)


<<

Filename: 296486_gdcpl.lsp
Tác giả: gia_bach
Bài viết gốc: 296550
Tên lệnh: fpl
Great looking web site. Assume you did a great deal of your very own coding.|

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

Cụ thể những đường đồng mức 0,5 sẽ bỏ đi (50.5, 51.5 ....) giữ lại các đường có cao độ tròn 50, 51

... 

http://www.cadviet.com/upfiles/3/123735_ddm.dwg

Tham khảo Lisp chuyển các LwPolyline có cao độ...

>>

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

Cụ thể những đường đồng mức 0,5 sẽ bỏ đi (50.5, 51.5 ....) giữ lại các đường có cao độ tròn 50, 51

... 

http://www.cadviet.com/upfiles/3/123735_ddm.dwg

Tham khảo Lisp chuyển các LwPolyline có cao độ là số thập phân về layer "0", các LwPolyline có cao độ là số nguyên không thay đổi.

(defun C:fpl(/ ele)
  (if(ssget "_:L" (list (cons 0 "LWPOLYLINE")))
    (vlax-for e (vla-get-activeSelectionSet (vla-get-ActiveDocument(vlax-get-acad-object)))
      (if (> (abs(- (setq ele (vla-get-elevation e)) (fix ele))) 0)
	(vla-put-layer e "0")) ))
  (princ))

<<

Filename: 296550_fpl.lsp
Tác giả: thanhduan2407
Bài viết gốc: 296622
Tên lệnh: kk
Nhờ các bác xem dùm LISP kiểm tra Text nhập vào có trên bản vẽ hay không?

Nhờ các bác chỉ giáo.
Em viết Lisp kiểm tra Text nhập vào có ở trong bản vẽ không?
Em Test hoài mà...

>>

Nhờ các bác chỉ giáo.
Em viết Lisp kiểm tra Text nhập vào có ở trong bản vẽ không?
Em Test hoài mà sao nó vẫn lỗi. Em chưa tìm thấy lỗi ở đâu.
Mong các bác giúp

 

(defun C:KK (/ NamePoint ss i temp Tdo NameText )
(vl-load-com)
(setq NamePoint (getstring "\n Nhap ten diem can tim: "))
(setq ss (ssget "_X" (list (cons 0 "TEXT"))))
(setq i 1)
(while (< i (sslength ss))
(setq temp (entget (ssname ss i)))
(setq NameText (cdr (assoc 1 temp)))
(if (= NamePoint NameText )
(setq KQ "OK")
(setq KQ "Not_OK")
)
(setq i (1+ i))
)
(Alert KQ)
(princ)
)

Rõ ràng là em nhập đúng tên Text trên bản vẽ mà nó báo là không. Haizzzz


<<

Filename: 296622_kk.lsp
Tác giả: Tot77
Bài viết gốc: 296681
Tên lệnh: tmp
Nhờ các cao thủ Lips giúp em như trong miêu tả ở bản vẽ này với.

Bạn dùng líp dưới đây, chọn từng dãy circle, cuối cùng enter để nối các dãy. Dim theo kiểu hiện hành.

(defun c:tmp(/ os pll l n)
  (defun dxf(id v) (list (car (setq tm (cdr (assoc id (entget v))))) (cadr tm)))
  (defun makepl(l / l1)
    (setq l1 (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")  (cons 90 (length l))))
    (foreach pt l (setq l1 (append l1 (list (cons 10 (dxf 10 pt))...
>>

Bạn dùng líp dưới đây, chọn từng dãy circle, cuối cùng enter để nối các dãy. Dim theo kiểu hiện hành.

(defun c:tmp(/ os pll l n)
  (defun dxf(id v) (list (car (setq tm (cdr (assoc id (entget v))))) (cadr tm)))
  (defun makepl(l / l1)
    (setq l1 (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")  (cons 90 (length l))))
    (foreach pt l (setq l1 (append l1 (list (cons 10 (dxf 10 pt)) (cons 42 0)))))
    (entmake l1)
  )
  
  (defun dimpl(l / n)
    (setq n -1)
    (repeat (1- (length l))
      (command "dimaligned" (dxf 10 (nth (setq n (1+ n)) l)) (dxf 10 (nth (1+ n) l)) (dxf 10 (nth n l))))
  )
 
  (defun dimpl1(l pl / v tm)
    (setq pl (vlax-ename->vla-object pl))
    (foreach v l
      (setq v (dxf 10 v))
      (if (and (setq tm (vlax-curve-getClosestPointto pl v t))
      (> (vlax-curve-getParamAtPoint pl tm) 0))
(command "dimaligned" v tm v)))
  )
  ;;===========================;;
  (setq os (getvar 'osmode)
pll nil)
  (setvar 'osmode 0)
  (while (setq l (vl-sort (acet-ss-to-list (ssget '((0 . "CIRCLE"))))
  '(lambda(x y) (< (car (dxf 10 x)) (car (dxf 10 y))))))
    (makepl l) (setq pll (append pll (list (list (entlast) l)))) (dimpl l)
  )
  (setq n 0)
  (repeat (1- (length pll))
    (setq n (1+ n))
    (dimpl1 (last (nth (1- n) pll)) (car (nth n pll))))
  (mapcar '(lambda(x) (entdel (car x))) pll)
  (setvar 'osmode os)
  (princ)
)

<<

Filename: 296681_tmp.lsp
Tác giả: Tot77
Bài viết gốc: 296628
Tên lệnh: kk
Nhờ các bác xem dùm LISP kiểm tra Text nhập vào có trên bản vẽ hay không?

Bạn đưa cái (setq KQ "Not_OK") ra ngoài vòng while như sau:

(defun C:KK (/ NamePoint ss i temp Tdo NameText)
  (vl-load-com)
  (setq NamePoint (getstring "\n Nhap ten diem can tim: "))
  (setq ss (ssget "_X" (list (cons 0 "TEXT"))))
  (setq i 1)
  (setq KQ "Not_OK")
  (while (< i (sslength ss))
    (setq temp (entget (ssname ss i)))
    (setq NameText (cdr (assoc 1 temp)))
    (if (= NamePoint NameText)
      (setq...
>>

Bạn đưa cái (setq KQ "Not_OK") ra ngoài vòng while như sau:

(defun C:KK (/ NamePoint ss i temp Tdo NameText)
  (vl-load-com)
  (setq NamePoint (getstring "\n Nhap ten diem can tim: "))
  (setq ss (ssget "_X" (list (cons 0 "TEXT"))))
  (setq i 1)
  (setq KQ "Not_OK")
  (while (< i (sslength ss))
    (setq temp (entget (ssname ss i)))
    (setq NameText (cdr (assoc 1 temp)))
    (if (= NamePoint NameText)
      (setq KQ "OK")      
    )
    (setq i (1+ i))
  )
  (Alert KQ)
  (princ)
)
 

 

Nếu ở trong vòng while và if thì nó sẽ lấy kết quả so sánh của cái text cuối cùng.


<<

Filename: 296628_kk.lsp
Tác giả: Tot77
Bài viết gốc: 296721
Tên lệnh: tmp
Some important points to consider when acquiring an infusion set are as follows:

Bạn chọn từng dãy một theo thứ tự (trái qua, phải qua, trên xuống hay dưới lên đều được). Chọn xong 1 dãy thì enter, nó sẽ nối các điểm của dãy đó với nhau. Xong hết các dãy thì enter lần nữa sẽ nối các dãy với nhau. Lisp sẽ theo thứ tự dãy bạn chọn để nối từ dảy 1 tời dãy 2, dãy 2 tới dãy 3 ... Tôi có sửa lại líp chút ít phòng trường hợp dãy thẳng đứng.

>>

Bạn chọn từng dãy một theo thứ tự (trái qua, phải qua, trên xuống hay dưới lên đều được). Chọn xong 1 dãy thì enter, nó sẽ nối các điểm của dãy đó với nhau. Xong hết các dãy thì enter lần nữa sẽ nối các dãy với nhau. Lisp sẽ theo thứ tự dãy bạn chọn để nối từ dảy 1 tời dãy 2, dãy 2 tới dãy 3 ... Tôi có sửa lại líp chút ít phòng trường hợp dãy thẳng đứng.

(defun c:tmp(/ os pll l n)
  (defun dxf(id v) (list (car (setq tm (cdr (assoc id (entget v))))) (cadr tm)))
  (defun makepl(l / l1)
    (setq l1 (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")  (cons 90 (length l))))
    (foreach pt l (setq l1 (append l1 (list (cons 10 (dxf 10 pt)) (cons 42 0)))))
    (entmake l1)
  )
  
  (defun dimpl(l / n)
    (setq n -1)
    (repeat (1- (length l))
      (command "dimaligned" (dxf 10 (nth (setq n (1+ n)) l)) (dxf 10 (nth (1+ n) l)) (dxf 10 (nth n l))))
  )
 
  (defun dimpl1(l pl / v tm)
    (setq pl (vlax-ename->vla-object pl))
    (foreach v l
      (setq v (dxf 10 v))
      (if (and (setq tm (vlax-curve-getClosestPointto pl v t))
      (> (vlax-curve-getParamAtPoint pl tm) 0))
(command "dimaligned" v tm v)))
  )
  ;;===========================;;
  (command "undo" "be")
  (setq os (getvar 'osmode)
pll nil)
  (setvar 'osmode 0)
  (while (setq l (vl-sort (acet-ss-to-list (ssget '((0 . "POINT"))))
  '(lambda(x y) (if (/= (car (dxf 10 x)) (car (dxf 10 y)))
  (< (car (dxf 10 x)) (car (dxf 10 y)))
  (> (cadr (dxf 10 x)) (cadr (dxf 10 y)))))))
    (makepl l) (setq pll (append pll (list (list (entlast) l)))) (dimpl l)
  )
  (setq n 0)
  (repeat (1- (length pll))
    (setq n (1+ n))
    (dimpl1 (last (nth (1- n) pll)) (car (nth n pll))))
  (mapcar '(lambda(x) (entdel (car x))) pll)  
  (command "undo" "e")
  (setvar 'osmode os)
  (princ)
)

<<

Filename: 296721_tmp.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 296895
Tên lệnh: gtd
lisp tọa độ

bác nào có lisp ghi tọa độ trên cad cho e xin với (kích 1 cái nó ghi luôn x,y trên cad luôn) cám ơn mọi người nhiều

Hề hề hề,

1/- Bạn nên đọc kỹ lại quy định của diễn đàn về việc yêu cầu viết lisp nhé.

2/- Vì không hiểu rõ cái bạn cần nên viết đại một lisp như vầy. Bạn dùng...

>>

bác nào có lisp ghi tọa độ trên cad cho e xin với (kích 1 cái nó ghi luôn x,y trên cad luôn) cám ơn mọi người nhiều

Hề hề hề,

1/- Bạn nên đọc kỹ lại quy định của diễn đàn về việc yêu cầu viết lisp nhé.

2/- Vì không hiểu rõ cái bạn cần nên viết đại một lisp như vầy. Bạn dùng thử, nếu chưa ưng thì hãy làm đúng các yêu cầu của diễn đàn nhé.

(defun c:gtd (/ oldos p)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(while (setq p (getpoint "\n Pick chon point muon gh toa do"))
      (command "text" p 2 0 (strcat (rtos (car p) 2 4) "," (rtos (cadr p) 2 4)))
)
(setvar "osmode" oldos)
(princ)
)
(defun c:gtd (/ oldos p)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(while (setq p (getpoint "\n Pick chon point muon gh toa do"))
      (command "text" p 2 0 (strcat (rtos (car p) 2 4) "," (rtos (cadr p) 2 4)))
)
(setvar "osmode" oldos)
(princ)
)

<<

Filename: 296895_gtd.lsp
Tác giả: Tot77
Bài viết gốc: 297026
Tên lệnh: dvp
Nhờ giúp đỡ viết LISP!

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

(defun c:dvp()
  (vl-load-com)
  (setq vp (vlax-ename->vla-object (car (entsel "\nChon Viewport:")))
hs (getreal "\nHe so nhan:"))
  (vla-put-Height vp (* hs (vla-get-Height vp)))
  (vla-put-Width vp (* hs (vla-get-Width vp)))
  (vla-put-CustomScale vp (/ (vla-get-CustomScale vp) hs 1.0))
  (princ)
)

Filename: 297026_dvp.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 296958
Tên lệnh: gtd
lisp tọa độ

Bác Bình xem lại vị trí đặt osmode, không hợp lý rồi.

Hề hề hề ,

Cám ơn bác DoanVanHa đã chỉ giáo. Xin sửa lại như sau, chẳng biết có hợp lý hơn không.....

(defun c:gtd (/ oldos p)
(while (setq p (getpoint "\n Pick chon point muon gh toa do"))
 (command "text" "_none" p...
>>

Bác Bình xem lại vị trí đặt osmode, không hợp lý rồi.

Hề hề hề ,

Cám ơn bác DoanVanHa đã chỉ giáo. Xin sửa lại như sau, chẳng biết có hợp lý hơn không.....

(defun c:gtd (/ oldos p)
(while (setq p (getpoint "\n Pick chon point muon gh toa do"))
 (command "text" "_none" p 2 0 (strcat (rtos (car p) 2 4) "," (rtos (cadr p) 2 4)))
)
(princ)
)

 

 (command "text" p 2 0 (strcat (rtos (car p) 2 4) "," (rtos (cadr p) 2 4)))
)

<<

Filename: 296958_gtd.lsp
Tác giả: Tot77
Bài viết gốc: 297065
Tên lệnh: dvp
Nhờ giúp đỡ viết LISP!

Vậy bạn sửa như sau:

(defun c:dvp (/ vp hs hs1)
  (setvar "cmdecho" 0)
  (vl-load-com)
  (setq vp (vlax-ename->vla-object (car (entsel "\nSelect Viewport:"))))
  
  (if (or (not hs) (/= 'REAL (type hs))) (setq hs 1.1))
  (setq hs1 (getreal (strcat "\nInput scale coefficient <" (rtos hs) ">(Enter to accept) :")))
  (if hs1 (setq hs hs1))
  
  (vla-put-Height vp (* hs (vla-get-Height vp)))   
  (vla-put-Width vp...
>>

Vậy bạn sửa như sau:

(defun c:dvp (/ vp hs hs1)
  (setvar "cmdecho" 0)
  (vl-load-com)
  (setq vp (vlax-ename->vla-object (car (entsel "\nSelect Viewport:"))))
  
  (if (or (not hs) (/= 'REAL (type hs))) (setq hs 1.1))
  (setq hs1 (getreal (strcat "\nInput scale coefficient <" (rtos hs) ">(Enter to accept) :")))
  (if hs1 (setq hs hs1))
  
  (vla-put-Height vp (* hs (vla-get-Height vp)))   
  (vla-put-Width vp (* hs (vla-get-Width vp)))
  (vla-put-CustomScale vp (/ (vla-get-CustomScale vp) hs 1.0))
  (setvar "cmdecho" 1)
  (princ "\nCompleted command!")
  (princ)
)

<<

Filename: 297065_dvp.lsp
Tác giả: Tot77
Bài viết gốc: 297081
Tên lệnh: tmp
[yêu cầu] lisp tính tổng số đai trong dim

Bạn thử dùng cái này, nó chẳng phân biệt kiểu dim, chỉ phân biệt tẽt dim thôi.

(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...
>>

Bạn thử dùng cái này, nó chẳng phân biệt kiểu dim, chỉ phân biệt tẽt dim thôi.

(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)))
  )
  (foreach x l (princ (strcat "\n" (itoa (cdr x)) (chr 216) (itoa (car x)))))
  (princ)
)

<<

Filename: 297081_tmp.lsp
Tác giả: Tot77
Bài viết gốc: 297083
Tên lệnh: tmp
[yêu cầu] 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 (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...
>>

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)
)
 

<<

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

Không nghĩ bạn "quơ" luôn dim không đai.

(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 ....
>>

Không nghĩ bạn "quơ" luôn dim không đai.

(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)))))
    (if (and (vl-string-search "[" txt) (vl-string-search "%" txt) (vl-string-search "a" txt))
      (setq
 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))))
  )
  (if l
    (progn
      (setq st "")
      (foreach x l (setq st (strcat st "\n" (itoa (cdr x)) (chr 216) (itoa (car x)))))
      (alert st)))
  (princ)
)
 

<<

Filename: 297103_tmp.lsp
Tác giả: Tot77
Bài viết gốc: 297105
Tên lệnh: tmp tim
Nhờ các cao thủ Lips giúp em như trong miêu tả ở bản vẽ này với.

Thật ra đây là bài toán tìm đường theo hướng gần giống vơi hướng cho sẵn,.

Líp dưới đây gồm 2 lệnh:

1. Lệnh TIM : chọn point 1. point 2, rồi chọn toàn bộ point, líp sẽ tìm đường đi thích hợp theo hướng ban đầu (p1-> p2) đến các điểm lân cận để vẽ pline.

2. Lệnh TMP : Chọn các pline bằng lệnh TIM vừa vẽ, líp sẽ dim các đường và ghi chữ.

 

>>

Thật ra đây là bài toán tìm đường theo hướng gần giống vơi hướng cho sẵn,.

Líp dưới đây gồm 2 lệnh:

1. Lệnh TIM : chọn point 1. point 2, rồi chọn toàn bộ point, líp sẽ tìm đường đi thích hợp theo hướng ban đầu (p1-> p2) đến các điểm lân cận để vẽ pline.

2. Lệnh TMP : Chọn các pline bằng lệnh TIM vừa vẽ, líp sẽ dim các đường và ghi chữ.

 

(defun dxf(id v) (list (car (setq tm (cdr (assoc id (entget v))))) (cadr tm)))
 
(defun c:tmp(/ os n sodem pll)  
  (defun laydinh(v / n L node)
    (setq v (vlax-ename->vla-object v)
          n -1 L nil)
    (vl-catch-all-error-p (vl-catch-all-apply '(lambda() 
      (while (setq node (vla-get-Coordinate v (setq n (1+ n)))) 
        (setq L (append L (list (vlax-safearray->list (vlax-variant-value node)))))))))
    L
  )
  
  (defun dimpl(l / n)
    (setq n -1)
    (repeat (1- (length l))
      (command "dimaligned" (nth (setq n (1+ n)) l) (nth (1+ n) l) (nth n l))
      (maketxt (polar (nth n l) (+ 1.5708 (angle (nth n l) (nth (1+ n) l))) (* 2 (getvar 'textsize)))
      (setq sodem (1+ sodem))))
    (maketxt (polar (nth (1+ n) l) (+ 1.5708 (angle (nth n l) (nth (1+ n) l))) (* 2 (getvar 'textsize)))
    (setq sodem (1+ sodem)))
  )
 
  (defun dimpl1(pl1 pl2 / l tm)
    (setq l (laydinh pl1)
 pl2 (vlax-ename->vla-object pl2))
    (foreach v l  
      (if (and (setq tm (vlax-curve-getClosestPointto pl2 v t))
      (> (vlax-curve-getParamAtPoint pl2 tm) 0))
(command "dimaligned" v tm v)))
  )
 
  (defun maketxt(pt txt)
    (entmake (list (cons 0 "TEXT") (cons 10 pt) (cons 11 pt) (cons 40 (getvar 'textsize))
  (cons 72 1) (cons 73 2) (cons 50 0) (cons 1 (itoa txt)))))
  
  ;;===========================;;
  
  (command "undo" "be")
  (setq os (getvar 'osmode) n 0 sodem 0)
  (setvar 'osmode 0)
  
  (foreach v (setq pll (acet-ss-to-list (ssget '((0 . "*POLYLINE"))))) (dimpl (laydinh v)))
  (repeat (1- (length pll)) (dimpl1 (nth n pll) (nth (setq n (1+ n)) pll)))
    
  (command "undo" "e")
  (setvar 'osmode os)
  (princ)
)
 
(defun c:tim(/ a b c ss lp ang )
  (defun leftl(l n / i) (setq i -1) (vl-remove-if '(lambda(x) (> (setq i (1+ i)) (1- n))) l))
  (defun makepl(l / l1)
    (setq l1 (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")  (cons 90 (length l))))
    (foreach pt l (setq l1 (append l1 (list (cons 10 (dxf 10 pt)) (cons 42 0)))))
    (entmake l1)
  )
  ;;;
  (setq a (car (entsel "\nChon Diem 1:"))
b (car (entsel "\nChon Diem 2:"))
ss (acet-ss-to-list (ssget '((0 . "POINT,CIRCLE"))))
lp (append nil (list a b))
ss (vl-remove a ss)
ss (vl-remove b ss)
ang (angle (dxf 10 a) (dxf 10 b)))
  (while (setq c (car (vl-remove-if-not '(lambda(x) (< (abs (- (angle (dxf 10 b) (dxf 10 x)) ang)) 0.5))
 (leftl (vl-sort ss '(lambda(x y) (< (distance (dxf 10 b) (dxf 10 x))
     (distance (dxf 10 b) (dxf 10 y))))) 5))))
 
    (setq ang (angle (dxf 10 b) (dxf 10 c))
 lp (append lp (list c))
 ss (vl-remove c ss)
 b c)
  )
  (makepl lp) (princ)
)

<<

Filename: 297105_tmp_tim.lsp
Tác giả: Tot77
Bài viết gốc: 297153
Tên lệnh: tmp
[yêu cầu] Lips cắt nhanh hàng đường thẳng

Vậy dùng thử cái này.

(defun C:tmp(/ lu1 ss ph os loai tt10 tt11)
   (vl-load-com)
   (command "undo" "be")
   (if (or (not lu) (/= (type lu) 'REAL)) (setq lu 1))
   (prompt "\nChon Line/PolyLine: ")
   (setq ss (ssget '((0 . "*LINE")))
lu1 (getreal (strcat "\nChieu dai moi <" (rtos lu) "> :"))
ph (getpoint "Phia se di chuyen:")
os (getvar 'osmode))
   (setvar 'osmode 0)
   (if lu1 (setq lu lu1))
  
   (foreach...
>>

Vậy dùng thử cái này.

(defun C:tmp(/ lu1 ss ph os loai tt10 tt11)
   (vl-load-com)
   (command "undo" "be")
   (if (or (not lu) (/= (type lu) 'REAL)) (setq lu 1))
   (prompt "\nChon Line/PolyLine: ")
   (setq ss (ssget '((0 . "*LINE")))
lu1 (getreal (strcat "\nChieu dai moi <" (rtos lu) "> :"))
ph (getpoint "Phia se di chuyen:")
os (getvar 'osmode))
   (setvar 'osmode 0)
   (if lu1 (setq lu lu1))
  
   (foreach v (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
     (setq loai (cdr (assoc 0 (entget v))))
     (if (or (= loai "LINE") (vl-string-search "POLYLINE" loai))
       (progn
 (setq obj (vlax-ename->vla-object v)
tt10 (vlax-curve-getStartPoint obj)
tt11 (vlax-curve-getEndPoint obj))
 (if (< (distance ph tt10) (distance ph tt11))
   (setq dc tt10)
   (setq dc tt11))
 (command "lengthen" "Total" lu (list v dc) "")) 
     )
   )
   (command "undo" "e")
   (setvar 'osmode os)
   (princ)
)

<<

Filename: 297153_tmp.lsp

Trang 160/330

160