- page 169

Info

File

Tác giả: Tot77
Bài viết gốc: 308369
Tên lệnh: tao

Thật ra cái này tuy tôi viết cũng lâu rồi nhưng chỉ mang tính thử nghiệm (làm cho biết), chưa có ứng dụng thực tế.

Bạn muốn dùng thì down cái lsp này về.

Trong file bạn phải có sẵn pline và text cho từng đoạn của pline (đặt text gần cái đoạn của nó).

Đánh lệnh "tao", chọn pline, quét các text của pline. XOng vẫn chưa thấy có gì khác, tuy nhiên nếu bạn thay đổi chiều dài...

Thật ra cái này tuy tôi viết cũng lâu rồi nhưng chỉ mang tính thử nghiệm (làm cho biết), chưa có ứng dụng thực tế.

Bạn muốn dùng thì down cái lsp này về.

Trong file bạn phải có sẵn pline và text cho từng đoạn của pline (đặt text gần cái đoạn của nó).

Đánh lệnh "tao", chọn pline, quét các text của pline. XOng vẫn chưa thấy có gì khác, tuy nhiên nếu bạn thay đổi chiều dài đoạn thì text sẽ đổi.

Làm xong nhớ save file.

Lần sau mở file lại load cái lsp này vào để cad hiểu các hàm của nó, nhưng không cần đánh lệnh "tao" lại (lệnh này chỉ làm 1 lần cho 1 pline thôi).

(defun print-length (notifier-object reactor-object parameter-list / lvt pl n tm)
    (setq lvt (getLength (setq pl (vlax-vla-object->ename notifier-object))))
    (mapcar '(lambda(x)
(setq obj (vla-HandleToObject adoc (last x)))
(vla-put-textstring obj (nth (car x) lvt))
(setq tm (laydinhdoan pl (car x)))
(vla-put-rotation obj (if (< (caar tm) (caadr tm)) (angle (car tm) (last tm))
     (angle (last tm) (car tm) )))       
(vla-put-TextAlignmentPoint obj (vlax-3d-point (midp (car tm) (last tm)))))
   
  (vlax-ldata-get "Rdict" (dxf 5 pl)))
    (princ) 
  )
  
  (defun laydoan(pl pt / obj) 
    (fix (vlax-curve-getParamAtPoint pl (vlax-curve-getClosestPointTo pl pt))))
  
  (defun laydinhdoan(pl n / obj) 
    (list (vlax-curve-getPointAtParam pl n) (vlax-curve-getPointAtParam pl (1+ n))))
  
  (defun getLength(pl / vt l obj)
    (setq vt 0 l nil)
    (repeat (fix (vlax-curve-getEndParam pl))
      (setq l (append l (list (rtos (- (vlax-curve-getDistAtParam pl (setq vt (1+ vt)))
              (vlax-curve-getDistAtParam pl (1- vt))) 2 0)))))
    l
  )
 
