Bạn mệt mỏi khi phải dóng để vẽ mặt đứng thang phức tạp?

 

Hãy để lisp tính thang của CADViet giúp bạn phần nào....

>>

Bạn mệt mỏi khi phải dóng để vẽ mặt đứng thang phức tạp?

 

Hãy để lisp tính thang của CADViet giúp bạn phần nào. Bạn copy đoạn code dưới đây vào file một file lisp rồi appload lên và dùng lệnh tinhthang.

 

(defun c:tinhthang()
(defun l2bac(ent)
(setq
tt (entget ent)
p1 (cdr (assoc 10 tt))
p2 (cdr (assoc 11 tt))
)
(list p1 p2)
)
(setq
ssbac (ssget '((0 . "LINE")))
hbac (getdist "\nChieu cao bac")
lstent (ss2ent ssbac)
ttbac (mapcar 'l2bac lstent)
index 0.0
)
(command ".3dmesh")
(command (* 2 (length lstent)) 2)
(foreach pp ttbac
(setq
caoht (* index hbac)
index (+ index 1.0)
p1 (car pp)
p2 (cadr pp)
x1 (car p1)
y1 (cadr p1)
x2 (car p2)
y2 (cadr p2)
za caoht
zb (+ caoht hbac)
p1a (list x1 y1 za)
p1b (list x1 y1 zb)
p2a (list x2 y2 za)
p2b (list x2 y2 zb)
)
(command p1a p2a p1b p2b)
)
)
(defun ss2ent(ss / sodt index lstent)
(setq
sodt (if ss (sslength ss) 0)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)

 

Đầu tiên là mặt bằng của bạn:

 

bạn đổi viewport để xem dạng phối cảnh:

 

dùng lệnh tinhthang để vẽ 3d của bậc thang:

 

dùng lệnh shade để xem thang dạng có diện:

 

Xoay để lấy mặt đứng biên:

 

Lệnh tính thang không thể vẽ kỹ được thang cho bạn, nhưng chắc chắn nó sẽ giúp bạn làm những thao tác cơ bản để có được những nét phôi của thang. Từ đó bạn sẽ thêm nét để trở thành mặt chiếu hay phối cảnh của thang.

 

Rất mong có được sự hồi âm sau khi sử dụng Lisp.

Có ai giúp mình không, sao mình vẽ hoài mà vẫn cứ bị như vậy. Đang rất cần. Cám ơn các huynh trước nha.

http://www.cadviet.com/upfiles/3/thang_luon_17_bac_ko.dwg

<<

6 giờ trước, vanhuyou đã nói:

Chào mọi người mình tìm được 1...

>>

6 giờ trước, vanhuyou đã nói:

Chào mọi người mình tìm được 1 lisp dim polyline nhưng muốn chỉnh lại theo nhu cầu của mình, khi dùng các phân đoạn arc trong polyline sẽ được dim theo 2 điểm đầu và cuối, nhờ mọi người sữa giúp mình để các phân đoạn arc đó dùng dimarc để dim. Cám ơn mọi người.

dpl.dwg

DPL_Automatic Dimension Pline.lsp

Bạn thử Lisp này.

chú ý chọn Dim_style trước khi chạy lệnh nhé.

(defun c:dimpl(/ doc ep i mp obj oldosn pllst plset sp spc)
  (defun LM:BulgeCenter ( p1 p2 b )
    (polar p1
	   (+ (angle p1 p2) (- (/ pi 2) (* 2 (atan b))))
	   (/ (* (distance p1 p2) (1+ (* b b))) 4 b)    ))
  
  (princ "\n<<< Select LwPolyline for dimensioning >>> ")
  (setq doc (vla-get-activedocument (vlax-get-acad-object))
        spc (vlax-get doc (if (eq (getvar 'CVPORT) 1)
			    'Paperspace
			    'Modelspace	    )	    )  )
  
  (if(setq plSet(ssget '((0 . "LWPOLYLINE"))))
    (progn
      (setq pLlst(vl-remove-if 'listp(mapcar 'cadr(ssnamex plSet)))
	    oldOsn (getvar "OSMODE"))
      (setvar "OSMODE" 0)
      (foreach pl pLlst
	(setq obj (vlax-ename->vla-object pl)
	      i 0)
	(Repeat (fix (vlax-curve-getEndParam obj))
	  (setq sp (vlax-curve-getpointatparam obj i)
		ep (vlax-curve-getpointatparam obj (1+ i))
		mp (vlax-curve-getpointatparam obj (+ i 0.5)))
	  (if (= 0 (vla-GetBulge obj i))
	    (vla-AddDimAligned spc
	      (vlax-3d-point sp) (vlax-3d-point ep) (vlax-3d-point mp))
	    (vla-AddDimArc spc
	      (vlax-3d-point (LM:BulgeCenter sp ep (vla-GetBulge obj i)))
	      (vlax-3d-point sp) (vlax-3d-point ep) (vlax-3d-point mp))
	    );if
	  (setq i (1+ i))
	  ); Repeat
	); end foreach
      (setvar "OSMODE" oldOsn)
      ); end progn
    ); end if
  (princ)
  ); end of defun

 

<<

Thanks anh Tue vì em dùng lệnh cad nhiều bước nên lười :D, nếu mình tạo hay lượm nhặt đc các linetype rùi đóng nó thành file.lin...

>>

Thanks anh Tue vì em dùng lệnh cad nhiều bước nên lười :D, nếu mình tạo hay lượm nhặt đc các linetype rùi đóng nó thành file.lin mún load mổi lần phải load tìm đường dẫn chọn -> ok. Nay dùng lsp gọn hơn 1 ít hihi.

Đây bạn dattran tham khảo hỉ

 

Lưu ý chỉ thay ngay đúng chữ viết màu đỏ, màu đen giữ nguyên y chang nhé :D

Code ví dụ

(defun c:llt ()
(if (tblsearch "ltype" "acad.lin")
(command "linetype" "load" "acad.lin" "C:\\program files\\autodesk\\autocad 2012 - English\\supports\\acad.lin" "y")
(command "linetype" "load" "DASHDOT,DASHED" "C:\\program files\\autodesk\\autocad 2012 - English\\supports\\acad.lin" ""))
)

Code load tất cả Linetype trong 1 file acad.lin đây bạn :

(defun c:Loadltype(/ f lst-lt data)
 ;;writen by Tue_NV
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
     (setq f (open (findfile "acad.lin") "r"))
 (while (setq data (read-line f))
(if (wcmatch data "`**@*`,*")
 	(setq lst-lt (append lst-lt (list (substr data (+ (vl-string-search "*" data) 2)
  				  		(1- (vl-string-search "," data))
  			     )
  		       )
  		)
 	)
)
 )
 (close f)
 (mapcar '(lambda(x) (loadLinetype doc x "acad.lin")) lst-lt)
 (princ)
)
(defun loadLinetype (doc LineTypeName FileName)
   (vl-catch-all-error-p
     (vl-catch-all-apply
   	'vla-load
   	(list
     	(vla-get-Linetypes doc)
     	LineTypeName
     	FileName
   	)
     )
   )
)

Tương tự, để load các linetype trong 1 file *lin -> xem code trên để tuỳ biến cho phù hợp

<<

 

à uh! Mình không để ý:

(defun c:tt  (/ Make-Line ang bv cdi hbv hcd len msp pd3 po1 po2 po3...
>>

 

à uh! Mình không để ý:

(defun c:tt  (/ Make-Line ang bv cdi hbv hcd len msp pd3 po1 po2 po3 po4 pt1 pt2 pt3 pt4 tlv p11 p33)
 (defun Make-Line  (p1 p2 lay)
  (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2) (cons 8 lay))))
 (vl-load-com)
 (setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
       cdi (* (getvar "DIMTXT") (getvar "DIMSCALE")))
 (if (and (setq pt1 (getpoint "\nDiem p1: "))
          (setq pt2 (getpoint "\nDiem p2: "))
          (setq pt3 (getpoint "\nDiem p3: "))
          (setq pt4 (getpoint "\nDiem p4: "))
          (setq hcd (getdist "\nChieu cao dam: "))
          (setq hbv (getdist "\nChieu day bt bao ve: "))
          (setq tlv (getreal "\nTi le ve <Nhap 20 de co ty le 1/20>:")))
  (progn (setq po1 (polar pt3 (* pi 1.0) (* hcd (/ 100 tlv)))
               po2 (polar po1 (* pi (/ 30 180.0)) 70)
               po3 (polar pt4 (* pi 0.0) (* hcd (/ 100 tlv)))
               po4 (polar po3 (* pi (/ 150 180.0)) 70)
               ang (angle pt1 pt2)
               pd3 (polar pt1 (+ ang (* pi 1.5)) (* cdi 4)))
         (Make-Line po1 po2 "CAT-THEP")
         (Make-Line po3 po4 "CAT-THEP")
         (setq p11 (inters pt1 pt2 po1 (polar po1 (* pi 1.5) hcd))
               p33 (inters pt1 pt2 po3 (polar po3 (* pi 1.5) hcd)))
         (mapcar (function (lambda (x y z) (vla-adddimaligned msp x y z)))
                 (mapcar 'vlax-3d-point (list pt1 pt2 p11))
                 (mapcar 'vlax-3d-point (list p11 p33 p33))
                 (mapcar 'vlax-3d-point (list pd3 pd3 pd3)))))
 (princ))

Ok rồi bác, mà sao bác không cho vị trí móc nó phụ thuộc vào lớp bảo vệ vậy, nhiều khi thép 2 lớp chẳng hạn, nếu nhập lớp bảo vệ 50 thì cái móc đó nằm phía trên cách mép dầm 50.

Cảm ơn bác rất nhiều.

<<

Download lisp

Filename: 400116_tt%C2%A0.lsp

(defun C:DBS()
	(if (not rea) (setq rea 200))
	(setq rea1 (getreal (strcat "\nInput distance of bulong <" (rtos rea) ">:"))) 
	(if rea1 (setq rea rea1))
	(if (not sln) (setq sln 2))
	(setq sln1 (getreal (strcat "\nNumber of bolts/row: <" (rtos sln) ">:"))) 
	(if sln1 (setq sln sln1))
	(if (not agnl) (setq agnl 0))
	(setq agnl1 (getreal (strcat "\nRotation of text: <" (rtos agnl) ">:"))) 
	(if agnl1 (setq agnl agnl1))
	(while
		(if (setq net...
>>

(defun C:DBS()
	(if (not rea) (setq rea 200))
	(setq rea1 (getreal (strcat "\nInput distance of bulong <" (rtos rea) ">:"))) 
	(if rea1 (setq rea rea1))
	(if (not sln) (setq sln 2))
	(setq sln1 (getreal (strcat "\nNumber of bolts/row: <" (rtos sln) ">:"))) 
	(if sln1 (setq sln sln1))
	(if (not agnl) (setq agnl 0))
	(setq agnl1 (getreal (strcat "\nRotation of text: <" (rtos agnl) ">:"))) 
	(if agnl1 (setq agnl agnl1))
	(while
		(if (setq net (nentsel "\nSelect  text of dimension!"))
			(setq
				etname (car net)
				etlist (entget etname)
				ettype (cdr (assoc 0 etlist))
				newtext (cdr (assoc 1 etlist))
			)
		)
		(if (= (substr newtext 1 4) "\\A1;")(setq newtext (vl-string-subst "" "\\A1;" newtext)))
		(if (= (substr newtext 1 4) "\\A1;")(setq newtext (vl-string-subst "" "\\A1;" newtext)))
		(if (= (substr newtext 1 4) "\\A1;")(setq newtext (vl-string-subst "" "\\A1;" newtext)))
		(if (= (substr newtext 1 4) "\\A1;")(setq newtext (vl-string-subst "" "\\A1;" newtext)))
		(if (= (substr newtext 1 4) "\\A1;")(setq newtext (vl-string-subst "" "\\A1;" newtext)))
		(setq newtext (vl-string-subst "" "," newtext))
		(setq newtext (vl-string-subst "" "," newtext))
		(setq newtext (vl-string-subst "" "," newtext))
		(setq bl (rtos(/ (atof newtext) rea)))
		(setq bl1 (rtos(fix (+ (/ (atof newtext) rea) 1))))
		(setq reat (rtos rea))
		(setq sl (rtos sln))
		(setq pst (vl-string-position (ascii ".") bl))
		(setq bl (substr bl 1 (+ pst 2)))
		(setq newtextS (strcat newtext "÷@" reat "=" bl1 "本(" bl ")x" sl "列"))
		(setvar "CLAYER" "07寸法")
		(setvar "CECOLOR" "3")
		(setvar "TEXTSTYLE" "Standard")
		(command "text" "j" "MC" pause 125 agnl newtextS)
	)
	(princ)
)

Lỗi

Select  text of dimension!; error: bad argument type: numberp: nil

Nhờ mọi người giúp đỡ:

1. Lỗi đó có nghĩa là gì và cách khắc phục.

2. Có một số bản vẽ không áp dụng được.

3. Có hàm nào trong autolisp fix được số chữ số thập phân không, vì trong đoạn code này em đang làm theo cách thủ công và kết quả thì tòi quá.

Cảm ơn mọi người!

 

Mình có sưu tầm được 1 lisp cộng các số text...

>>

 

Mình có sưu tầm được 1 lisp cộng các số text rồi viết ra kết quả đè lên 1 text khác. tên lệnh: CS

Nhưng gặp phải các khó khăn sau:

+ Kết quả viết ra nó có chưa 1 số sau dấu thập phân, mình muốn thay đổi thì sửa ở dòng lệnh nào.

+ Mình muốn sau mỗi lần nhấp vô các text cần cộng nó hiện kết quả ngay ở dòng Command cho mình thấy. Ví dụ có text 2 3 6 7, sau khi nhấp vô số 2 và 3, dưới command cho kết quả là 5, nhấp thêm số 6 thì command cho là 11....

+ Tốt nhất khi ghi kết quả, mình muốn nó tạo ra 1 text mới với cao chữ là 2 thay vì ghi đè lên text có sẵn, anh em nào sửa giúp mình với

NỘI DUNG LISP:

;;;Created by "NXT "

(defun C:CS (/ mysset counter number_total number name_ent cur_ent text_origin

number_total number_total_text LOOP result result_text text_modified old new)

(setvar "CMDECHO" 0)

;***************************************************************************************

(princ "\nSelect text objects for addition")

(setq mysset (ssget))

(if (/= mysset nil)

(progn

(setq counter 0)

(setq number_total 0.00)

(setq number 0.00)

(while (< counter (sslength mysset)) 

(setq name_ent (ssname mysset counter))

(setq cur_ent (entget name_ent))

(if (or (= (cdr (assoc '0 cur_ent)) "TEXT")

(= (cdr (assoc '0 cur_ent)) "MTEXT")

)

(progn

(setq text_origin (cdr (assoc 1 cur_ent)))

(setq number (distof text_origin 2));doi chuoi thanh so thuc

(if (= number nil)

(setq number 0.00)

) 

(setq number_total (+ number number_total)) 

)

)

(if (= (cdr (assoc '0 cur_ent)) "DIMENSION")

(progn

(setq text_origin (cdr (assoc 42 cur_ent)))

(setq number (/ text_origin 100.0))

(if (= number nil)

(setq number 0.00)

) 

(setq number_total (+ number number_total)) 

)

)

(setq counter (+ counter 1))

)

(setq number_total_text (rtos number_total));;doi so thuc thanh chuoi

)

(princ "\nThanks a lot and back to you !")

)

;***************************************************************************************

(setq LOOP T)

(while (= LOOP T)

(while (null (setq result (nentsel "\nSelect text for result: ")))

(princ "Nothing selected !")

); bat buoc user phai chon mot doi tuong

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

;lam noi bat doi tuong nguon bang ham redraw

(redraw (car result) 3)

(setq result_text (entget (car result)))

(if (or (= (cdr (assoc '0 result_text)) "TEXT")

(= (cdr (assoc '0 result_text)) "MTEXT")

(= (cdr (assoc '0 result_text)) "DIMENSION")

)

(progn

(setq text_origin (cdr (assoc 1 result_text)));Dong text can thay doi...

(setq text_modified number_total_text) ;Duoc thay doi boi...

(setq old (cons 1 text_origin))

(setq new (cons 1 text_modified))

(entmod (subst new old result_text))

(setq LOOP nil)

)

(progn

(princ "Please select text object !")

(setq LOOP T);Neu doi tuong khong phai la text thi vong lap se tiep tuc

) ;cho den khi chon duoc text

)

);Ket thuc viec chon doi text result

;***************************************************************************************

;Tra ve lai trang thai cu cho doi text result

(redraw (car result) 4)

(princ)

);end program

 

sao lại pót kèm topic khác nhỉ ^_^

Giờ rảnh rang , ko thấy ai nghịch thì mình nghịch vây.

Thấy bạn viết đc lisp nên mình làm cái ví dụ này (chưa đúng hết các trường hợp con trỏ chuột ở các vị trí menu.......) bạn có thể nghiên cứu thêm cho hoàn thiện. Good luck.

(defun c:test (/)

  (if (setq text (car (entsel "\nChon text dau tien: "))
	    loop t
      )
    (progn
      (setq sum 0)
      (setq num (distof (cdr (assoc 1 (entget text)))))
      (if (not (null num))
	(setq sum (+ sum num))
	(princ "\nTEXT chon khong phai la number!")
      )
      (while (and (setq gr (grread t 15 2)) loop)
	(cond
	  ((= (car gr) 5)
	   (and txt (entdel txt) (setq txt nil))
	   (if (cadr gr)
	     (progn
	       (setq pt	(polar (cadr gr)
			       (* pi 1.5)
			       (* 2 (cdr (assoc 40 (entget text))))
			)
	       )
	       (redraw text 3)
	       (setq
		 txt (entmakex
		       (list
			 '(0 . "TEXT")
			 '(100 . "AcDbEntity")
			 '(100 . "AcDbText")
			 (assoc 40 (entget text))
			 (cons 10 pt)
			 (cons 1 (strcat "Tong la: " (rtos sum 2 2)))
		       )
		     )			;entmakex_txt_sum
	       )
	     )
	   )
	  )				;cond gr 5
	  ((= (car gr) 3)
	   (if (and (setq ent (car (nentselp (cadr gr))))
		    (vl-position
		      (cdr (assoc 0 (entget ent)))
		      '("MTEXT" "TEXT")
		    )
	       )
	     (progn
	       (redraw ent 3)
	       (setq num (distof (cdr (assoc 1 (entget ent)))))
	       (if (not (null num))
		 (progn
		   (setq
		     pt1
		      (polar (cadr gr)
			     (* pi 1.5)
			     (* 2 (cdr (assoc 40 (entget text))))
		      )
		   )
		   (setq sum (+ sum num))
		   (and txt (entdel txt) (setq txt nil))
		   (setq
		     txt (entmakex
			   (list
			     '(0 . "TEXT")
			     '(100 . "AcDbEntity")
			     '(100 . "AcDbText")
			     (assoc 40 (entget text))
			     (cons 10 pt1)
			     (cons
			       1
			       (strcat "Tong la: " (rtos sum 2 2))
			     )

			   )
			 )		;entmakex_txt_sum
		   )

		 )			;progn
		 (princ "\nTEXT chon khong phai la number!")
	       )
	     )				;progn
	     (princ "\nBan chon khong phai la TEXT!")
	   )				;if
	  )				;cond gr 3
	  (t
	   (and txt (entdel txt) (setq txt nil))
	   (setq loop nil)
	  )				
	)				;COND
      )
    )					;progn
  )					;if
  (command "regen")
  (princ)
)

<<

Download lisp

Filename: 411627_test.lsp

Bạn dùng thử code này nhé

;|
REV.LSP © 1999-2001 Tee Square Graphics
|;

(defun C:REV (/ olderr cmde blip ltsc cclr snap pwid pgenen1 nam ent p obj ltp
			clr lts wid flgs...
>>

Bạn dùng thử code này nhé

;|
REV.LSP © 1999-2001 Tee Square Graphics
|;

(defun C:REV (/ olderr cmde blip ltsc cclr snap pwid pgenen1 nam ent p obj ltp
			clr lts wid flgs first final next spl cur vert a clos zoomit clyr lyr)
 (setq olderr *error*)
 (defun *error* (x)
(setvar "cmdecho" cmde)
(setvar "blipmode" blip)
(setvar "osmode" snap)
(setvar "celtscale" ltsc)
(setvar "cecolor" cclr)
(setvar "plinewid" pwid)
(setvar "plinegen" pgen)
(setq *error* olderr)
(princ)
 );; end of *error* function
 (setq cmde (getvar "cmdecho")
	blip (getvar "blipmode")
	ltsc (getvar "celtscale")
	cclr (getvar "cecolor")
	snap (getvar "osmode")
	pwid (getvar "plinewid")
	clyr (getvar "clayer")
	pgen (getvar "plinegen"))
 (setvar "cmdecho" 0)
 (setvar "blipmode" 0)
 (setvar "osmode" 0)
 (setvar "plinewid" 0)
 (setvar "plinegen" 1)
 (command "_.undo" "_be")
 (while (null (setq en1 (entsel "\nPick an object to reverse: "))))
 (setq nam (car en1)
	ent (entget nam)
	p (cadr en1)
	obj (cdr (assoc 0 ent)))
 (cond
((= obj "CIRCLE")
  (setq ctr (cdr (assoc 10 ent))
		dia (* 2.0 (cdr (assoc 40 ent)))
		a (angle p ctr))
  (command "_.break" p (polar p (/ pi 4) 0.001)
		   "_.pedit" p "_y" "_c" "_x")
  (carc))
((= obj "ARC")
  (command "_.break" p "@"
		   "_.pedit" p "_y" "_j" nam (entlast) "" "_x")
  (carc))
(T nil))
 (setq ltp (cdr (assoc 6 ent))
	lyr (cdr (assoc 8 ent))
	clr (cdr (assoc 62 ent))
	lts (cdr (assoc 48 ent))
	wid (cdr (assoc 40 ent))
	flgs (cdr (assoc 70 ent)))
 (if (not ltp)(setq ltp "bylayer"))
 (cond
((= obj "LINE")
  (setq first (assoc 10 ent)
		final (assoc 11 ent)
		ent (subst (cons 10 (cdr final)) first ent)
		ent (subst (cons 11 (cdr first)) final ent))
  (entmod ent))
((= obj "LWPOLYLINE")
  (setq final (cdr (assoc 10 (setq ent (reverse ent))))
		next (cdr (assoc 10 (cdr (member (assoc 10 ent) ent)))))
  (prev))
((= obj "POLYLINE")
  (setq spl (= (logand flgs 4) 4)
		cur (= (logand flgs 2) 2)
		vert (entnext nam))
  (if cur
	(command "_.pedit" p "_s" ""))
  (while (= (cdr (assoc 0 (entget (setq vert (entnext vert))))) "VERTEX")
	(setq next final
		  final (cdr (assoc 10 (entget vert)))))
  (prev))
(T (alert "Not a REVersible object.")))
 (command "_.undo" "_e")
 (setvar "cmdecho" cmde)
 (setvar "blipmode" blip)
 (setvar "osmode" snap)
 (setvar "celtscale" ltsc)
 (setvar "cecolor" cclr)
 (setvar "plinewid" pwid)
 (setvar "plinegen" pgen)
 (setvar "clayer" clyr)
 (setq *error* olderr)
 (princ)
)
(defun carc ()
 (setq ent (entget (entlast))
	nam (cdr (assoc -1 ent))
	obj (cdr (assoc 0 ent)))
)
(defun prev ()
 (setq a (angle next final)
	clos (= (logand flgs 1) 1))
 (if clos (command "_.pedit" nam "_o" ""))
 (setq zoomit (null (ssget "c" final final)))
 (if zoomit (command "_.zoom" "_c" final ""))
 (if clr (command "_.color" clr))
 (if lts (setvar "celtscale" lts))
 (setvar "clayer" lyr)
;  (setvar "celtype" ltp)
 (command "_.pline" (polar final a 0.0001) final ""
	   "_.chprop" (entlast) "" "_lt" ltp ""
	   "_.pedit" (entlast) "_j" nam "" ""
	   "_.break" final (polar final a 0.001))
 (if cur (command "_.pedit" (entlast) "_f" ""))
 (if spl (command "_.pedit" (entlast) "_s" ""))
 (if clos (command "_.pedit" (entlast) "_c" ""))
 (if wid (command "_.pedit" (entlast) "_w" wid ""))
 (if zoomit (command "_.zoom" "_p"))
)
;;; (alert (strcat "REV.LSP © 1999-2001 Tee Square Graphics\n\n" 
;;;				"			  Type REV to begin."))
(princ)

Bác philipdn viết ghê quá đọc một hồi chưa hiểu nhưng để khi có thời gian mình được tiếp, đang bận chuẩn bị báo cáo cấp trên vẽ thủ công đã cảm ơn các bạn đã góp ý.

<<

14 giờ trước, hoacomay70 đã nói:

Trước bác Tot77 có viết cho em...

>>

14 giờ trước, hoacomay70 đã nói:

Trước bác Tot77 có viết cho em một lisp rất hay như sau:

- chọn một đường pline 1 cho trước

- chọn 1 đường pline 2 ( hoặc line)vuông góc với pline 1 đó

- chọn điểm đầu (hoặc cuối) của pline để xác định hướng rải

- nhâp khoảng cách cần rải và số lượng đường cần rải

Lisp sẽ rải ra các đường pline vuông góc với pline 1 và cách pline 2 khoảng cách người dùng nhập.

Trước em dùng lisp này rất tốt nhưng hiện tại em hay phải thao tác với các đường pline 1 rất dài, bản vẽ nặng, công zoom để chọn được

điểm cuối của pline rất lâu. Em nhờ các bác có thể sửa giúp lisp để không cần phải chọn điểm đầu (hoặc cuối) của pline mà lisp tự động 

vẽ ra 2 đầu của pline đc không ạ.

Em xin cảm ơn.

 

test.lsp

(defun c:test(/ pl obj dd dait cl n os ki )
  (defun ad(v p1 p2 / a1)
    (abs (- (vlax-curve-getDistAtPoint (setq a1 (vlax-ename->vla-object v)) (vlax-curve-getClosestPointTo a1 p2))
  (vlax-curve-getDistAtPoint a1 (vlax-curve-getClosestPointTo a1 p1)))))
  
  (defun getp(v dis)
     (vlax-curve-getPointAtDist (vlax-ename->vla-object v) dis))
  
  (defun thgoc (ent pt / param obj) 
    (if (setq param (vlax-curve-getParamAtPoint (setq obj (vlax-ename->vla-object ent)) pt))
      (- (angle '(0 0 0) (vlax-curve-getFirstDeriv obj param))  (/ pi 2))
      nil))
  
  (defun daitc(v / obj)    
      (vlax-curve-getDistAtParam (setq obj (vlax-ename->vla-object v)) (vlax-curve-getEndParam obj)))
  
  ;;;
  
  (setq pl (car (entsel "\nChon Polyline:"))
li (car (entsel "\nChon duong thang vuong goc voi Polyline:"))
dail (daitc li)
obj (vlax-ename->vla-object pl) 
dg (vlax-curve-getClosestPointTo obj (acet-dxf 10 (entget li)))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (< (distance dg (vlax-curve-getEndPoint obj)) (distance dg (vlax-curve-getStartPoint obj))) 
(setq dd (vlax-curve-getStartPoint obj))
(setq dd (vlax-curve-getEndPoint obj))
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(or (and cd (or (= (type cd) 'int) (= (type cd) 'real))) (setq cd 20.00))
(setq cd (cond ((getreal (strcat "\nNhap buoc de rai <" (rtos cd 2 2) ">:"))) (cd)))
;(setq cd (getreal "\nNhap buoc de rai:"))
;(setq sl (getint "\nSo luong coc rai"))
(or (and sl (or (= (type sl) 'int))) (setq sl (fix (/ (GetDis obj dd dg) cd))))
(setq sl (cond ((getint (strcat "\nNhap buoc de rai <" (rtos sl 2 0) ">:"))) (sl)))
(setq ct (vlax-curve-getDistAtPoint obj dg)
n 0
os (getvar "OSMODE"))
  (if (< (distance dd (vlax-curve-getStartPoint obj)) (distance dd (vlax-curve-getEndPoint obj)))
    (setq ki nil) (setq ki t))
  (setvar "OSMODE" 0)
  (repeat sl         
    (command "line"
    (setq dg1 (if ki (getp pl (+ ct (* (setq n (1+ n)) cd)))
     (getp pl (- ct (* (setq n (1+ n)) cd)))))   
    (polar dg1 (thgoc pl dg1) dail) ""))
  (setvar "OSMODE" os)
  (princ)
)
(defun GetDis (en pt1 pt2 / dis1 dis2 dis)
(setq
dis1 (vlax-curve-getDistAtPoint en (vlax-curve-getClosestPointTo en pt1))
dis2 (vlax-curve-getDistAtPoint en (vlax-curve-getClosestPointTo en pt2))
dis (abs (- dis2 dis1))
)
)

Sửa lại cho bạn nhé. Số lượng có thể nhập nếu không muốn rải hết, còn rải hết thì cứ việc ấn Enter nhé

<<

Do trình duyệt thôi, bạn thử download lại
 

(defun C:NT() ;;;;;;;;;; NHAN VOI MOT SO ;;;;;;;;;;;
(command "undo" "BE")(setq ttt (getreal "Nhap gia tri muon nhan : "))(setq tp (getint "Nhap so thap phan : "))(princ "Chon cac Text can nhan:")(setq ss (ssget '((0 . "TEXT"))))(setq j -1)(repeat (sslength ss)(setq j (+ j 1))(setq dt1 (ssname ss j))(setq el (entget dt1)...
>>

Do trình duyệt thôi, bạn thử download lại
 

(defun C:NT() ;;;;;;;;;; NHAN VOI MOT SO ;;;;;;;;;;;
(command "undo" "BE")(setq ttt (getreal "Nhap gia tri muon nhan : "))(setq tp (getint "Nhap so thap phan : "))(princ "Chon cac Text can nhan:")(setq ss (ssget '((0 . "TEXT"))))(setq j -1)(repeat (sslength ss)(setq j (+ j 1))(setq dt1 (ssname ss j))(setq el (entget dt1) )(setq gt (cdr (assoc 1 el) ))(setq gt1 (atof gt))(setq gt2 (* gt1 ttt))(setq gt2 (rtos gt2 2 tp))(setq elt (subst (cons 1 gt2) (assoc 1 el) el))(entmod elt))(command "undo" "END"))

nt.lsp

^^. Như kiểu F8 ạ . : ))) Hì, em quên mất chỉ cần ON với OFF , nên lỡ cho thành 2 lệnh luôn  :blink:  :blink:

 

Cho 2...

>>

^^. Như kiểu F8 ạ . : ))) Hì, em quên mất chỉ cần ON với OFF , nên lỡ cho thành 2 lệnh luôn  :blink:  :blink:

 

 

Cho 2 lệnh thành 1 như thế này tiện hơn ko e :)

(defun c:ge  ()
  (if (= (getvar "PICKSTYLE") 0)
    (setvar "PICKSTYLE" 1)
    (setvar "PICKSTYLE" 0))
  (princ)
  )

<<

Download lisp

Filename: 409382_ge.lsp

 

Bạn dùng cái này. Nó chỉ hỏi 1 lần thôi.

(defun c:cca (/ ss sstk sstn sscc v cdtk tm cc cdtn tm1)
  (defun...
>>

 

Bạn dùng cái này. Nó chỉ hỏi 1 lần thôi.

(defun c:cca (/ ss sstk sstn sscc v cdtk tm cc cdtn tm1)
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (defun gan(v l)
   (car (vl-remove-if-not '(lambda(x) (< (distance (dxf 10 v) (dxf 11 x)) 1)) l))
  )
  (if (not laylist)
    (setq laylist (cons (dxf 8 (car (entsel "\nChon doi tuong thuoc layer Cao do thiet ke :"))) laylist)
 laylist (cons (dxf 8 (car (entsel "\nChon doi tuong thuoc layer Cao do tu nhien :"))) laylist)
 laylist (cons (dxf 8 (car (entsel "\nChon doi tuong thuoc layer Chenh cao :"))) laylist)
    )
  )      
  (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex
(ssget "X" (list '(0 . "TEXT") (cons 8 (strcat (car laylist)"," (cadr laylist) "," (last laylist))))))))
sstk (vl-remove-if-not '(lambda(x) (= (dxf 8 x) (last laylist))) ss)
sstn (vl-remove-if-not '(lambda(x) (= (dxf 8 x) (cadr laylist))) ss)
sscc (vl-remove-if-not '(lambda(x) (= (dxf 8 x) (car laylist))) ss))
(while sstk
 (setq v (car sstk)
       sstk (cdr sstk)
       cdtk (atof (dxf 1 v))
       tm (gan v sstn)
       cc (gan v sscc))
 (if (and tm cc)
    (setq cdtn (atof (dxf 1 tm))
 sstn (vl-remove tm sstn)
 sscc (vl-remove cc sscc)
 tm1 (entmod (subst (cons 1 (rtos (- cdtk cdtn) 2 3)) (assoc 1 (entget cc)) (entget cc)))
  )
 )
)
(princ)
)

Cho em hỏi, em dùng lsp trên rất tốt nhưng có một số bản vẽ lỗi. Anh sửa giúp em được không ạ?

http://www.cadviet.com/upfiles/5/64018_lsp_cc_bi_loi.dwg

<<

Download lisp

Filename: 387015_cca.lsp

Hi i find this code in this site https://www.cadviet.com/forum/topic/13203-viết-lisp-theo-yêu-cầu-phần-2/?page=68. The project started by phamngoctukts . Is any one finish this code? Can any one help?

Thanks

(DEFUN...
>>

Hi i find this code in this site https://www.cadviet.com/forum/topic/13203-viết-lisp-theo-yêu-cầu-phần-2/?page=68. The project started by phamngoctukts . Is any one finish this code? Can any one help?

Thanks

(DEFUN stretchblock()
(batdau)  
 (princ "chon doi tuong: ")
 (setq ss0 (ssget))
 (initget 1)
 (setq hs (getreal "Cho biet he so STRETCH: "))
 (setq P01 (getpoint "\nChon diem chen: "))
(delblock)
 (command "-Block" "vkc_temp1" "0,0" ss0 "")
 (command "-insert" "vkc_temp1" "0,0" "" "" "")
 (setq sstt1 (entlast))
 (setq sstt (ssget "l"))
(blockrectang)
 (setq re1 (entlast))
 (setq tt (entget re1)) 
 (setq tt (vl-remove-if '(lambda (x) (/= 10 (car x))) tt)) 
 (setq dinh1 (cdr (nth 0 tt)))
 (setq dinh2 (cdr (nth 1 tt)))
 (command "_.erase" "l" "")
 (command "_.copy" sstt1 "" "0,0" "0,0")
 (command "_.explode" "l")
 (setq ss00 (ssget "p"))
 (Command "_.Explode" sstt1)
 (command "-Block" "vkc_temp1" "y" dinh1 ss00 "")
 (command "line" dinh2 dinh1 "")
 (setq re (ssget "l"))
 (command "_.move" re "" dinh1 p01)
 (command "_.rotate" re "" p01 "45")
 (command "-insert" "vkc_temp1" "r" "45" p01 "" "")
 (setq blgoc (entlast))
 (Command "Explode" blgoc)
 (setq bl (ssget "p")) 
 (command "-Block" "vkc_temp2" P01 re "")
 (command "-Block" "vkc_temp3" P01 bl "")
 (Command "-Insert" "vkc_temp3" P01 "" hs "")  
 (setq dt1 (entlast))
 (Command "-Insert" "vkc_temp2" P01 "" hs "")  
 (Command "_.Explode" "l" "")
 (setq dt2 (entlast))
 (setq tt1 (entget dt2))
 (setq tt1 (vl-remove-if '(lambda (x) (/= 10 (car x))) tt1))
 (setq dinh11 (cdr (nth 0 tt1)))
 (command "_.align" dt1 "" p01 dinh1 dinh11 dinh2 "" "y")
 (command "_.erase" dt2 "")
 (command "_.move" dt1 "" dinh1 p01)
 (Command "_.Explode" "l")
(ketthuc)
 (princ)
)
;**************************************************************
(defun c:stb ()
(stretchblock)
)

(defun batdau ()
 (command "undo" "be")
 (setvar "cmdecho" 0)
 (while (/= (logand (getvar "cmdactive") 31) 0)(command pause))
)
;**************************************************************
(defun ketthuc ()
 (command "undo" "e")
 (setvar "cmdecho" 1)
)
;**************************************************************
(defun delblock ()
(Command "-Purge" "B" "vkc_temp1" "Y" "Y")
(Command "-Purge" "B" "vkc_temp2" "Y" "Y")
(Command "-Purge" "B" "vkc_temp3" "Y" "Y")
)
;**************************************************************       
(defun blockrectang ()
(while (setq e (ssname sstt 0))
(setq sstt (ssdel e sstt)
tmp (vla-getboundingbox (vlax-ename->vla-object e) 'p1 'p3)
p1 (vlax-safearray->list p1)
p3 (vlax-safearray->list p3) 
p1 (list (car p1) (cadr p1))
p3 (list (car p3) (cadr p3))
p2 (list (car p1) (cadr p3))
p4 (list (car p3) (cadr p1))
tmp (list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity") 
(cons 100 "AcDbPolyline") 
(cons 90 4)
(cons 70 1)
(cons 10 p1)
(cons 10 p2)
(cons 10 p3)
(cons 10 p4)
)
)
(entmake tmp)
) 
)

Hi bro, try this (in the same link) . Ken you sờ pik Vietnamese ?

;; free lisp from cadviet.com
;;; this lisp was downloaded from https://www.cadviet.com/forum/topic/13203-vi%E1%BA%BFt-lisp-theo-y%C3%AAu-c%E1%BA%A7u-ph%E1%BA%A7n-2/?page=68
(defun nhapsolieu ()
(setq goc1 (getangle p01 "chon diem thu 2 theo huong bac: "))
(setq goc (/ (* goc1 180) pi))
(setq xulygoc (- 45 (/ goc 2)))
(setq gocra (/ (* pi xulygoc) 180))
(setq sina (sin gocra))
(setq cosa (sqrt (- 1 (expt sina 2))))
(setq tang (/ sina cosa))
(setq a (distance dinh2 dinh3))
(setq duongcheo (* a (sqrt 2)))
(setq b (/ duongcheo (* 2 tang)))
(setq anso (- b (/ duongcheo 2)))
(setq x (* anso 2))
(setq hs (+ (/ x duongcheo) 1))
)

(DEFUN stretchblock()
(batdau)  
 (princ "chon doi tuong: ")
 (setq ss0 (ssget))
 (initget 1)
 (setq P01 (getpoint "\nChon diem chen: "))
(delblock)
 (command "-Block" "vkc_temp1" "0,0" ss0 "")
 (command "-insert" "vkc_temp1" "0,0" "" "" "")
 (setq sstt1 (entlast))
 (setq sstt (ssget "l"))
(blockrectang)
 (setq re1 (entlast))
 (setq tt (entget re1)) 
 (setq tt (vl-remove-if '(lambda (x) (/= 10 (car x))) tt)) 
 (setq dinh1 (cdr (nth 0 tt)))
 (setq dinh2 (cdr (nth 1 tt)))
 (setq dinh3 (cdr (nth 2 tt)))
 (command "_.erase" "l" "")
(nhapsolieu)
 (command "_.copy" sstt1 "" "0,0" "0,0")
 (command "_.explode" "l")
 (setq ss00 (ssget "p"))
 (Command "_.Explode" sstt1)
 (command "-Block" "vkc_temp1" "y" dinh1 ss00 "")
 (command "line" dinh2 dinh1 "")
 (setq re (ssget "l"))
 (command "_.move" re "" dinh1 p01)
 (command "_.rotate" re "" p01 "45")
 (command "-insert" "vkc_temp1" "r" "45" p01 "" "")
 (setq blgoc (entlast))
 (Command "Explode" blgoc)
 (setq bl (ssget "p")) 
 (command "-Block" "vkc_temp2" P01 re "")
 (command "-Block" "vkc_temp3" P01 bl "")
 (Command "-Insert" "vkc_temp3" P01 "" hs "")  
 (setq dt1 (entlast))
 (Command "-Insert" "vkc_temp2" P01 "" hs "")  
 (Command "_.Explode" "l" "")
 (setq dt2 (entlast))
 (setq tt1 (entget dt2))
 (setq tt1 (vl-remove-if '(lambda (x) (/= 10 (car x))) tt1))
 (setq dinh11 (cdr (nth 0 tt1)))
 (command "_.align" dt1 "" p01 dinh1 dinh11 dinh2 "" "y")
 (command "_.erase" dt2 "")
 (command "_.move" dt1 "" dinh1 p01)
 (Command "_.Explode" "l")
(ketthuc)
 (princ)
)

(defun c:stb ()
(stretchblock)
)

(defun batdau ()
 (command "undo" "be")
 (setvar "cmdecho" 0)
 (while (/= (logand (getvar "cmdactive") 31) 0)(command pause))
)

(defun ketthuc ()
 (command "undo" "e")
 (setvar "cmdecho" 1)
)
(defun delblock ()
(Command "-Purge" "B" "vkc_temp1" "Y" "Y")
(Command "-Purge" "B" "vkc_temp2" "Y" "Y")
(Command "-Purge" "B" "vkc_temp3" "Y" "Y")
)

(defun blockrectang ()
(while (setq e (ssname sstt 0))
(setq sstt (ssdel e sstt)
tmp (vla-getboundingbox (vlax-ename->vla-object e) 'p1 'p3)
p1 (vlax-safearray->list p1)
p3 (vlax-safearray->list p3) 
p1 (list (car p1) (cadr p1))
p3 (list (car p3) (cadr p3))
p2 (list (car p1) (cadr p3))
p4 (list (car p3) (cadr p1))
tmp (list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity") 
(cons 100 "AcDbPolyline") 
(cons 90 4)
(cons 70 1)
(cons 10 p1)
(cons 10 p2)
(cons 10 p3)
(cons 10 p4)
)
)
(entmake tmp)
) 
)

1 giờ} trướ}c, Luongquocsonxd đã nói:

;; Thường thi khi chọn...

>>

1 giờ} trướ}c, Luongquocsonxd đã nói:

;; Thường thi khi chọn đối tượng thì đối tượng đó hiển thị những đường nét đứt (giống như nét Hidden)

;; Mình gửi đoạn lisp nội dung là thay thế Text ứng với một Text trước đó có sẵn

;; Sau khi mình nhập lệnh và chọn text "nguồn" thì Text nguồn đó không hiển thị dạng nét đứt để mô tả là đối tượng Text nguồn đã được chọn mà nó vẫn bình thường

;; Nhiều khi lick chọn đối tượng Text nguồn nhưng không biết là đã chọn được nó chưa

;; nhờ anh em giúp làm sao khi chọn Text nguồn thì nó hiển thị dạng nét đứt để dễ nhận biết là nó đã được chọn.

;; Thank you anh em!

(defun C:TC1 (/ con rep ch_text so_text text_val text_run)
  (setvar "Cmdecho" 0)
  (setq so_text NIL
    text_val NIL
    ch_text NIL
        so_text(entsel "\nChon Text goc <Noi dung mau>: "))
  (if so_text 
      (progn
    (setq so_text(entget(car so_text)))
    (if(or(= (cdr(assoc 0 so_text)) "TEXT");Kiem tra du lieu Text
          (= (cdr(assoc 0 so_text)) "MTEXT") )
       (setq text_val(cdr(assoc 1 so_text)) )
    );if
    (if(> (strlen text_val) 0)
       (progn
             (prompt "\nChon Texts muon sua noi dung theo Text goc: ")
         (setq ch_text(ssget '((0 . "*TEXT"))) )
       )
       (princ "\nKhong chon duoc Texts can sua !")
    );if
    (if(and ch_text text_val)
       (progn
         (setq rep (sslength ch_text)
           con 0)
         (while (> rep con)
           (setq text_run(entget(ssname ch_text con))
             ch_val(assoc 1 text_run))
           (setq text_run(subst (cons 1 text_val) ch_val text_run))
           (entmod text_run)
           (princ ".")
           (setq con(+ con 1))
         );while
         (princ "\n")(princ rep)(princ " Texts da duoc thay doi !")
        );progn
     );if
       );progn
    );if
  (princ)
); 

Code cho bạn xíu!

(defun C:TC1 (/ COLOR NDUNG SSTEXT TEXTN X)
  (setvar "Cmdecho" 0)
  (setq TextN (car (entsel "\nCh\U+1ECDn Text ngu\U+1ED3n: ")))
  (if (and TextN
	   (or (= (cdr (assoc 0 (entget TextN))) "TEXT")
	       (= (cdr (assoc 0 (entget TextN))) "MTEXT")
	   )
      )
    (progn
      (setq Color (vla-get-color (vlax-ename->vla-object TextN)))
      (setq NDung (cdr (assoc 1 (entget TextN))))
      (vla-put-color (vlax-ename->vla-object TextN) 1)
      (prompt
	"\nQu\U+00E9t ch\U+1ECDn Text c\U+1EA7n thay \U+0111\U+1ED5i n\U+1ED9i dung gi\U+1ED1ng Text ngu\U+1ED3n: "
      )
      (setq ssText (ssget '((0 . "*TEXT"))))
      (if ssText
	(progn
	  (mapcar '(lambda (x) (entmod (subst (cons 1 NDung) (assoc 1 (entget x)) (entget x))))
		  (acet-ss-to-list ssText)
	  )
	  (vla-put-color (vlax-ename->vla-object TextN) Color)
	  (Prompt
	    "\nN\U+1ED9i dung \U+0111\U+00E3 \U+0111\U+01B0\U+1EE3c thay \U+0111\U+1ED5i  "
	  )
	)
      )
    )
    (progn
      (Prompt
	"\nB\U+1EA1n ch\U+1ECDn \U+0111\U+1ED1i t\U+01B0\U+1EE3ng kh\U+00F4ng ph\U+1EA3i Text!"
      )
      (Alert
	"B\U+1EA1n ch\U+1ECDn \U+0111\U+1ED1i t\U+01B0\U+1EE3ng kh\U+00F4ng ph\U+1EA3i Text!"
      )
    )
  )
  (princ)
)

 

<<

Quick code cho bạn, từ cái này bạn phát triển hay sửa lỗi j thì mần :)
 

(defun c:foo(/ _massoc e1 e2 p)
;Free from CADViet @ketxu
(command "undo" "be")
(defun _massoc (id eData / x l)
	(foreach x eData
		(if (eq id (car x))
			(setq l (cons (cdr x) l))
		)
	)
(reverse l)
)
(if 
	(and 
		(setq e1 (entsel "\nObject 1:"))
		(wcmatch  (cdr (assoc 0 (entget...
>>

Quick code cho bạn, từ cái này bạn phát triển hay sửa lỗi j thì mần :)
 

(defun c:foo(/ _massoc e1 e2 p)
;Free from CADViet @ketxu
(command "undo" "be")
(defun _massoc (id eData / x l)
	(foreach x eData
		(if (eq id (car x))
			(setq l (cons (cdr x) l))
		)
	)
(reverse l)
)
(if 
	(and 
		(setq e1 (entsel "\nObject 1:"))
		(wcmatch  (cdr (assoc 0 (entget (setq e1 (car e1))))) "LINE,LWPOLYLINE")
		(setq e2 (entsel "\nObject 2:"))
		(wcmatch (cdr (assoc 0 (entget (setq e2 (car e2))))) "ARC,CIRCLE,ELLIPSE,LINE,LWPOLYLINE,SPLINE")
	)
	(progn 
		(setq l (_massoc 10 (entget e1)))
		(mapcar 
			'(lambda(x)
				(if (setq p (vlax-curve-getclosestpointto e2 x))
					(command "dimaligned" "non" p "non" x (polar p (- (angle p x) (* pi 0.5)) 1))
				)
			)
			l
		)
	)
)
(command "undo" "end")
(princ)
)

1 giờ trước, saukhoai đã nói:

ae giúp...

>>

1 giờ trước, saukhoai đã nói:

ae giúp với

(defun C:z1 (/ giatri sokhoang ss)
(vl-load-com)
(setq oldos (getvar "OSMODE"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(command "osnap" "none")
(if (null bcd)
 (progn
 (setq bcd 150)
 ))
 (setq bcd1 (getstring (strcat "\nBuoc cot dai <"(rtos bcd 2 0)"> :")))
 (if (/= bcd1 "") (setq bcd (atof bcd1)))
 (if (null dkt)
 (progn
 (setq dkt 6)
 ))
 (setq dkt1 (getstring (strcat "\duong kinh thep <"(rtos dkt 2 0)"> :")))
 (if (/= dkt1 "") (setq dkt (atof dkt1)))
(if (null khieu)
(progn
(setq khieu "1")
))
(setq khieu1 (getstring (strcat "\nNhap ky hieu thep <" khieu "> :")))
(if (/= khieu1 "") (setq khieu khieu1))
(prompt "\nChon doi tuong Dim.")
(setq ss (acet-ss-to-list (ssget '((0 . "DIMENSION")))))
(foreach enxt ss
(if (or (= (setq giatri (cdr (assoc 1 (entget enxt)))) "<>") (= (setq giatri (cdr (assoc 1 (entget enxt)))) ""))
(setq giatri (cdr (assoc 42 (entget enxt))))
(setq giatri (atof (cdr (assoc 1 (entget enxt)))))
)
(setq toado (polar (cdr (assoc 11 (entget enxt))) (/ pi -2) 300))
(setq sokhoang (+ (fix (/ giatri bcd)) 1))
(setq text (strcat "-" (rtos sokhoang 2 0) "%%C" (rtos dkt 2 0) "a" (rtos bcd 2 0)))
(command "TEXT" "J" "C" toado 150 0 text)
)
(princ)
)

Bạn kiểm tra được chưa nhé

<<

Không biết như này phù hợp với bạn chưa?

(defun C:00 (/ G1 G2 KC LTSDIM OBJ1 OBJXLINE PNTG1 PNTG2 SSCHON SSDIM)
  (vl-load-com)
  (defun *error* (msg)
    (if	Olmode
      (setvar 'osmode Olmode)
    )
    (if	(not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nError: " msg))
    )
    (redraw)
    (princ)
  )
  (command "undo" "begin")
  (setq Olmode (getvar "OSMODE"))
 ...
>>

Không biết như này phù hợp với bạn chưa?

(defun C:00 (/ G1 G2 KC LTSDIM OBJ1 OBJXLINE PNTG1 PNTG2 SSCHON SSDIM)
  (vl-load-com)
  (defun *error* (msg)
    (if	Olmode
      (setvar 'osmode Olmode)
    )
    (if	(not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nError: " msg))
    )
    (redraw)
    (princ)
  )
  (command "undo" "begin")
  (setq Olmode (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setq Obj1 (Car (entsel "\nChon Dimension dau tien: ")))
  (if (= (cdr (assoc 0 (entget Obj1))) "DIMENSION")
    (progn
      (setq ssDim (ssget '((0 . "DIMENSION"))))
      (if ssDim
	(progn
	  (setq LtsDim (acet-ss-to-list ssDim))
	  (if (member Obj1 LtsDim)
	    (vl-remove Obj1 LtsDim)
	  )
	  (if LtsDim
	    (progn
	      (setq G1 (angle (cdr (assoc 13 (entget Obj1))) (cdr (assoc 14 (entget Obj1)))))
	      (setq PntG1 (cdr (assoc 11 (entget Obj1))))
	      (command "Xline" PntG1 (polar PntG1 G1 1.0) "")
	      (setq ObjXline (entlast))
	      (setq ssChon (ssadd))
	      (foreach eDim LtsDim
		(setq G2 (angle (cdr (assoc 13 (entget eDim))) (cdr (assoc 14 (entget eDim)))))
		(setq PntG2 (cdr (assoc 11 (entget eDim))))
		(setq Kc (distance PntG2 (vlax-curve-getClosestPointto ObjXline PntG2)))
		(if (and (equal Kc 0.0 1e-8) (or (equal G2 G1 1e-8) (equal G2 (+ G1 pi) 1e-8)))
		  (ssadd eDim ssChon)
		)
	      )
	      (entdel ObjXline)
	    )
	  )
	)
      )
    )
  )
  (if ssChon
    (sssetfirst nil ssChon)
  )
  (setvar "OSMODE" Olmode)
  (princ)
)

Bạn thử xem thế nào nhé!

(defun C:00 (/ G1 G2 KC LTSDIM OBJ1 OBJXLINE PNTG1 PNTG2 SSCHON SSDIM)
  (vl-load-com)
  (defun *error* (msg)
    (if	Olmode
      (setvar 'osmode Olmode)
    )
    (if	(not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nError: " msg))
    )
    (redraw)
    (princ)
  )
  (command "undo" "begin")
  (setq Olmode (getvar "OSMODE"))
  (setvar "OSMODE" 0)
 ...
>>

Bạn thử xem thế nào nhé!

(defun C:00 (/ G1 G2 KC LTSDIM OBJ1 OBJXLINE PNTG1 PNTG2 SSCHON SSDIM)
  (vl-load-com)
  (defun *error* (msg)
    (if	Olmode
      (setvar 'osmode Olmode)
    )
    (if	(not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nError: " msg))
    )
    (redraw)
    (princ)
  )
  (command "undo" "begin")
  (setq Olmode (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setq Obj1 (Car (entsel "\nChon Dimension dau tien: ")))
  (if (= (cdr (assoc 0 (entget Obj1))) "DIMENSION")
    (progn
      (setq ssDim (ssget '((0 . "DIMENSION"))))
      (if ssDim
	(progn
	  (setq LtsDim (acet-ss-to-list ssDim))
	  (if (member Obj1 LtsDim)
	    (setq LtsDim (vl-remove Obj1 LtsDim))
	  )
	  (if LtsDim
	    (progn
	      (setq G1 (angle (cdr (assoc 13 (entget Obj1))) (cdr (assoc 14 (entget Obj1)))))
	      (setq PntG1 (cdr (assoc 11 (entget Obj1))))
	      (command "Xline" PntG1 (polar PntG1 G1 1.0) "")
	      (setq ObjXline (entlast))
	      (setq ssChon (ssadd))
	      (foreach eDim LtsDim
		(setq G2 (angle (cdr (assoc 13 (entget eDim))) (cdr (assoc 14 (entget eDim)))))
		(setq PntG2 (cdr (assoc 11 (entget eDim))))
		(setq KC (distance PntG2 (vlax-curve-getClosestPointto ObjXline PntG2 T)))
		(if (and (not (equal KC 0.0 1e-1))
			 (or (equal G2 G1 1e-8) (equal G2 (+ G1 pi) 1e-8)(equal G2 (- G1 pi) 1e-8))
		    )
		  (ssadd eDim ssChon)
		)
	      )
	      (entdel ObjXline)
	    )
	  )
	)
      )
    )
  )
  (if (> (sslength ssChon) 0)
    (progn
      (Alert (strcat "C\U+00F3 t\U+1EA5t c\U+1EA3 : " (rtos (sslength ssChon) 2 0) " Dim \U+0111\U+01B0\U+1EE3c ch\U+1ECDn"))
      (Prompt (strcat "\nC\U+00F3 t\U+1EA5t c\U+1EA3 : " (rtos (sslength ssChon) 2 0) " Dim \U+0111\U+01B0\U+1EE3c ch\U+1ECDn\n"))
      (sssetfirst nil ssChon)
    )
    (progn
      (Alert "Kh\U+00F4ng c\U+00F3 \U+0111\U+1ED1i t\U+01B0\U+1EE3ng n\U+00E0o \U+0111\U+01B0\U+1EE3c ch\U+1ECDn")
      (Prompt "\nKh\U+00F4ng c\U+00F3 \U+0111\U+1ED1i t\U+01B0\U+1EE3ng n\U+00E0o \U+0111\U+01B0\U+1EE3c ch\U+1ECDn\n")
    )
  )
  (setvar "OSMODE" Olmode)
  (princ)
)

Được một bạn trong diễn đàn chỉ ra 2 vấn đề này:

Quote

Góc của dim line trong lisp:

(angle (cdr (assoc 13 (entget Obj1))) (cdr (assoc 14 (entget Obj1))))

chỉ đúng khi 2 chân dim = nhau. Trường hợp này xảy ra trong hình dim nằm nghiêng 2 chân dim /= nhau =>...

>>

Được một bạn trong diễn đàn chỉ ra 2 vấn đề này:

Quote

Góc của dim line trong lisp:

(angle (cdr (assoc 13 (entget Obj1))) (cdr (assoc 14 (entget Obj1))))

chỉ đúng khi 2 chân dim = nhau. Trường hợp này xảy ra trong hình dim nằm nghiêng 2 chân dim /= nhau => sai

 

(setq PntG1 (cdr (assoc 11 (entget Obj1))))

lấy dxf 11 làm chuẩn sai khi text không còn vị trí ban đầu hoặc nhiều hàng

nên mình xin phép @thanhduan2407 được sửa lại. Để có ai quan tâm thì tham khảo.

(defun C:00 (/ G1 G2 KC LTSDIM OBJ1 OBJXLINE PNTG1 PNTG2 SSCHON SSDIM)
  (vl-load-com)
  (defun *error* (msg)
    (if	Olmode
      (setvar 'osmode Olmode)
    )
    (if	(not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nError: " msg))
    )
    (redraw)
    (princ)
  )
  (command "undo" "begin")
  (setq Olmode (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setq Obj1 (Car (entsel "\nChon Dimension dau tien: ")))
  (if (= (cdr (assoc 0 (entget Obj1))) "DIMENSION")
    (progn
      (setq ssDim (ssget '((0 . "DIMENSION"))))
      (if ssDim
	(progn
	  (setq LtsDim (acet-ss-to-list ssDim))
	  (if (member Obj1 LtsDim)
	    (setq LtsDim (vl-remove Obj1 LtsDim))
	  )
	  (if LtsDim
	    (progn
		
		
	(if (= 0 (rem (cdr (assoc 70 (entget Obj1))) 2))
        (setq G1 (cdr (assoc 50 (entget Obj1))))
        (setq G1 (angle (cdr (assoc 13 (entget Obj1))) (cdr (assoc 14 (entget Obj1)))))
	)		
		  
	      (setq PntG1 (cdr (assoc 10 (entget Obj1))))
	      (command "Xline" PntG1 (polar PntG1 G1 1.0) "")	
	      (setq ObjXline (entlast))
	      (setq ssChon (ssadd))
	      (foreach eDim LtsDim

	(if (= 0 (rem (cdr (assoc 70 (entget eDim))) 2))
        (setq G2 (cdr (assoc 50 (entget eDim))))
        (setq G2 (angle (cdr (assoc 13 (entget eDim))) (cdr (assoc 14 (entget eDim)))))
    )		

		(setq PntG2 (cdr (assoc 10 (entget eDim))))
		(setq KC (distance PntG2 (vlax-curve-getClosestPointto ObjXline PntG2 T)))
		(if (and (not (equal KC 0.0 1e-1))
			 (or (equal G2 G1 1e-8) (equal G2 (+ G1 pi) 1e-8)(equal G2 (- G1 pi) 1e-8))
		    )
		  (ssadd eDim ssChon)
		)
	      )
(entdel ObjXline)
	    )
	  )
	)
      )
    )
  )
  (if (> (sslength ssChon) 0)
    (progn
      (Alert (strcat "C\U+00F3 t\U+1EA5t c\U+1EA3 : " (rtos (sslength ssChon) 2 0) " Dim \U+0111\U+01B0\U+1EE3c ch\U+1ECDn"))
      (Prompt (strcat "\nC\U+00F3 t\U+1EA5t c\U+1EA3 : " (rtos (sslength ssChon) 2 0) " Dim \U+0111\U+01B0\U+1EE3c ch\U+1ECDn\n"))
      (sssetfirst nil ssChon)
    )
    (progn
      (Alert "Kh\U+00F4ng c\U+00F3 \U+0111\U+1ED1i t\U+01B0\U+1EE3ng n\U+00E0o \U+0111\U+01B0\U+1EE3c ch\U+1ECDn")
      (Prompt "\nKh\U+00F4ng c\U+00F3 \U+0111\U+1ED1i t\U+01B0\U+1EE3ng n\U+00E0o \U+0111\U+01B0\U+1EE3c ch\U+1ECDn\n")
    )
  )
  (setvar "OSMODE" Olmode)
  (princ)
)

Cảm ơn mọi người rất nhiều!

<<

41 phút trước, vietduc147258 đã nói:

Nhờ các bác viết dùm em...

>>

41 phút trước, vietduc147258 đã nói:

Nhờ các bác viết dùm em Lisp này với.

Khi nhấn lệnh in thì nó sẽ nhớ máy in, vùng in trước, Hiện lại bảng cho mình chọn vùng in mới.

Giống như lúc in mà ta chọn thuộc tính "<Previous plot>".

Em thường dùng lisp in hàng loàn thì nó in bản vẽ không đúng thứ tự, phải sắp lại.

Dùng lệnh "Apply to layout" thì Cad cũng nhớ các tùy chọn. Nhưng cái này dễ bị nhầm, nhiều trang mình in 2 lần.

Với tùy chọn "<Previous plot>". thì khi chọn vùng in thì vùng in trước đó nó màu đen mình không nhầm được.

Thank các bác.

Bác thử command -plot nó ra như nào thì viết lại đúng như thế là đc:

(defun c:te ()

(command "-plot"  "Yes"	 ""  ""   ""  ""  ""  "No"   "Window"
	 pause     pause
	 		""   ""  "Yes"   ""   "Yes"  ""  "No" "No"
	     		"Yes")
  )

 

<<