(defun C:tao (/ mypLine tt5 pl)
  (setq mypLine  (vlax-ename->vla-object (setq pl (car (entsel "\nChon Polyline:"))))
tt5 (dxf 5 pl))
  (prompt "\nChon text ghi chieu dai:")  
  
  (if (vlax-ldata-get "Rdict" tt5) (vlax-ldata-delete "Rdict" tt5))
  
  (vlax-ldata-put "Rdict" tt5
    (mapcar '(lambda(x)  (list (laydoan pl (vlax-curve-getClosestPointTo mypLine (dxf 10 x)))
(vla-get-Handle (vlax-ename->vla-object x)))) (ssto (ssget '((0 . "TEXT"))))))
  
  (setq plineReactor (vlr-object-reactor (list mypLine) "PLine Reactor" '((:vlr-modified . print-length))))
  (vlr-pers plineReactor)
  (princ)
)

Download lisp

Filename: 308369_tao.lsp

Tác giả: hiepttr
Bài viết gốc: 298938
Tên lệnh: mchange cont

Chương 7.2,3 : Bài Tập

Mới được mấy bài, gửi lên để hâm nóng lớp :D :D :D

Chờ phán :lol:

;;;1. Ham doc ma dxf cua doi tuong. Doi so la ename doi tuong va ma dxf
(defun dxf (ename code)
(cdr (assoc code (entget ename)))
)
;;===========================================================
;;;2. Ham doi thuoc tinh dxf cua 1 doi tuong. Doi so la ename, dxf, gia tri dxf
(defun change_dxf(ename dxf val)
(entmod (subst (cons dxf val) (assoc dxf (setq info (entget...
>>

Mới được mấy bài, gửi lên để hâm nóng lớp :D :D :D

Chờ phán :lol:

;;;1. Ham doc ma dxf cua doi tuong. Doi so la ename doi tuong va ma dxf
(defun dxf (ename code)
(cdr (assoc code (entget ename)))
)
;;===========================================================
;;;2. Ham doi thuoc tinh dxf cua 1 doi tuong. Doi so la ename, dxf, gia tri dxf
(defun change_dxf(ename dxf val)
(entmod (subst (cons dxf val) (assoc dxf (setq info (entget ename))) info))
)
;;===========================================================
;;;3. Ham thay doi layer cua mot doi tuong. Doi so la ename, layer dich
(defun change_lay(ename lay)
(entmod (append (entget ename) (list (cons 8 lay))))
)
;;===========================================================
;;;4. Ham thay doi noi dung cua 1 doi tuong la TEXT. Doi so la ename, noi dung dich.
(defun change_cont(ename cont / info)
(entmod (subst (cons 1 cont) (assoc 1 (setq info (entget ename))) info))
)
;;===Truong hop chac chan la TEXT (ko la MTEXT...) thi co the su dung:
(defun change_cont_2(ename cont)
(entmod (append (entget ename) (list (cons 1 cont))))
)
;;============================================================
;;;5. Ham copy noi dung text sang text khac. Doi so la ename nguon, ename dich
(defun cp_cont(ename_nguon ename_dich / info)
(entmod (subst (assoc 1 (entget ename_nguon)) (assoc 1 (setq info (entget ename_dich))) info))
)
;;============================================================
;;;6. Ham thay doi thuoc tinh cua mot doi tuong. Doi so la ename, list cac assoc va gia tri can thay doi '((8 . "0")(1 . "ABC) ...)
(defun mchange_dxf(ename lst / dxf val)
(foreach elem lst
	(setq dxf (car elem)
		  val (cdr elem)
		  )
	(change_dxf ename dxf val)
	;Reuse ex.2
)
)
;;=============================================================
;;;7. Viet lenh sao chep noi dung tu Dtext nguon ra dtext khac, chon nguon -> pick, pick, pick...
(defun c:Mchange_cont( / ss1 ss2 cont)
(prompt "\nPick chon text can sao noi dung: ")
(setq ss1 (ssget "_+.:E:S" '((0 . "TEXT"))))
(if ss1
	(progn 
		(setq cont (assoc 1 (entget (ssname ss1 0))))
		(prompt "\nChon text can paste noi dung ! ")
		(while (setq ss2 (ssget "_+.:E:S" '((0 . "TEXT"))))
			(prompt "\nChon text can paste noi dung ! ")
			(entmod (append (entget (ssname ss2 0)) (list cont)))
		)
	)
	(princ "\n *** Chua chon duoc text nguon ! ***")
)
(princ)
)
;;================================================================

Download lisp

Filename: 298938_mchange_cont.lsp

Tác giả: hiepttr
Bài viết gốc: 298982
Tên lệnh: mchange cont 2 change color

Chương 7.2,3 : Bài Tập

>>>tiếp ...

;;;8. Viet lenh sao chep noi dung tu Dtext nguon ra dtext khac, chon nguon -> quet chon text dich
(defun c:Mchange_cont_2( / ss1 ss2 cont ent)
(prompt "\nPick chon text can sao noi dung: ")
(setq ss1 (ssget "_+.:E:S" '((0 . "TEXT"))))
(if ss1
	(progn 
		(setq cont (assoc 1 (entget (ssname ss1 0))))
		(prompt "\nChon text can paste noi dung ! ")
		(setq ss2 (ssget '((0 . "TEXT"))))
		(if ss2
			(repeat (sslength ss2)
				(setq ent...
>>

>>>tiếp ...

;;;8. Viet lenh sao chep noi dung tu Dtext nguon ra dtext khac, chon nguon -> quet chon text dich
(defun c:Mchange_cont_2( / ss1 ss2 cont ent)
(prompt "\nPick chon text can sao noi dung: ")
(setq ss1 (ssget "_+.:E:S" '((0 . "TEXT"))))
(if ss1
	(progn 
		(setq cont (assoc 1 (entget (ssname ss1 0))))
		(prompt "\nChon text can paste noi dung ! ")
		(setq ss2 (ssget '((0 . "TEXT"))))
		(if ss2
			(repeat (sslength ss2)
				(setq ent (ssname ss2 0))
				(entmod (append (entget ent) (list cont)))
				(ssdel ent ss2)
			)
		)
	)
)
(princ)
)
;;==================================================================
;;;9. Lenh doi mau sac cua doi tuong nguoi dung pick thanh mau do. Bo qua doi tuong phuc
(defun c:CHANGE_COLOR( / ss)
(prompt "\nPick chon doi tuong muon chuyen sang mau do !")
(while (setq ss (ssget "_+.:E:S" '((-4 . "<NOT") (62 . 1) (-4 . "NOT>"))))
	(entmod (append (entget (ssname ss 0)) (list (cons 62 1))))
)
(princ)
)

Download lisp

Filename: 298982_mchange_cont_2_change_color.lsp

Tác giả: hiepttr
Bài viết gốc: 299283
Tên lệnh: mchange cont 2

Chương 7.2,3 : Bài Tập

Dear Mr Ket ! :D :D :D

- Phân biệt DT & MT vì nếu MT mà dùng append ---> cho kết quả là strcat của 2 string

- Sửa như ở dưới: ...

- Không biết còn cao chiêu gì nữa để dùng append không ?! Song, theo mình nếu dùng append đối với mã 1 cho mtext, mã 10 cho polyline ... thì nó bổ sung vào chứ ko thay thế như yêu cầu đề bài !

===>>> cần chỉ giáo thêm !

- Bài 8, được...

Dear Mr Ket ! :D :D :D

- Phân biệt DT & MT vì nếu MT mà dùng append ---> cho kết quả là strcat của 2 string

- Sửa như ở dưới: ...

===>>> cần chỉ giáo thêm !

- Bài 8, được !

:D :D :D

;;;1. Ham doc ma dxf cua doi tuong. Doi so la ename doi tuong va ma dxf
(defun dxf (ename code)
(cdr (assoc code (entget ename)))
)
;;===========================================================
;;;2. Ham doi thuoc tinh dxf cua 1 doi tuong. Doi so la ename, dxf, gia tri dxf
(defun change_dxf(ename dxf val)
(entmod (subst (cons dxf val) (assoc dxf (setq info (entget ename))) info))
)
;;===========================================================
;;;3_2. Ham thay doi layer cua mot doi tuong. Doi so la ename, layer dich
(defun change_lay(ename lay)
(change_dxf ename 8 lay)
)
;;===========================================================
;;;4_2. Ham thay doi noi dung cua 1 doi tuong la TEXT. Doi so la ename, noi dung dich.
(defun change_cont(ename cont)
(change_dxf ename 1 cont)
)
;;============================================================
;;;5_2. Ham copy noi dung text sang text khac. Doi so la ename nguon, ename dich
(defun cp_cont(ename_nguon ename_dich / info)
(entmod (subst (cons 1 (dxf ename_nguon 1)) (assoc 1 (setq info (entget ename_dich))) info))
)
;Tranh thu tan dung ex.1 tuy ko rut ngan duoc code ^|^ , hic ...
;;============================================================
;;;8_2. Viet lenh sao chep noi dung tu Dtext nguon ra dtext khac, chon nguon -> quet chon text dich
(defun c:Mchange_cont_2( / ss1 ss2 cont ent)
(while (not ss1)
(prompt "\nPick chon text can sao noi dung: ")
(setq ss1 (ssget "_+.:E:S" '((0 . "TEXT"))))
)
(if ss1
	(progn 
		(setq cont (assoc 1 (entget (ssname ss1 0))))
		(prompt "\nChon text can paste noi dung ! ")
		(setq ss2 (ssget '((0 . "TEXT"))))
		(if ss2
			(repeat (sslength ss2)
				(setq ent (ssname ss2 0))
				(entmod (append (entget ent) (list cont)))
				(ssdel ent ss2)
			)
		)
	)
)
(princ)
)

Download lisp

Filename: 299283_mchange_cont_2.lsp

Tác giả: thanhduan2407
Bài viết gốc: 308528
Tên lệnh: cv3d23d

Hỏi về Lisp (thuật toán, ý tưởng, coding,...)

Em dùng một số hàm sau đây để vẽ lại 3D Polyline từ 2D Polyline có các đỉnh đi qua các TEXT.

Tại mỗi đỉnh 2D Polyline em cứ phải duyệt qua tất cả các Text có trong bản vẽ.

Cho em hỏi các bác xem còn cách nào làm tối ưu hơn không ạ?

Đây là CODE của em.

(vl-load-com)
(defun C:CV3D23D(/ Olmode en n ob Pnt_i Lts1 i P1 Pnt_TB  Pnt_DN y ss1 Pnt_i e)
(defun *error* ( msg...
>>

Em dùng một số hàm sau đây để vẽ lại 3D Polyline từ 2D Polyline có các đỉnh đi qua các TEXT.

Tại mỗi đỉnh 2D Polyline em cứ phải duyệt qua tất cả các Text có trong bản vẽ.

Cho em hỏi các bác xem còn cách nào làm tối ưu hơn không ạ?

Đây là CODE của em.

(vl-load-com)
(defun C:CV3D23D(/ Olmode en n ob Pnt_i Lts1 i P1 Pnt_TB  Pnt_DN y ss1 Pnt_i e)
(defun *error* ( msg )
(if Olmode (setvar 'osmode Olmode))
(if (not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
    (princ (strcat "\nError: " msg))
)
(princ)
)
(setq Olmode (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq ss (ssget "_X" (list (cons 0 "TEXT"))))
(setq ss1 (vl-remove nil (mapcar '(lambda(x) (if  (= (acet-dxf 0 (entget x)) "TEXT")  (TD:Text-Base x) nil)) (acet-ss-to-list ss))))
(setq ss2 (vl-sort (vl-sort ss1 '(lambda(x y) (< (car x) (car y)))) '(lambda(x y) (< (cadr x) (cadr y)))))

(setq ssObjPline (ssget (list (cons 0 "*POLYLINE"))))
(setq LtsObjPline (acet-ss-to-list ssObjPline))
(foreach en LtsObjPline
	(CV1PL3D en ss2)
)
(setvar "OSMODE" Olmode)
(princ)
)




(defun CV1PL3D( ObjPline ss2 / Olmode en n ob Pnt_i Lts1 i P1 Pnt_TB  Pnt_DN y ss1 Pnt_i e)
(setvar "OSMODE" 0)
(setq ob (vlax-ename->vla-object ObjPline)
       n (vlax-curve-getEndParam ob)
)
(setq Lts1 (list))
(setq Pnt_i nil)
(setq i 0)
(while (<= i n)
	(progn
		(setq P1 (vlax-curve-getPointAtParam ob i))
		(setq Pnt_text (car (vl-sort ss2 '(lambda(x y) (< (distance x P1) (distance y P1))))))
	  	(if (and (equal (car P1) (car Pnt_text) 0.0000000001) (equal (cadr P1) (cadr Pnt_text) 0.0000000001))
			 (setq Pnt_i Pnt_text)
		  	 (setq Pnt_i P1)
	  	)
		(setq Lts1 (append Lts1 (list Pnt_i)))
	)
(setq i (+ i 1))
)
(entdel ObjPline)
(MakePolyline3D Lts1)
)


(defun TD:Text-Base (ent)
  (setq Ma10  (cdr (assoc 10 (entget ent))))
  (setq Ma11  (cdr (assoc 11 (entget ent))))
  (setq X11 (car Ma11))
  (setq Ma71  (cdr (assoc 71 (entget ent))))
  (setq Ma72  (cdr (assoc 72 (entget ent))))
  (if (or (and (= Ma71 0) (= Ma72 0) (= X11 0))
	  (and (= Ma71 0) (= Ma72 3) )
	  (and (= Ma71 0) (= Ma72 5) )
      )
    Ma10
    Ma11
   )
)


(defun MakePolyline3D (vtcs)
  (entmake
    (list
    '(0 . "POLYLINE")
    '(66 . 1)
    '(70 . 8)
    )
  )
  (foreach vtx vtcs
    (entmake
      (list
      '(0 . "VERTEX")
      (cons 10 vtx)
      '(70 . 32)
      )
    )
  )
  (entmake '((0 . "SEQEND")))
)

Download lisp

Filename: 308528_cv3d23d.lsp

Tác giả: phamngoctukts
Bài viết gốc: 108531
Tên lệnh: recc

Viết lisp theo yêu cầu [phần 2]

Mình chỉnh sửa lại cho đúng ý bạn rồi nhé

Download lisp

Filename: 108531_recc.lsp

Tác giả: Tot77
Bài viết gốc: 308291
Tên lệnh: lnt

Xin linetype hình chữ nhật tiếp giáp nhau

Tôi không biết cách nào tạo linetype như vậy, nhưng bạn có thể dùng lsp này để rải cái block đó.

Điều kiện là trong file phải có cái block tên "VH zig zag" và kích thước của nó theo chiều dài là 1.

Tôi không biết bạn vẽ theo tỉ lệ nào, cho nên cứ xài thử xem sao.

Có điều là nó rải theo khoảng cách chẵn, thí dụ nếu kc = 10.5 thì nó chỉ rải 10 thôi.

>>

Tôi không biết cách nào tạo linetype như vậy, nhưng bạn có thể dùng lsp này để rải cái block đó.

Điều kiện là trong file phải có cái block tên "VH zig zag" và kích thước của nó theo chiều dài là 1.

Tôi không biết bạn vẽ theo tỉ lệ nào, cho nên cứ xài thử xem sao.

Có điều là nó rải theo khoảng cách chẵn, thí dụ nếu kc = 10.5 thì nó chỉ rải 10 thôi.

(defun c:lnt()
  (defun rtd(a) (* 180 (/ a pi)))
  
  (setvar 'insunits 0) 
  (setq a (getpoint))
  (while (setq b (getpoint a))
    (setq n -1)
    (repeat (fix (distance a b))
      (setq n (1+ n))
      (command "-insert" "VH zig zag"
(if (zerop (rem n 2))
 (polar (polar a (angle a b) n) (+ (angle a b) (* 0.5 pi)) 0.05)
 (polar (polar a (angle a b) n) (- (angle a b) (* 0.5 pi)) 0.05))
1 1 (rtd (- (angle a b) (* 0.5 pi)))))
    (setq a b)
  ) (princ)
)

Download lisp

Filename: 308291_lnt.lsp

Tác giả: nhoclangbat
Bài viết gốc: 308928
Tên lệnh: kvv

Lisp ghi tên đường và hướng đi

- Như tiêu đề nhóc mún 1 lsp như trên, nhoc cũng thử mò viết theo ý mình với khả năng của mình, lsp xài cũng được ^^, nhưng vẫn còn thủ công, nay nhoc mún nhờ mí a trên diễn đàn giúp nhoc cải tiến lsp nếu ko mún nói là viết mới hoàn toàn @@ :), ý tưởng của nhoc thế này:

- sau khi chạy lệnh vẫn hỏi nhập tỉ lệ như bình thường

- sau đó sẽ hiện dòng nhắc nhập tên viết tắc...

- sau khi chạy lệnh vẫn hỏi nhập tỉ lệ như bình thường

- sau đó sẽ hiện dòng nhắc nhập tên viết tắc của đường, vd: thd = Trần Hưng Đạo, Trần Hữu Dực,v...v, sau khi nhập lúc này tại con trỏ chuột sẽ hiện đầy đủ tên đường cần ghi, click phải chuột để hiện tên đường tiếp theo ứng với chữ cái đầu viết tắc tên đường, đến khi vừa ý click chuột trái để chọn hướng ghi và ghi lên bản vẽ, ah cụm từ "Đi Đ. " giữ nguyên và sẽ đc nối vào tên đường ^^, còn nếu click hết danh sách mà ko chọn đc tên nào thì thoát lệnh

- thông sô kích thước mũi tên chỉ hướng phía dưới text và đk xoay mũi tên như trong lsp của nhoc ^^

- nhoc nghĩ mún làm đc vậy chắc phải có 1 file txt riêng hoặc file gì đó liệt kệ tên đường tương ứng với chữ viết tắc liên kết với lsp, chứ liệt kê toàn bộ trong lisp chắc nặng lắm, danh sách tên đường bên nhoc có rùi nếu có file liên kết nhoc chỉ cần add vào thui :)

- các a ghé qua rãnh xem giúp nhoc ý tưởng này có thực hiện được không ^^

- đây là lsp thổ dân nhoc viết :

;ghi ten duong va ve mui ten huong di
(defun c:kvv (/ old x d w pt1 pt2 pt3 goc goc270 pt4 pt5 pt6 h f ghep ten ghepten xx )
(setq old (mapcar 'getvar '("cmdecho" "osmode")))
(mapcar 'setvar '("cmdecho" "osmode") '(0 0))
(command "style" "VAVON" "vni-avo" 0 1 0 "" "")
(if (tblsearch "style" "VAVON") (setvar "TEXTSTYLE" "VAVON"))
(if (= tl nil) (setq tl 500))
(setq tl1 (getreal (strcat "\nti le bd ht (" (rtos tl 2 0) "): ")))
(if tl1 (setq tl1 tl))
(setq ten (getstring 1 "\n nhap ten duong:"))
(setq ghep (strcat "Ñi Ñ. ")
      ghepten (strcat ghep ten))
(setq x (/ 1000 tl)); he so tl bd
(setq d (/ 2.2 x); do dai dau mui ten
	  w (/ 0.65 x); do rong mui ten
	  h (/ 1.9 x); cao text
	  f 1); khoang cach giong duoi mui ten voi text
(setq pt1 (getpoint "\n chon diem dau:")
	  pt2 (getpoint pt1 "\n chon diem cuoi:"))
(command ".text" pt1 h pt2 ghepten)
(setq goc (angle pt1 pt2)
	  	  goc270 (- goc (/ PI 2)))
(setq pt3 (polar pt1 goc270 f)
	  pt4 (polar pt3 goc 2.5)
	  pt5 (polar pt4 goc d)
	  pt6 (polar pt3 goc (/ (distance pt3 pt5) 2.0)))
(initget "N Y")
  (setq cove (getkword "\nXoay mui ten <Enter=No/Yes>: "))
  (if (= cove "Y") (setq cove t) (setq cove nil))
(command "pline" pt3 "w" 0.0 0.0 pt4 "w" w 0.0 pt5 "")
(setq xx (entlast))
(if cove
  (progn
     (command "rotate" xx "" pt6 180 ))
	 )

(mapcar 'setvar '("cmdecho" "osmode") old)
(princ "\n")
(princ "xong")
(princ)
)

;ghi ten duong va ve mui ten huong di

(defun c:kvv (/ old x d w pt1 pt2 pt3 goc goc270 pt4 pt5 pt6 h f ghep ten ghepten xx )

(setq old (mapcar 'getvar '("cmdecho" "osmode")))

(mapcar 'setvar '("cmdecho" "osmode") '(0 0))

(command "style" "VAVON" "vni-avo" 0 1 0 "" "")

(if (tblsearch "style" "VAVON") (setvar "TEXTSTYLE" "VAVON"))

(if (= tl nil) (setq tl 500))

(setq tl1 (getreal (strcat "\nti le bd ht (" (rtos tl 2 0) "): ")))

(if tl1 (setq tl1 tl))

(setq ten (getstring 1 "\n nhap ten duong:"))

(setq ghep (strcat "Ñi Ñ. ")

ghepten (strcat ghep ten))

(setq x (/ 1000 tl)); he so tl bd

(setq d (/ 2.2 x); do dai dau mui ten

w (/ 0.65 x); do rong mui ten

h (/ 1.9 x); cao text

f 1); khoang cach giong duoi mui ten voi text

(setq pt1 (getpoint "\n chon diem dau:")

pt2 (getpoint pt1 "\n chon diem cuoi:"))

(command ".text" pt1 h pt2 ghepten)

(setq goc (angle pt1 pt2)

goc270 (- goc (/ PI 2)))

(setq pt3 (polar pt1 goc270 f)

pt4 (polar pt3 goc 2.5)

pt5 (polar pt4 goc d)

pt6 (polar pt3 goc (/ (distance pt3 pt5) 2.0)))

(initget "N Y")

(setq cove (getkword "\nXoay mui ten <Enter=No/Yes>: "))

(if (= cove "Y") (setq cove t) (setq cove nil))

(command "pline" pt3 "w" 0.0 0.0 pt4 "w" w 0.0 pt5 "")

(setq xx (entlast))

(if cove

(progn

(command "rotate" xx "" pt6 180 ))

)

(mapcar 'setvar '("cmdecho" "osmode") old)

(princ "\n")

(princ "xong")

(princ)

)

;ghi ten duong va ve mui ten huong di

(defun c:kvv (/ old x d w pt1 pt2 pt3 goc goc270 pt4 pt5 pt6 h f ghep ten ghepten xx )

(setq old (mapcar 'getvar '("cmdecho" "osmode")))

(mapcar 'setvar '("cmdecho" "osmode") '(0 0))

(command "style" "VAVON" "vni-avo" 0 1 0 "" "")

(if (tblsearch "style" "VAVON") (setvar "TEXTSTYLE" "VAVON"))

(if (= tl nil) (setq tl 500))

(setq tl1 (getreal (strcat "\nti le bd ht (" (rtos tl 2 0) "): ")))

(if tl1 (setq tl1 tl))

(setq ten (getstring 1 "\n nhap ten duong:"))

(setq ghep (strcat "Ñi Ñ. ")

ghepten (strcat ghep ten))

(setq x (/ 1000 tl)); he so tl bd

(setq d (/ 2.2 x); do dai dau mui ten

w (/ 0.65 x); do rong mui ten

h (/ 1.9 x); cao text

f 1); khoang cach giong duoi mui ten voi text

(setq pt1 (getpoint "\n chon diem dau:")

pt2 (getpoint pt1 "\n chon diem cuoi:"))

(command ".text" pt1 h pt2 ghepten)

(setq goc (angle pt1 pt2)

goc270 (- goc (/ PI 2)))

(setq pt3 (polar pt1 goc270 f)

pt4 (polar pt3 goc 2.5)

pt5 (polar pt4 goc d)

pt6 (polar pt3 goc (/ (distance pt3 pt5) 2.0)))

(initget "N Y")

(setq cove (getkword "\nXoay mui ten <Enter=No/Yes>: "))

(if (= cove "Y") (setq cove t) (setq cove nil))

(command "pline" pt3 "w" 0.0 0.0 pt4 "w" w 0.0 pt5 "")

(setq xx (entlast))

(if cove

(progn

(command "rotate" xx "" pt6 180 ))

)

(mapcar 'setvar '("cmdecho" "osmode") old)

(princ "\n")

(princ "xong")

(princ)

)

Download lisp

Filename: 308928_kvv.lsp

Tác giả: Tot77
Bài viết gốc: 308856
Tên lệnh: lnt

Xin linetype hình chữ nhật tiếp giáp nhau

Đâu có rải vuông góc!! Bạn gõ lnt xong thì chọn điểm giống như vẽ line vậy thôi, nó rải doc theo line.

Vì thấy vẽ line đơn giản nên tôi không thêm dòng nào ở command, còn nếu bạn muốn thêm thì down cái này.

(defun c:lnt()
  (defun rtd(a) (* 180 (/ a pi)))
  
  (setvar 'insunits 0) 
  (setq a (getpoint "\nChon diem bat dau:"))
  (while (setq b (getpoint a "\nChon diem tiep...
>>

Đâu có rải vuông góc!! Bạn gõ lnt xong thì chọn điểm giống như vẽ line vậy thôi, nó rải doc theo line.

Vì thấy vẽ line đơn giản nên tôi không thêm dòng nào ở command, còn nếu bạn muốn thêm thì down cái này.

(defun c:lnt()
  (defun rtd(a) (* 180 (/ a pi)))
  
  (setvar 'insunits 0) 
  (setq a (getpoint "\nChon diem bat dau:"))
  (while (setq b (getpoint a "\nChon diem tiep theo:"))
    (setq n -1)
    (repeat (fix (distance a b))
      (setq n (1+ n))
      (command "-insert" "VH zig zag"
(if (zerop (rem n 2))
 (polar (polar a (angle a b) n) (+ (angle a b) (* 0.5 pi)) 0.05)
 (polar (polar a (angle a b) n) (- (angle a b) (* 0.5 pi)) 0.05))
1 1 (rtd (- (angle a b) (* 0.5 pi)))))
    (setq a b)
  ) (princ)
)

Download lisp

Filename: 308856_lnt.lsp

Tác giả: thanhduan2407
Bài viết gốc: 309044
Tên lệnh: tvg

Entmod đối với điểm chèn của đối tượng Text

Chào các bác!

Từ trước đến giờ em vẫn băn khoăn với điểm chèn của Text.

Thường thì căn chỉnh lề của TEXT là LEFT thì không vấn đề gì nhưng nếu căn chỉnh TEXT ở dạng khác thì việc Entmod Text sẽ có vấn đề xảy ra.

Text có 2 mã để lấy toạ độ là 10 và 11.

1. Nếu em có 1 điểm toạ độ mới làm thế nào để cho điểm chèn chuẩn của Text...

Chào các bác!

Từ trước đến giờ em vẫn băn khoăn với điểm chèn của Text.

Thường thì căn chỉnh lề của TEXT là LEFT thì không vấn đề gì nhưng nếu căn chỉnh TEXT ở dạng khác thì việc Entmod Text sẽ có vấn đề xảy ra.

Text có 2 mã để lấy toạ độ là 10 và 11.

1. Nếu em có 1 điểm toạ độ mới làm thế nào để cho điểm chèn chuẩn của Text đúng với toạ độ mới đó?

2. Em có 1 đoạn lisp move Text vuông góc với Line hoặc Pline. Nhưng nó chỉ có tác dụng với đối tượng Text căn chỉnh dạng Left.

Nhờ các bác kiểm tra và xem nguyên nhân vì sao ạ?

(defun c:TVG(/ Obj ss );;;;TEXT VUONG GOC
(setq obj (vlax-ename->vla-object (car (entsel "\nChon Line hoac Polyline:"))))
(prompt "\nChon text:")
(setq ss (ssget '((0 . "TEXT"))))
  (mapcar '(lambda(x) (vla-put-InsertionPoint (vlax-ename->vla-object x) (vlax-3d-point (vlax-curve-getClosestPointTo obj (TD:TEXTBASE x) T)))) (acet-ss-to-list ss))
)
(defun TD:TEXTBASE (Ent / Ma72 Ma73  Ma7273Pnt MaBase   )
(setq e (entget Ent))
(setq  Ma72 (cdr (assoc 72 e))
       Ma73 (cdr (assoc 73 e))
)
(setq Ma7273Pnt (list '(0 0 10) '(2 0 11) '(1 0 11) '(3 0 11) '(4 0 11)
		      '(5 0 10) '(0 3 10) '(1 3 11) '(2 3 11) '(0 2 11)
		      '(1 2 11) '(2 2 11) '(0 1 11) '(1 1 11) '(2 1 11)
		)
)
(setq MaBase (nth 0 (vl-remove nil (mapcar '(lambda(x) (if (and (= Ma72 (car x) ) (= Ma73 (cadr x))) (caddr x) nil)) Ma7273Pnt))))
(setq Pnt  (cdr (assoc MaBase (entget ent))))
Pnt
)

Download lisp

Filename: 309044_tvg.lsp

Tác giả: Tot77
Bài viết gốc: 309063
Tên lệnh: ddo

Lisp tính cao độ khi biết cao độ và độ dốc

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

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

(defun c:ddo( / a b txt tt1 sole dd1 vt)
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (setq a (getpoint "\nChon diem da biet cao do: ")
txt (car (entsel "\nText cao do tuong ung: "))
tt1 (dxf 1 txt)
sole (if (setq vt...
>>

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

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

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

Download lisp

Filename: 309063_ddo.lsp

Tác giả: nhoclangbat
Bài viết gốc: 309112
Tên lệnh: clt

Xin lisp nội suy cao độ từ 2 điểm (3 điểm nằm trên 1 đoạn thẳng)

hihi rãnh rãnh nhóc nghịch chơi, ko pit có làm hư lsp ko mình test so sánh chưa sữa với sữa cũng đúng cao độ text in ra và thỏa yêu cầu cho properties text có z=0 của bạn, còn số hiển thị trên text vẫn đúng cao độ cần tìm ^^

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/107133-xin-lisp-noi-suy-cao-do-tu-2-diem-3-diem-nam-tren-1-doan-thang/
;; free...
>>

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/107133-xin-lisp-noi-suy-cao-do-tu-2-diem-3-diem-nam-tren-1-doan-thang/
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/107133-xin-lisp-noi-suy-cao-do-tu-2-diem-3-diem-nam-tren-1-doan-thang/
;;;L?y t?a d? chu?n c?a Text
(defun TD:Text-Base (ent)
  (setq Ma10  (cdr (assoc 10 (entget ent))))
  (setq Ma11  (cdr (assoc 11 (entget ent))))
  (setq X11 (car Ma11))
  (setq Ma71  (cdr (assoc 71 (entget ent))))
  (setq Ma72  (cdr (assoc 72 (entget ent))))
  (if (or (and (= Ma71 0) (= Ma72 0) (= X11 0))
	  (and (= Ma71 0) (= Ma72 3) )
	  (and (= Ma71 0) (= Ma72 5) )
      )
    Ma10
    Ma11
   )
)
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/107133-xin-lisp-noi-suy-cao-do-tu-2-diem-3-diem-nam-tren-1-doan-thang/
;;;;T?o Layer 
(defun _layer2 ( name colour )
    (if (null (tblsearch "LAYER" name))
        (entmake
            (list
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
               '(70 . 0)
                (cons 2 name)
                (cons 62 colour)
            )
        )
    )
)
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/107133-xin-lisp-noi-suy-cao-do-tu-2-diem-3-diem-nam-tren-1-doan-thang/
;;;;Make by Thaistreetz
(defun MakeText (point string Height Ang justify  Layer  / Lst); Ang: Radial
	(setq Lst (list '(0 . "TEXT")
									(cons 10 point)
									(cons 40 Height)
									(cons 1 string)
								        (cons 50 Ang)
									(cons 8 Layer)
			)
				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)
  )



(defun c:clt(/ chieucao  stt  item1 temp1 Tdo1 X1 Y1 Z1 Caodo1 item2 Tdo2 X2 Y2 Z2 Caodo2 pt1 pt2 pt3 X3 Y3 Z3 z4 d1 d2 d dh dhz Caodo3) ;chen lien tiep tu 2 diem 
		(or *chieucao* (setq *chieucao* 1))
		(setq chieucao (getreal (strcat "\n Chieu cao text <"
					  (rtos *chieucao* 2 2)
					 "> :"
				  )
			 )
		)
		(if (not chieucao) (setq chieucao *chieucao*) (setq *chieucao* chieucao))
  	    (setq stt 1)
  	    (_layer2 "Them_lt" 6)
            (setq Olmode (getvar "OSMODE"))
  	    
  (progn
            (setq item1 (entsel "\nChon text thu nhat : "))
  	    (setq temp1  (entget (car item1)))
	    (setq Tdo1 (TD:Text-Base (car item1 )))
	    (setq  Caodo1 (cdr (assoc 1 temp1))
	              x1 (car Tdo1)
	              y1 (cadr Tdo1)
            )
	    (setq pt1 (list x1 y1))
            (setq  z1 (atof Caodo1))
  
            (setq item2 (entsel "\nChon text thu hai : "))
  	    (setq temp2  (entget (car item2)))
	    (setq Tdo2 (TD:Text-Base (car item2 )))
	    (setq  Caodo2 (cdr (assoc 1 temp2))
	              x2 (car Tdo2)
	              y2 (cadr Tdo2)
            )
            (setq pt2 (list x2 y2))
            (setq z2 (atof Caodo2))
    )
            
  (while
         (progn
         (setvar "OSMODE" 512 )
            (setq pt3 (getpoint "\nVi tri chen diem : "))
            (setq x3 (car pt3))
            (setq y3 (cadr pt3))
            (setq d1 (distance pt1 pt3))
            (setq d2 (distance pt2 pt3))
            (setq d (+ d1 d2))
            (setq dh (- z2 z1))
            (setq dhz (* dh (/ d1 d)))
            (setq z3 (+ z1 dhz))
			(setq z4 0)
            (setq Caodo3 (rtos z3 2 3))
            (setq pt3 (list x3 y3 z4))
	    (MakeText pt3 Caodo3 chieucao 0 "C" "Them_lt")
	   (setq stt (+ stt 1))
      )
   )
   (setvar "OSMODE" Olmode )
   (princ)
)

- ah còn vụ canh lề với osnap bạn tự sữa hen, nhoc tải lsp góc nên làm biếng :)

Download lisp

Filename: 309112_clt.lsp

Tác giả: gia_bach
Bài viết gốc: 309133
Tên lệnh: tvg

Entmod đối với điểm chèn của đối tượng Text

Hì hì. Tại em biết ít hàm vl- quá nên phải làm thủ công bác ạ.

Bác có thể cho em xin 1 ít kiến thức về Vl- Vlax...ko ạ?

Em thích nó lắm nhưng mò mẫm hơi lâu.

ví dụ dùng vl :

(defun c:TVG(/ Obj ss );;;;TEXT VUONG GOC
  (if (and (setq obj (vlax-ename->vla-object (car...
>>

Hì hì. Tại em biết ít hàm vl- quá nên phải làm thủ công bác ạ.

Bác có thể cho em xin 1 ít kiến thức về Vl- Vlax...ko ạ?

Em thích nó lắm nhưng mò mẫm hơi lâu.

ví dụ dùng vl :

(defun c:TVG(/ Obj ss );;;;TEXT VUONG GOC
  (if (and (setq obj (vlax-ename->vla-object (car (entsel "\nChon Line hoac Polyline:"))))
	   (not(prompt "\nChon text:"))
	   (setq ss (ssget '((0 . "TEXT")))) )
  (vlax-for e (vla-get-activeSelectionSet (vla-get-ActiveDocument(vlax-get-acad-object)))    
    (if (equal (vlax-safearray->list (variant-value (vla-get-TextAlignmentPoint e))) '(0.0 0.0 0.0) 0.001)
      (vla-put-InsertionPoint e (vlax-3d-point (vlax-curve-getClosestPointTo obj
						 (vlax-safearray->list (variant-value (vla-get-InsertionPoint e))) T)))
      (vla-put-TextAlignmentPoint e (vlax-3d-point (vlax-curve-getClosestPointTo obj
						     (vlax-safearray->list (variant-value (vla-get-TextAlignmentPoint e))) T))) )  )))

Download lisp

Filename: 309133_tvg.lsp

Tác giả: Tot77
Bài viết gốc: 309135
Tên lệnh: rdi

Nhờ Viết Lisp

Bạn dùng cái này, dùng được cho cả line,pline,spline,arc,circle... trừ block.

Chọn đối tượng, nhập khoảng cách (cách nhau bởi dấu phẩy) thí dụ : 1.2,2.3,500,1000

chọn diểm bắt đầu (điểm bất kỳ trên đối tượng), chọn điểm cuối (để biết rải theo hướng nào).

Nó sẽ rải point theo thứ tự.

(defun c:rdi(/ vat st1 st2 dd dd1 dc dc1 lenh kc)
 ...
>>

Bạn dùng cái này, dùng được cho cả line,pline,spline,arc,circle... trừ block.

Chọn đối tượng, nhập khoảng cách (cách nhau bởi dấu phẩy) thí dụ : 1.2,2.3,500,1000

chọn diểm bắt đầu (điểm bất kỳ trên đối tượng), chọn điểm cuối (để biết rải theo hướng nào).

Nó sẽ rải point theo thứ tự.

(defun c:rdi(/ vat st1 st2 dd dd1 dc dc1 lenh kc)
  (if (/= 3 (getvar 'pdmode)) (setvar 'pdmode 3))
  (setq vat (car (entsel "\nChon doi tuong:"))
st1 (getstring (strcat "\nKhoang cach <" (if st st "") ">:")))
  (if (/= st1 "") (setq st st1))
  (setq st2 (read (strcat "(" (vl-list->string (subst 32 44 (vl-string->list st))) ")"))
dd (getpoint "\nDiem dau:")
        dc (getpoint "\nDiem cuoi:")
dd1 (vlax-curve-getDistAtPoint vat dd)
dc1 (vlax-curve-getDistAtPoint vat dc)
lenh (if (> dc1 dd1) + -)
kc dd1
  )
  (foreach v st2      
    (command "point" (vlax-curve-getPointAtDist vat (setq kc (lenh kc v)))))
  (princ)
)

Download lisp

Filename: 309135_rdi.lsp

Tác giả: Tot77
Bài viết gốc: 309070
Tên lệnh: tvg

Entmod đối với điểm chèn của đối tượng Text

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

 
(defun c:TVG(/ Obj ss );;;;TEXT VUONG GOC
  (setq obj (vlax-ename->vla-object (car (entsel "\nChon Line hoac Polyline:"))))
  (prompt "\nChon text:")
  (setq ss (ssget '((0 . "TEXT"))))
  (mapcar '(lambda(x / tm)
    (setq tm (TD:TEXTBASE x))
    (if (= (car tm) 10)
      (vla-put-InsertionPoint (vlax-ename->vla-object x) (vlax-3d-point (vlax-curve-getClosestPointTo obj (last tm) T)))
     ...
>>

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

 
(defun c:TVG(/ Obj ss );;;;TEXT VUONG GOC
  (setq obj (vlax-ename->vla-object (car (entsel "\nChon Line hoac Polyline:"))))
  (prompt "\nChon text:")
  (setq ss (ssget '((0 . "TEXT"))))
  (mapcar '(lambda(x / tm)
    (setq tm (TD:TEXTBASE x))
    (if (= (car tm) 10)
      (vla-put-InsertionPoint (vlax-ename->vla-object x) (vlax-3d-point (vlax-curve-getClosestPointTo obj (last tm) T)))
      (vla-put-TextAlignmentPoint (vlax-ename->vla-object x) (vlax-3d-point (vlax-curve-getClosestPointTo obj (last tm) T)))
      ))
 (acet-ss-to-list ss))
)
 
(defun TD:TEXTBASE (Ent / Ma72 Ma73  Ma7273Pnt MaBase   )
  (setq e (entget Ent))
  (setq  Ma72 (cdr (assoc 72 e))
         Ma73 (cdr (assoc 73 e))
  )
  (setq Ma7273Pnt (list '(0 0 10) '(2 0 11) '(1 0 11) '(3 0 11) '(4 0 11)
     '(5 0 10) '(0 3 10) '(1 3 11) '(2 3 11) '(0 2 11)
     '(1 2 11) '(2 2 11) '(0 1 11) '(1 1 11) '(2 1 11)
)
  )
  (setq MaBase (nth 0 (vl-remove nil (mapcar '(lambda(x) (if (and (= Ma72 (car x) ) (= Ma73 (cadr x))) (caddr x) nil)) Ma7273Pnt))))
  (setq Pnt  (cdr (assoc MaBase (entget ent))))
  (list MaBase Pnt)
)

Download lisp

Filename: 309070_tvg.lsp

Tác giả: Tot77
Bài viết gốc: 309262
Tên lệnh: dem

LISP KIỂM TRA CÁC TEXT TRÙNG NỘI DUNG!

Bạn dùng cái này. Những text nào trùng nhau thì nó chuyển sang layer 0 và đổi màu theo từng cặp.

Chỉ cần đánh lệnh thôi. Cuối lệnh nó sẽ ghi lên dòng command những cái trùng nhau.

(defun c:dem(/ l0 l1 ss n)
  (setvar 'cmdecho 0)
  (setq ss (ssget "X" '((0 . "TEXT")(1 . "~**")))
l0 (vl-remove-if-not '(lambda (x) (= 11 (strlen (cdr (assoc 1 (entget x))))))
    (vl-remove-if 'listp (mapcar...
>>

Bạn dùng cái này. Những text nào trùng nhau thì nó chuyển sang layer 0 và đổi màu theo từng cặp.

Chỉ cần đánh lệnh thôi. Cuối lệnh nó sẽ ghi lên dòng command những cái trùng nhau.

(defun c:dem(/ l0 l1 ss n)
  (setvar 'cmdecho 0)
  (setq ss (ssget "X" '((0 . "TEXT")(1 . "~**")))
l0 (vl-remove-if-not '(lambda (x) (= 11 (strlen (cdr (assoc 1 (entget x))))))
    (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
l1 nil
  )
  (mapcar '(lambda(x) (if (setq pair (assoc (setq chu (cdr (assoc 1 (entget x)))) l1))
(setq l1 (subst (cons chu (1+ (cdr pair))) pair l1))
(setq l1 (cons (cons chu 1) l1)))) l0)
  (setq l1 (vl-remove-if '(lambda (x) (= (cdr x) 1)) l1)
n 0)
  (foreach v l1
    (command "change" (ssget "X" (list '(0 . "TEXT") (cons 1 (car v)))) ""
    "P" "LA" "0" "C" (itoa (setq n (1+ n))) ""))
  (setvar 'cmdecho 1) (princ l1) (princ)
)

Download lisp

Filename: 309262_dem.lsp

Tác giả: Doan Van Ha
Bài viết gốc: 309280
Tên lệnh: ha

Entmod đối với điểm chèn của đối tượng Text

Lisp của bác Gia_bach thiếu vài trường hợp. Có vẽ như cái này thì phù hợp với ý tưởng của em?

(defun C:HA(/ obj pg);;;;TEXT VUONG GOC

(if

(and

(setq obj (vlax-ename->vla-object (car (entsel "\nChon Line hoac Polyline:"))))

(not (prompt "\nChon text:"))

(ssget '((0 . "TEXT"))))

(vlax-for e (vla-get-activeSelectionSet (vla-get-ActiveDocument...

Download lisp

Filename: 309280_ha.lsp

Tác giả: thanhduan2407
Bài viết gốc: 309340
Tên lệnh: cvt3d

Entmod đối với điểm chèn của đối tượng Text

Nhờ các hàm của các bác mà em đã hoàn thiện LISP CONVERT TEXT 3D rồi ạ.

(defun C:CVT3D(/ ss0 ss ss1 ss2 item Caodo Pn)
(vl-load-com)
(setq ss (ssget (list (cons 0  "TEXT"))))
(setq ss1 (ChonTextSo ss))
(setq ss2 (acet-ss-to-list ss1))
(foreach item ss2
	(setq temp (entget item))
	(setq Caodo (cdr (assoc 1 temp)))
  	(setq e (vlax-ename->vla-object item))
  	(setq P1 (vlax-get e 'InsertionPoint))
	(setq Pnt (list (car P1) (cadr P1)...
>>

Nhờ các hàm của các bác mà em đã hoàn thiện LISP CONVERT TEXT 3D rồi ạ.

(defun C:CVT3D(/ ss0 ss ss1 ss2 item Caodo Pn)
(vl-load-com)
(setq ss (ssget (list (cons 0  "TEXT"))))
(setq ss1 (ChonTextSo ss))
(setq ss2 (acet-ss-to-list ss1))
(foreach item ss2
	(setq temp (entget item))
	(setq Caodo (cdr (assoc 1 temp)))
  	(setq e (vlax-ename->vla-object item))
  	(setq P1 (vlax-get e 'InsertionPoint))
	(setq Pnt (list (car P1) (cadr P1) (atof Caodo)))
  	(vla-move (vlax-ename->vla-object item) (vlax-3d-point P1) (vlax-3d-point Pnt))
)
(princ)
)

(defun ChonTextSo (ss / ss i ent str ss1) 
    (progn
      (setq i	0
	    ss1	(ssadd)
      )
      (repeat (sslength ss)
	(setq ent (ssname ss i)
	      str (cdr(assoc 1 (entget ent)))
	      i	  (+ 1 i)
	)
	(if (distof str 2)
	  (ssadd ent ss1)
	)
      )
      (if (> (sslength ss1) 0)
	ss1
      )      
    )
)

Download lisp

Filename: 309340_cvt3d.lsp

Tác giả: nhoclangbat
Bài viết gốc: 309363
Tên lệnh: angsidet ast

Nhờ giúp lisp lấy tọa độ x,y

hehe nghịch tí, ko phải lsp của nhoc, nhoc chôm của người ta ^^, nhưng nhoc ráng sửa cho đúng ý đồ của bạn, phần xuất ra txt y chang mẫu bạn đưa lên , chỉ khác chỗ tọa độ x y thay bằng số pick đc trên cad, lệnh là "AST" sau khi đánh lệnh kêu bạn chọn trạm máy với điểm định hướng bạn pick đại đâu cũng đc chủ yếu là để lấy cái cơ sở tính ra tọa độ bạn cần pick thui :))

>>

(defun INPUTST (Pt0 num2	Sln user / ang2	delang dis st dl dat Htext d1 d2
	       d3 d4)
  (setvar "texteval" 1)
  (setq htext 0.75)
  (setq ang2 (angle base PT0))
  (setq delang (- ang ang2))
  (if (< delang 0)
    (setq delang (+ delang (* 2 pi)))
  )
  (setq dis (* (distance base PT0) (expt user -1)))
  (setq SLn (max delang dis Sln))
  (setq st (strcat " " (itoa num2)))
  (setq Dat (list delang dis))
  (setq Ldata (append Ldata Dat (list (cadr PT0) (car PT0))))
  (setvar "Osmode" 0)
  (command "_layer" "s" "mia" "")
  (setq d1 (Polar pt0 0 0.27))
  (setq d2 (Polar pt0 (/ pi 2) 0.27))
  (setq d3 (Polar pt0 pi 0.27))
  (setq d4 (Polar pt0 (* 1.5 pi) 0.27))
  (command "Line" d1 d3 "")
  (command "Line" d2 d4 "")
  (command "_layer" "s" "somia" "")
  (command "Text" "S" "vhelvei" "Bl" pt0 htext "0" St)
)
;;;
(defun RatoST (Ra / kq Deg du Mi sec stemp stp str)
  (setq kq (/ (* Ra 180.0) pi))
  (setq Deg (fix kq))
  (setq du (- kq Deg))
  (setq du3 (* du 60.0))
  (setq Mi (fix du3))
  (setq sec (* (- du3 Mi) 60.0))
  (setq sec (fix sec))
  (setq stemp (itoa Mi))
  (setq deg (itoa Deg))
  (if (< (strlen stemp) 2)
    (setq stemp (strcat "0" stemp))
  )
  (setq stp (itoa sec))
  (if (< (strlen stp) 2)
    (setq stp (strcat "0" stp))
  )
  (if (< (strlen deg) 2)
    (setq deg (strcat "0" deg))
  )
;;;  (if (< (strlen deg) 3)
;;;    (setq deg (strcat "0" deg))
;;;  )
  (setq str (strcat Deg "." stemp stp ))
)
;;;
;;;PHAN XuatT RA MAN HINH DO HOA
(defun XuatT (Spoint LData  MaxLen num3	 /	Osm    L1     htext
	     Hc	    Lenghthy	  p1	 p2	p3     p3x    p3y
	     p4	    p5	   p6	  p7	 p8	p31    p32    p71
	     p72    ptd	 Pd Pd1 Pd2 Pd3 Pd3X Pd3Y  pstt	  pang	 Pside	j      dl     toadY
	     toadX
	    )
  (setq Osm (getvar "Osmode"))
  (setvar "Osmode" 0)
  (setvar "texteval" 1)
  (setq htext (getvar "Textsize"))
  (setq	L1 (* Htext 5)
	hC (* Htext 3)
  )
  (setq MaxLen (* MaxLen Htext 0.4))
  (setq Lenghthy (+ L1 (* MaxLen 3)))
  (setq p1 (getpoint "\n Diem dat bang toa do :"))
  (command "_layer" "s" "bang_toado" "")
  (if (/= p1 nil)
    (progn
      (setq p2 (Polar p1 0 Lenghthy))
      (setq p3 (Polar p1 (* 1.5 pi) hc))
      (setq p4 (Polar p3 0 Lenghthy))
      (setq p5 (Polar p3 (* 1.5 pi) hc))
      (setq p6 (Polar p5 0 Lenghthy))
      (setq p7 (Polar p5 (* 1.5 pi) (* (1+ Spoint) hc)))
      (setq p8 (Polar p7 0 Lenghthy))
      (setq p31 (Polar p3 0 L1))
      (setq p32 (Polar p31 0 MaxLen))
      (setq p33 (Polar p32 0 MaxLen))
      (setq p71 (Polar p7 0 L1))
      (setq p72 (Polar p71 0 MaxLen))
      (setq p73 (Polar p72 0 MaxLen))
      (command "Line" p1 p2 p8 p7 "c")
      (command "Line" p3 p4 "")
      (command "Line" p5 p6 "")
      (command "Line" p7 p8 "")
      (command "Line" p31 p71 "")
      (command "Line" p32 p72 "")
      (command "Line" p33 p73 "")
      (setq ptd (mapcar '+ p1 (list (/ Lenghthy 2) (- (/ hC 2)))))
      (setq pstt (mapcar '+ p3 (list (/ L1 2) (- (/ hC 2)))))
      (setq pang (mapcar '+ pstt (list (/ (+ MaxLen L1) 2) 0)))
      (setq Pside (mapcar '+ pang (list MaxLen 0)))
      (setq Pnot (mapcar '+ Pside (list MaxLen 0)))
      (command "_layer" "s" "bang_toado" "")
      (command "text"	       "S"	       "vhelveb"
	       "MC"	       ptd	       Htext
	       "0"	       "BANG THONG KE TOA DO"
	      )
      (command "text" "MC" pstt Htext "0" "STT")
      
      (command "text" "MC" Pnot Htext "0" "                           TOADO X            TOADO Y")
      (setq j 0) 
      (setq n 1)
      (repeat Spoint
	(setq Pd1 (mapcar '+ p5 (list (/ L1 2) (- (* hC n)))))
	(setq Pd2 (Polar pd1 0 (/ (+ L1 MaxLen) 2)))

	(setq Pd3 (mapcar '+ pd2 (list MaxLen 0)))
	(setq Pd3X (mapcar '+ Pd3 (list MaxLen 0)))
	(setq Pd3Y (mapcar '+ Pd3X (list MaxLen 0)))
	(setq delang (Nth j Ldata))
	(setq dis (Nth (+ j 1) Ldata))
	(setq toadY (Nth (+ j 2) Ldata))
	(setq toadX (Nth (+ j 3) Ldata))

	(command "text" "S" "vaptimn" "c" pd1 Htext "0" (itoa num3))
	
	(setq dis (rtos dis 2 3))
	(setq toadY (rtos toadY 2 3))
	(setq toadX (rtos toadX 2 3))
;;;	(while (< (strlen dis) 9)
;;;	  (setq dis (strcat "0" dis))
;;;	)
;;;	(setq dis1 (substr dis 1 5))
;;;	(setq dis2 (substr dis 7 9))
;;;	(setq dis (strcat dis1 dis2))
	(setq st (strcat (itoa n) "\t" (RatoST delang) "\t" dis))

	
	(command "text" "S" "vaptimn" "C" pd3X Htext "0" toadY)
	(command "text" "S" "vaptimn" "C" pd3Y Htext "0" toadX)
	(setq j (+ j 4))
	(setq n (1+ n))
	(setq num3 (1+ num3))
      )					;repeat
    )
  )
  (setvar "Osmode" Osm)
)
;;;
;;;PHAN CHUNG TRINH CHINH
;;;
(defun C:AngSideT (/	 d1	d2     d3     d4     num3   num
		  num1	 num2	lupreccu      units  Andir  Anu
		  user	 sc	Base   PT     ang    pt0    i
		  Nmax	 Ldata	MaxLen Spoint TL
		 )
  (setvar "dimzin" 1)
  (setvar "cmdecho" 1)
  (setq unts (getvar "lunits"))
  (setvar "lunits" 2)
					;them
  (setvar "luprec" 3)
  (setq Andir (getvar "Angdir"))
  (setvar "angdir" 0)
  (setq Anu (getvar "AUNITS"))
  (setvar "AUNITS" 0)
  (setq user (getvar "USERR1"))
  (if (= user 0)
    (progn
      (setq user 1)
      (setvar "USERR1" 1)
    )
  )
;;;  (setq sc (getreal (strcat "\nTy le ban ve (nhap day du)<" (rtos user) ">:")))
;;;  (if (and (/= sc nil) (/= sc 0))  (setvar "USERR1" sc))
;;;  (setq user (getvar "USERR1"))
  (if (null (tblsearch "layer" "mia"))
    (command "_layer" "N" "mia" "")
  )
  (if (null (tblsearch "layer" "somia"))
    (command "_layer" "N" "somia" "")
  )
  (if (null (tblsearch "layer" "trammay"))
    (command "_layer" "N" "trammay" "")
  )
  (if (null (tblsearch "layer" "bang_toado"))
    (command "_layer" "n" "bang_toado" "")
  )
  (if (null (tblsearch "style" "vhelvei"))
    (command "_style" "vhelvei" "vhelvei.ttf" "" "" "" "" "")
  )
  (if (null (tblsearch "style" "vhelveb"))
    (command "_style" "vhelveb" "vhelveb.ttf" "" "" "" "" "")
  )
  (if (null (tblsearch "style" "vaptimn"))
    (command "_style" "vaptimn" "vaptimn.ttf" "" "" "" "" "")
  )
  (command "_layer" "c" "7" "bang_toado" "")
  (command "_layer" "c" "1" "somia" "")
  (command "_layer" "c" "3" "mia" "")
  (initget 1)
  (setvar "Osmode" 33)
  (setq Base (getpoint "\nTram may: "))
  (command "_layer" "s" "trammay" "")
  (setq d1 (Polar base 0 0.27))
  (setq d2 (Polar base (/ pi 2) 0.27))
  (setq d3 (Polar base pi 0.27))
  (setq d4 (Polar base (* 1.5 pi) 0.27))
  (setvar "Osmode" 0)
  (command "Line" d1 d3 "")
  (command "Line" d2 d4 "")
  (command "CIRCLE" base 0.22)
  (setvar "Osmode" 33)
  (setq PT (getpoint base "\nHuong ngam: "))
  (setq ang (angle base PT))
  (setq d1 (Polar pt 0 0.27))
  (setq d2 (Polar pt (/ pi 2) 0.27))
  (setq d3 (Polar pt pi 0.27))
  (setq d4 (Polar pt (* 1.5 pi) 0.27))
  (setvar "Osmode" 0)
  (command "Line" d1 d3 "")
  (command "Line" d2 d4 "")
  (command "CIRCLE" pt 0.22)
  (setq num (getint "\nSo bat dau:"))
  (setq num2 num)
  (setq num1 num)
  (setq num3 num)
  (setvar "Osmode" 545)
  (setq pt0 (getpoint base "\nMia:"))
  (setq	i 1
	Ldata nil
  )
  (setq Nmax 1)
  (while (/= pt0 nil)
    (INPUTST pt0 num2 Nmax user)
    (setvar "Osmode" 1)
    (setq pt0 (getpoint base "\nSelect endpoints:"))
    (setq num2 (1+ num2))
    (setq i (+ i 1))
  )
  (setq Spoint (- i 1))
  (setq MaxLen (* (strlen (angtos Nmax 1 4)) 3))
  (XuatT Spoint Ldata MaxLen num3)
;;;  (initget 1 "Yes No")
;;;  (setq TL (getKword "\nCo ghi du lieu ra file?<N>:"))
;;;  (if (= TL "Yes")
  (SaveT Ldata Spoint num1)

  (setvar "AUNITS" Anu)
  (setvar "lunits" unts)
  (setvar "angdir" Andir)
  (setvar "cmdecho" 1)
  (princ)
)
;;;
;;;PHAN GHI VAO FILE
(defun SaveT (Ldata Spoint num1 / Fname Fn j n delang dis toadY toadX)
  (setq fname (Getfiled "TAO FILE MOI" "" "Txt" 1))
  (setq fn (OPEN Fname "W"))
  (setq j 0)
  (setvar "luprec" 3)
  (setq n num1)
  (Write-line "BEGIN" fn)
  (Write-line "TiTle" fn)
  (repeat Spoint
    (setq delang (Nth j Ldata))
    (setq dis (Nth (+ j 1) Ldata))
    (setq toadY (Nth (+ j 2) Ldata))
	(setq toadX (Nth (+ j 3) Ldata))
    (setq toadY (rtos toadY 2 3))
	(setq toadX (rtos toadX 2 3))
    (setq dis (rtos dis 2 3))
;;;    (while (< (strlen dis) 9)
;;;      (setq dis (strcat "0" dis))
;;;    )
;;;    (setq dis1 (substr dis 1 5))
;;;    (setq dis2 (substr dis 7 9))
;;;    (setq dis (strcat dis1 dis2))
    (setq st (strcat "NOI DUNG 1, " "\t" "NOI DUNG 2, " "\t" toadY "\t" "\t" toadX "\t" "\t" "NOIDUNG 3"))
    (Write-line st fn)
	(setq j (+ j 4))
    (setq n (+ 1 n))
	
  );repeat	
  (Write-line "end" fn)  
  (close fn)
)
;;;

(defun C:AST ()
  (setvar "dimzin" 1)
  (C:AngSideT)
)
(print "Start by command AngSideT or AST")

Download lisp

Filename: 309363_angsidet_ast.lsp

Tác giả: thanhduan2407
Bài viết gốc: 309486
Tên lệnh: srd

Lisp tạo một số ngẫu nhiên trong khoảng nhập vào

Với góp ý anh Tot77 em có chương trình gửi lên để ai cần mng dùng.

(defun c:SRD(/ );;;;SO RANDOM
(setq i 0)
(setvar "CMDECHO" 0)
(or *a* (setq *a* 0))
(setq a (getreal (strcat "\n \nNhap so nho:  <"
		  (rtos *a* 2 0)
		 "> :"
	  )
 )
)
(if (not a) (setq a *a*) (setq *a* a))
(or *b* (setq *b* 10.0))
(setq b (getreal (strcat "\n \nNhap so lon: <"
		  (rtos *b* 2 0)
		 "> :"
	  )
 )
)
(if (not b) (setq b *b*) (setq *b*...
>>

Với góp ý anh Tot77 em có chương trình gửi lên để ai cần mng dùng.

(defun c:SRD(/ );;;;SO RANDOM
(setq i 0)
(setvar "CMDECHO" 0)
(or *a* (setq *a* 0))
(setq a (getreal (strcat "\n \nNhap so nho:  <"
		  (rtos *a* 2 0)
		 "> :"
	  )
 )
)
(if (not a) (setq a *a*) (setq *a* a))
(or *b* (setq *b* 10.0))
(setq b (getreal (strcat "\n \nNhap so lon: <"
		  (rtos *b* 2 0)
		 "> :"
	  )
 )
)
(if (not b) (setq b *b*) (setq *b* b))
(or *h* (setq *h* 1.00))
(setq h (getreal (strcat "\n \nNhap chieu cao chu: <"
		  (rtos *h* 2 2)
		 "> :"
	  )
 )
)
(if (not h) (setq h *h*) (setq *h* h))
(if (< a b)
    (progn
	(while
		(setq Pnt (getpoint "\nChon diem Pick ghi so ngau nhien: "))
	  	(setq NumberRandom (+ (rand1 a b) (* 0.1 (rand2 0 9)) (* 0.01 (rand2 0 9))))
		(Entmake (list (cons 0 "TEXT") (cons 10 Pnt) (cons 1 (rtos NumberRandom 2 2)) (cons 40 h)))

	)
     )
     (Alert "Ban nhap so a lon hon so b roi! Nhap lai nhe ban")
)
(princ)
)


(defun rand1 (a b)
    (+ a (fix (* (- b a) (atof (strcat "0." (substr (rtos (getvar 'cdate) 2 18) 16 2))))))
)
(defun rand2 (a b)
    (+ a  (* (- b a) (atof (strcat "0." (substr (rtos (getvar 'cdate) 2 18) 16 2)))))
)

Download lisp

Filename: 309486_srd.lsp

Trang 169/330