Jump to content
InfoFile
Tác giả: nhoclangbat
Bài viết gốc: 309465
Tên lệnh: angsidet ast
Nhờ giúp lisp lấy tọa độ x,y

@@ "trạm máy" => "hướng ngắm" => "số bắt đầu" nhập stt đầu tiên bạn mún lấy tọa độ rùi cứ pick tiếp các điểm bạn cần lấy thui xong rùi space ghi bảng ra cad rùi xuất file .txt thui, lsp trên thiếu style, nhoc quên :), tại trong máy truoc khi vẽ nhoc đã tạo đủ style nên ko viết tỏng lsp bạn tải lại lsp này thử ^^

;; free lisp from cadviet.com
;;; this lisp was...
>>

@@ "trạm máy" => "hướng ngắm" => "số bắt đầu" nhập stt đầu tiên bạn mún lấy tọa độ rùi cứ pick tiếp các điểm bạn cần lấy thui xong rùi space ghi bảng ra cad rùi xuất file .txt thui, lsp trên thiếu style, nhoc quên :), tại trong máy truoc khi vẽ nhoc đã tạo đủ style nên ko viết tỏng lsp bạn tải lại lsp này thử ^^

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/109178-nho-giup-lisp-lay-toa-do-x-y/
(command "style" "vaptimn" "vni-aptima" 0 1 0 "" "")
(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")


<<

Filename: 309465_angsidet_ast.lsp
Tác giả: Tot77
Bài viết gốc: 309466
Tên lệnh: int
Tại sao bắt điểm Intersection tại điểm giao trên 3D không được?

Nhìn bằng mắt thì thấy nó giao nhau nhưng dùng lệnh dưới đây thì chỉ có điểm D là giao thôi.

@tien2005 : lệnh ID thì cứ phương đứng là y, ngang là x. Nhưng ở đây đứng là z.

(defun c:int(/ a b c)
  (defun get3(l) (if (cdddr l) (cons (list (car l) (cadr l) (caddr l)) (get3 (cdddr l))) (list l)))
  (defun ints (o1 o2 mo)
    (get3 (vlax-Invoke (vlax-EName->vla-Object o1)...
>>

Nhìn bằng mắt thì thấy nó giao nhau nhưng dùng lệnh dưới đây thì chỉ có điểm D là giao thôi.

@tien2005 : lệnh ID thì cứ phương đứng là y, ngang là x. Nhưng ở đây đứng là z.

(defun c:int(/ a b c)
  (defun get3(l) (if (cdddr l) (cons (list (car l) (cadr l) (caddr l)) (get3 (cdddr l))) (list l)))
  (defun ints (o1 o2 mo)
    (get3 (vlax-Invoke (vlax-EName->vla-Object o1) "IntersectWith" (vlax-EName->vla-Object o2) mo))
  )
  (setq a (car (entsel "\nchon doi tuong 1: "))
b (car (entsel "\nchon doi tuong 2: "))
   c (ints a b acextendnone)
  ) 
)

<<

Filename: 309466_int.lsp
Tác giả: nhoclangbat
Bài viết gốc: 309510
Tên lệnh: angsidet ast
Nhờ giúp lisp lấy tọa độ x,y

@@ nhoc cũng chưa rành lisp đâu viết nổi lisp chôm người ta mà, chỉ lỗi thiếu style mà lisp bắt buộc có thui, nhoc đã sữa rùi lần này bảo đảm chạy ngọt :))

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/109178-nho-giup-lisp-lay-toa-do-x-y/
(command "style" "vaptimn" "vni-aptima" 0 1 0 "" "")
(command "style" "vhelvei" "vni-helve" 0 1 0 "" "")
(command "style"...
>>

@@ nhoc cũng chưa rành lisp đâu viết nổi lisp chôm người ta mà, chỉ lỗi thiếu style mà lisp bắt buộc có thui, nhoc đã sữa rùi lần này bảo đảm chạy ngọt :))

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/109178-nho-giup-lisp-lay-toa-do-x-y/
(command "style" "vaptimn" "vni-aptima" 0 1 0 "" "")
(command "style" "vhelvei" "vni-helve" 0 1 0 "" "")
(command "style" "vhelveb" "vni-avo" 0 1 0 "" "")
(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")


<<

Filename: 309510_angsidet_ast.lsp
Tác giả: duytuankts
Bài viết gốc: 309553
Tên lệnh: 9
Nhờ sửa lisp chuyển layer và hướng dẫn về array trong block dynamic

;;************************Chuyen doi tuong ve dung layer

1. Mình dùng lisp chuyển đối tượng như sau để quản lý layer:

 

 

;;************************Chuyen doi tuong ve dung layer

(defun CHANGE-LAYER (_TYPE LAYER / OBJS)
 (setq OBJS (ssget "X" (list (cons 0 _TYPE))))
 (if (not (tblsearch "layer" LAYER))
  (command ".layer" "m" LAYER "")
 );_ end if
 (command ".chprop" OBJS "" "la" LAYER "")
 (princ)
);_ end...
>>
;;************************Chuyen doi tuong ve dung layer

1. Mình dùng lisp chuyển đối tượng như sau để quản lý layer:

 

 

;;************************Chuyen doi tuong ve dung layer

(defun CHANGE-LAYER (_TYPE LAYER / OBJS)
 (setq OBJS (ssget "X" (list (cons 0 _TYPE))))
 (if (not (tblsearch "layer" LAYER))
  (command ".layer" "m" LAYER "")
 );_ end if
 (command ".chprop" OBJS "" "la" LAYER "")
 (princ)
);_ end defun
(defun C:9 (/ OBJS)
(CHANGE-LAYER "DIMENSION" "---Q7-DIM")
(CHANGE-LAYER "HATCH" "---Q8-HATCH")

(CHANGE-LAYER "*TEXT" "---Q9-TEXT") )
 

Bây h mình muốn khi thực hiện lệnh của lisp trên "9" thì những đối tượng hatch của layer "---Q63-LAT NEN" không bị chuyển sang layer "---Q8-HATCH" thì phải sửa lisp như thế nào.

2. Mình muốn dùng tính năng array của block dynamic nhưng chỉ dùng được 1 chiều, muốn dùng 2 chiều thì như thế nào. Ví dụ: 1 viên gạch 500x500, chỉ cần kéo mũi tên sẽ lát gạch đó cho phòng 4000x6000 (file đính kèm)

3. Mình dùng cad hay bị lỗi khi sử dụng wipeout khi hiển thị vẫn che mất đối tượng nằm phía trên, nhưng khi move thì lại view đúng, rồi vẽ 1 lúc lại bị che mất (đối tượng nằm trên wipeout). In thì bình thường nhưng khi vẽ khó quản lý.

Thanks đã đọc. Chúc mọi người kỳ nghỉ vui vẻ.

;;************************Chuyen doi tuong ve dung layer
 
(defun CHANGE-LAYER (_TYPE LAYER / OBJS)
 (setq OBJS (ssget "X" (list (cons 0 _TYPE))))
 (if (not (tblsearch "layer" LAYER))
  (command ".layer" "m" LAYER "")
 );_ end if
 (command ".chprop" OBJS "" "la" LAYER "")
 (princ)
);_ end defun
(defun C:9 (/ OBJS)
(CHANGE-LAYER "DIMENSION" "---Q7-DIM")
(CHANGE-LAYER "HATCH" "---Q8-HATCH")

 

(CHANGE-LAYER "*TEXT" "---Q9-TEXT") )
;;************************Chuyen doi tuong ve dung layer
 
(defun CHANGE-LAYER (_TYPE LAYER / OBJS)
 (setq OBJS (ssget "X" (list (cons 0 _TYPE))))
 (if (not (tblsearch "layer" LAYER))
  (command ".layer" "m" LAYER "")
 );_ end if
 (command ".chprop" OBJS "" "la" LAYER "")
 (princ)
);_ end defun
(defun C:9 (/ OBJS)
(CHANGE-LAYER "DIMENSION" "---Q7-DIM")
(CHANGE-LAYER "HATCH" "---Q8-HATCH")
 
 
(defun CHANGE-LAYER (_TYPE LAYER / OBJS)
 (setq OBJS (ssget "X" (list (cons 0 _TYPE))))
 (if (not (tblsearch "layer" LAYER))
  (command ".layer" "m" LAYER "")
 );_ end if
 (command ".chprop" OBJS "" "la" LAYER "")
 (princ)
);_ end defun
(defun C:9 (/ OBJS)
(CHANGE-LAYER "DIMENSION" "---Q7-DIM")
(CHANGE-LAYER "HATCH" "---Q8-HATCH")
(CHANGE-LAYER "*TEXT" "---Q9-TEXT") )

<<

Filename: 309553_9.lsp
Tác giả: gp14
Bài viết gốc: 13451
Tên lệnh: sum
Lý thuyết sáng tác.

Cuộc hành trình lãng mạn qua các hình thức tổ hợp kiến trúc:
http://www.cadviet.com/upfiles/hanh_trinh_Langman.doc

Filename: 13451_sum.lsp
Tác giả: tnmtpc
Bài viết gốc: 13455
Tên lệnh: sum
Ghép số bị tách trong bình đồ

Lệnh quá hay!!! Nhưng góp ý và mong Bác nghiên cứu giúp: sau khi text được nối bị lệch vị trí sang trái, nếu giữ nguyên vị trí tại dấu chấm thì quá tuyệt vời

Filename: 13455_sum.lsp
Tác giả: tien2005
Bài viết gốc: 309697
Tên lệnh: test
Nối nhiều đường polyline vuông góc.

Bản vẽ của bạn là các line không phải polyline, các line được vẽ từ trái qua phải, từ trên xuống dưới. Bạn dùng lisp sau để tạo polyline, mình làm nhanh nên sẽ đúng về hình dạng, polyline ở layer hiện hành và có màu số 5 (xanh dương)

(defun c:test (/ ss lst)
  (defun dxf (code e) (cdr (assoc code (entget e))))
  (defun Make-LWPolyline
			 (listpoint closed Color / Lst)
    (setq Lst (list '(0 ....
>>

Bản vẽ của bạn là các line không phải polyline, các line được vẽ từ trái qua phải, từ trên xuống dưới. Bạn dùng lisp sau để tạo polyline, mình làm nhanh nên sẽ đúng về hình dạng, polyline ở layer hiện hành và có màu số 5 (xanh dương)

(defun c:test (/ ss lst)
  (defun dxf (code e) (cdr (assoc code (entget e))))
  (defun Make-LWPolyline
			 (listpoint closed Color / Lst)
    (setq Lst (list '(0 . "LWPOLYLINE")
		    '(100 . "AcDbEntity")

		    (cons 62
			  (if Color
			    Color
			    256
			  )
		    )
		    '(100 . "AcDbPolyline")
		    (cons 90
			  (if closed
			    (1+ (length listpoint))
			    (length listpoint)
			  )
		    )
		    (cons 70
			  (if closed
			    1
			    0
			  )
		    )
	      )
    )
    (foreach PP	listpoint
      (setq Lst (append Lst (list (cons 10 PP))))
    )
    (entmakex Lst)
  )
  (princ "\nChon cac line: ")
  (if (setq ss (ssget '((0 . "line"))))
    (progn
      (setq
	ss (vl-sort
	     (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
	     (function
	       (lambda (a b) (< (car (dxf 10 a)) (car (dxf 10 b))))
	     )
	   )
      )
      (foreach n ss
	(setq lst (append lst (list (dxf 10 n) (dxf 11 n) (dxf 10 n))))
      )					;for
      (Make-LWPolyline lst nil 5)
    )					;progn
  )					;if
  (princ)
)

 


<<

Filename: 309697_test.lsp
Tác giả: nhoclangbat
Bài viết gốc: 309734
Tên lệnh: 9
Nhờ sửa lisp chuyển layer và hướng dẫn về array trong block dynamic

^^ nhoc bỏ đại chạy thử thấy q63 ko bị đỗi thành Q8 :)

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/109369-nho-sua-lisp-chuyen-layer-va-huong-dan-ve-array-trong-block-dynamic/
;;************************Chuyen doi tuong ve dung layer

(defun CHANGE-LAYER (_TYPE LAYER / OBJS)
 (setq OBJS (ssget "X" (list (cons 0 _TYPE))))
 (if (not (tblsearch "layer" LAYER)) 
  (command ".layer"...
>>

^^ nhoc bỏ đại chạy thử thấy q63 ko bị đỗi thành Q8 :)

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/109369-nho-sua-lisp-chuyen-layer-va-huong-dan-ve-array-trong-block-dynamic/
;;************************Chuyen doi tuong ve dung layer

(defun CHANGE-LAYER (_TYPE LAYER / OBJS)
 (setq OBJS (ssget "X" (list (cons 0 _TYPE))))
 (if (not (tblsearch "layer" LAYER)) 
  (command ".layer" "m" LAYER "")
 );_ end if
 (command ".chprop" OBJS "" "la" LAYER "")
 (princ)
);_ end defun
(defun C:9 (/ OBJS)
(CHANGE-LAYER "DIMENSION" "---Q7-DIM")
;(CHANGE-LAYER "HATCH" "---Q8-HATCH")
(CHANGE-LAYER "*TEXT" "---Q9-TEXT")
(if (and (setq ss (ssget  "_x" '((0 . "HATCH") (-4 . "<not")(8 . "---Q63-LAT NEN")(-4 . "not>")))))
(command ".chprop" ss "" "la" "---Q8-HATCH" ""))
)


<<

Filename: 309734_9.lsp
Tác giả: tien2005
Bài viết gốc: 309735
Tên lệnh: noname
Đếm, sắp xếp, ghi thông tin Block

BẠn thử cái này, chỉ ghi theo 8 hướng

không biết đặt tên gì, thôi thì NONAME :(

(defun c:NoName	(/ p0 p1 ss pn ang dirr dxf maketext)
  (defun dxf (code e) (cdr (assoc code (entget e))))
  (defun maketext (p height str)
    (entmake (list (cons 0 "TEXT")
		   (cons 10 p)
		   (cons 40 height)
		   (cons 1 str)
	     )
    )
  )
  (or rank# (setq rank# 30))
  (setq	rank# (cond ((getint (strcat "\nDo lon cua so de chon <"
				    ...
>>

BẠn thử cái này, chỉ ghi theo 8 hướng

không biết đặt tên gì, thôi thì NONAME :(

(defun c:NoName	(/ p0 p1 ss pn ang dirr dxf maketext)
  (defun dxf (code e) (cdr (assoc code (entget e))))
  (defun maketext (p height str)
    (entmake (list (cons 0 "TEXT")
		   (cons 10 p)
		   (cons 40 height)
		   (cons 1 str)
	     )
    )
  )
  (or rank# (setq rank# 30))
  (setq	rank# (cond ((getint (strcat "\nDo lon cua so de chon <"
				     (rtos rank# 2 0)
				     ">: "
			     )
		     )
		    )
		    (rank#)
	      )
  )
  (command ".undo" "be")
  (while (and (setq p0 (getpoint "\nChon diem chuan: "))
	      (setq ss
		     (ssget "x"
			    (list (cons 0 "insert")
				  (cons -4 ">=,>=,*")
				  (cons 10 (mapcar '- p0 (list rank# rank# rank#)))
				  (cons -4 "<=,<=,*")
				  (cons 10 (mapcar '+ p0 (list rank# rank# rank#)))

			    )
		     )
	      )
	 )
    (setq p1
	   (cond
	     ((getpoint
		"\nChon diem ghi ket qua hoac enter de ghi tai diem chuan: "
	      )
	     )
	     (p0)
	   )
    )

    (setq
      ss (vl-sort (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
		  '(lambda (x y)
		     (<	(distance p0 (dxf 10 x))
			(distance p0 (dxf 10 y))
		     )
		   )
	 )
    )
    (foreach n ss
      (setq pn	(dxf 10 n)
	    ang	(angle p0 pn)
      )
      (cond
	((or (>= (/ pi 8) ang) (< (/ (* 15 pi) 8) ang))
	 (setq dirr "Dong")
	)
	((>= (/ (* 3 pi) 8) ang) (setq dirr "Dong Bac"))
	((>= (/ (* 5 pi) 8) ang) (setq dirr "Bac"))
	((>= (/ (* 7 pi) 8) ang) (setq dirr "Tay Bac"))
	((>= (/ (* 9 pi) 8) ang) (setq dirr "Tay"))
	((>= (/ (* 11 pi) 8) ang) (setq dirr "Tay Nam"))
	((>= (/ (* 13 pi) 8) ang) (setq dirr "Nam"))
	((>= (/ (* 15 pi) 8) ang) (setq dirr "Dong Nam"))
      )
      (maketext p1 2.5 dirr)
      (maketext	(setq p1 (mapcar '- p1 (list 0 5 0)))
		2.5
		(dxf 2 n)
      )
      (maketext	(setq p1 (mapcar '- p1 (list 0 5 0)))
		2.5
		(strcat "L=" (rtos (distance p0 pn) 2 2))
      )
      (setq p1 (mapcar '- p1 (list 0 8 0)))
    )					;for

  )					;while
  (command ".undo" "en")
  (princ)
)

 


<<

Filename: 309735_noname.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 309737
Tên lệnh: ha
Đếm, sắp xếp, ghi thông tin Block

Không hiểu hết ý của bạn ở cái đoạn "mình chỉ" nên tạm thế này.

; Font va Height cua Text theo Current Text.
(defun C:HA(/ pc cr ptd ppt ss lst pg ten dis goc hng)
 (setq pc (getpoint "\nChon diem chuan: "))
 (setq cr (getreal "\nNhap chieu rong khung Window: "))
 (setq ptd (polar pc (* 1.25 pi) (* (/ cr 2) (sqrt 2))))
 (setq ppt (polar pc (* 0.25 pi) (* (/ cr 2) (sqrt...
>>

Không hiểu hết ý của bạn ở cái đoạn "mình chỉ" nên tạm thế này.

; Font va Height cua Text theo Current Text.
(defun C:HA(/ pc cr ptd ppt ss lst pg ten dis goc hng)
 (setq pc (getpoint "\nChon diem chuan: "))
 (setq cr (getreal "\nNhap chieu rong khung Window: "))
 (setq ptd (polar pc (* 1.25 pi) (* (/ cr 2) (sqrt 2))))
 (setq ppt (polar pc (* 0.25 pi) (* (/ cr 2) (sqrt 2))))
 (setq ss (ssget "c" ptd ppt '((0 . "Insert"))))
 (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
 (setq lst (vl-sort lst '(lambda(e1 e2) (< (distance pc (cdr (assoc 10 (entget e1)))) (distance pc (cdr (assoc 10 (entget e2))))))))
 (foreach ent lst
  (setq pg (cdr (assoc 10 (entget ent)))) 
  (setq ten (cdr (assoc 2 (entget ent))))
  (setq dis (distance pc pg))
  (setq goc (angle pc pg))
  (setq hng
   (cond
    ((equal goc 0 1E-3) "D")
((equal goc (/ pi 2) 1E-3) "B")
((equal goc pi 1E-3) "T")
((equal goc (* 1.5 pi) 1E-3) "N")
    ((< 0 goc (/ pi 2)) "DB")
((< (/ pi 2) goc pi) "TB")
((< pi goc (* 1.5 pi)) "TN")
((< (* 1.5 pi) goc (* 2 pi)) "DN")))
  (entmakex (list (cons 0 "TEXT") (cons 10 pg) (cons 40 (getvar 'textsize)) (cons 1 (strcat hng "_" ten "_" (rtos dis 2 2)))))))
 


<<

Filename: 309737_ha.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 309808
Tên lệnh: ha
Đếm, sắp xếp, ghi thông tin Block

Đây. Nhưng hết chữ cái thì ráng chịu nghe!

; Font va Height cua Text theo Current Text.
(defun C:HA(/ pc cr ptd ppt ss lst pg ten dis goc hng x)
 (setq pc (getpoint "\nChon diem chuan: "))
 (setq cr (getreal "\nNhap chieu rong khung Window: "))
 (setq ptd (polar pc (* 1.25 pi) (* (/ cr 2) (sqrt 2))))
 (setq ppt (polar pc (* 0.25 pi) (* (/ cr 2) (sqrt 2))))
 (setq ss (ssget "c" ptd ppt '((0 ....
>>

Đây. Nhưng hết chữ cái thì ráng chịu nghe!

; Font va Height cua Text theo Current Text.
(defun C:HA(/ pc cr ptd ppt ss lst pg ten dis goc hng x)
 (setq pc (getpoint "\nChon diem chuan: "))
 (setq cr (getreal "\nNhap chieu rong khung Window: "))
 (setq ptd (polar pc (* 1.25 pi) (* (/ cr 2) (sqrt 2))))
 (setq ppt (polar pc (* 0.25 pi) (* (/ cr 2) (sqrt 2))))
 (setq ss (ssget "c" ptd ppt '((0 . "Insert"))))
 (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
 (setq lst (vl-sort lst '(lambda(e1 e2) (< (distance pc (cdr (assoc 10 (entget e1)))) (distance pc (cdr (assoc 10 (entget e2))))))))
 (setq x 65)
 (repeat (length lst)
  (setq ent (nth (- x 65) lst))
  (setq pg (cdr (assoc 10 (entget ent)))) 
  (setq ten (cdr (assoc 2 (entget ent))))
  (setq dis (distance pc pg))
  (setq goc (angle pc pg))
  (setq hng
   (cond
    ((equal goc 0 1E-3) "D")
((equal goc (/ pi 2) 1E-3) "B")
((equal goc pi 1E-3) "T")
((equal goc (* 1.5 pi) 1E-3) "N")
    ((< 0 goc (/ pi 2)) "DB")
((< (/ pi 2) goc pi) "TB")
((< pi goc (* 1.5 pi)) "TN")
((< (* 1.5 pi) goc (* 2 pi)) "DN")))
  (entmakex (list (cons 0 "TEXT") (cons 10 pg) (cons 40 (getvar 'textsize)) (cons 1 (strcat (chr x) "_" hng "_" ten "_" (rtos dis 2 2)))))
  (setq x (1+ x))))
 


<<

Filename: 309808_ha.lsp
Tác giả: nhoclangbat
Bài viết gốc: 309892
Tên lệnh: s2
-Mong các Bro giúp đỡ

cũng tò mò, đúng là lỗi, chỗ lệnh pseclect ^^, bạn thử dùng lisp có lệnh s2 trong topic đó xem 

;; free lisp from cadviet.com
(defun c:s2() (SelRange <=))

(defun SelRange(f / ss a b)
    (setq ss  (acet-ss-to-list (ssget '((0 . "TEXT")))))
    (setq a (getreal "\nNhap so nho: ") b (getreal "\nNhap so lon: "))
    (command "_.PSELECT" (acet-list-to-ss (vl-remove nil (mapcar '(lambda(x) (if (f a (distof (cdr (assoc 1...
>>

cũng tò mò, đúng là lỗi, chỗ lệnh pseclect ^^, bạn thử dùng lisp có lệnh s2 trong topic đó xem 

;; free lisp from cadviet.com
(defun c:s2() (SelRange <=))

(defun SelRange(f / ss a b)
    (setq ss  (acet-ss-to-list (ssget '((0 . "TEXT")))))
    (setq a (getreal "\nNhap so nho: ") b (getreal "\nNhap so lon: "))
    (command "_.PSELECT" (acet-list-to-ss (vl-remove nil (mapcar '(lambda(x) (if (f a (distof (cdr (assoc 1 (entget x)))) b) x nil)) ss))) "")
    (princ)
)
 


<<

Filename: 309892_s2.lsp
Tác giả: Tot77
Bài viết gốc: 309922
Tên lệnh: tim
-Mong các Bro giúp đỡ

Bạn dùng thử cái này, cách dùng :

1. Nhập biểu thức, thí dụ : 

   >=3

  <6

  2.3<=5.0

  (2 cái trên thì dễ hiểu rồi, cái thứ 3 nghĩa là trong khoảng từ 2.3 đến 5.0 có lấy cả 2 số đó)

2. Quét chọn text.

3. Cái text nào thoả thì bị bắt, khi đó bạn muốn đổi layer như thế nào cũng được.

(defun c:tim()
 ...
>>

Bạn dùng thử cái này, cách dùng :

1. Nhập biểu thức, thí dụ : 

   >=3

  <6

  2.3<=5.0

  (2 cái trên thì dễ hiểu rồi, cái thứ 3 nghĩa là trong khoảng từ 2.3 đến 5.0 có lấy cả 2 số đó)

2. Quét chọn text.

3. Cái text nào thoả thì bị bắt, khi đó bạn muốn đổi layer như thế nào cũng được.

(defun c:tim()
  (defun ssfrom (sl / ss0) (setq ss0 (ssadd)) (mapcar '(lambda(x) (ssadd x ss0)) sl) ss0)
  (setq gtt (getstring t "\nNhap bieu thuc :")
lso ".1234567890"
so  (read (strcat "(" (vl-list->string (mapcar '(lambda(x) (if (vl-string-search (chr x) lso) x 32)) (vl-string->list gtt))) ")"))
chu (car (read (strcat "(" (vl-list->string (mapcar '(lambda(x) (if (vl-string-search (chr x) lso) 32 x)) (vl-string->list gtt))) ")")))
  )  
  (sssetfirst nil (ssfrom (vl-remove-if-not '(lambda(x)
(if (= 1 (length so))
  ((eval chu) (atof (cdr (assoc 1 (entget x)))) (car so))
  (and ((eval chu) (car so) (atof (cdr (assoc 1 (entget x)))) (last so)))))
(vl-remove-if 'listp (mapcar 'cadr (ssnamex  (ssget '((0 . "*TEXT") (1 . "~**")))))))))
)

<<

Filename: 309922_tim.lsp
Tác giả: Tot77
Bài viết gốc: 309955
Tên lệnh: tim
-Mong các Bro giúp đỡ

Thể theo yêu cầu của bác Ha, tôi viết lại như sau:

 

(defun c:tim()
  (defun ssfrom (sl / ss0) (setq ss0 (ssadd)) (mapcar '(lambda(x) (ssadd x ss0)) sl) ss0)
  (setq gtt (getstring t "\nNhap bieu thuc :")
lso "-.1234567890"
so  (read (strcat "(" (vl-list->string (mapcar '(lambda(x) (if (vl-string-search (chr x) lso) x 32)) (vl-string->list gtt))) ")"))
chu (car (read (strcat "(" (vl-list->string (mapcar...
>>

Thể theo yêu cầu của bác Ha, tôi viết lại như sau:

 

(defun c:tim()
  (defun ssfrom (sl / ss0) (setq ss0 (ssadd)) (mapcar '(lambda(x) (ssadd x ss0)) sl) ss0)
  (setq gtt (getstring t "\nNhap bieu thuc :")
lso "-.1234567890"
so  (read (strcat "(" (vl-list->string (mapcar '(lambda(x) (if (vl-string-search (chr x) lso) x 32)) (vl-string->list gtt))) ")"))
chu (car (read (strcat "(" (vl-list->string (mapcar '(lambda(x) (if (vl-string-search (chr x) lso) 32 x)) (vl-string->list gtt))) ")")))
  )  
  (sssetfirst nil (ssfrom (vl-remove-if-not '(lambda(x)
(if (= 1 (length so))
  ((eval chu) (atof (cdr (assoc 1 (entget x)))) (car so))
  (and ((eval chu) (car so) (atof (cdr (assoc 1 (entget x)))) (last so)))))
    (vl-remove-if-not '(lambda(x) (distof (cdr (assoc 1 (entget x)))))
      (vl-remove-if 'listp (mapcar 'cadr (ssnamex  (ssget (list '(0 . "*TEXT") )))))))))
)

 

Các biểu thức so sánh hợp lệ là  <, <=, >, >=, =, /= (khác),


<<

Filename: 309955_tim.lsp
Tác giả: Tue_NV
Bài viết gốc: 55897
Tên lệnh: jj
Bác Pro nào sửa cho em đoạn Lisp cái !

Đây bạn:

Bạn phải chọn Line trước bằng Grid thì nó mới chạy đấy nhé. Đối tượng là Line

Filename: 55897_jj.lsp
Tác giả: nhoclangbat
Bài viết gốc: 308777
Tên lệnh: expp nhatt
BT chương 4.3 - Xử lý list

anh Ket nhoc nộp trước 3 bài đầu hen ^^

; 4-3-1 xuat toa do 1 diem
(defun c:expp (/ old pt1)
(setq old (mapcar 'getvar '("cmdecho" "osmode")))
(mapcar 'setvar '("cmdecho" "osmode") '(0 0))
(setq pt1 (getpoint "\n cho diem mun lay toa do:"))
(princ "\n")
(princ (strcat "X= " (rtos (car pt) 2 3) "; Y= " (rtos (cadr pt) 2 3) "; Z= " (rtos (last pt) 2 3)))
(mapcar 'setvar '("cmdecho" "osmode") old)
(princ)
)
;ve hinh chu nhat doi
(defun C:nhatt (/ pt1...
>>

anh Ket nhoc nộp trước 3 bài đầu hen ^^

; 4-3-1 xuat toa do 1 diem
(defun c:expp (/ old pt1)
(setq old (mapcar 'getvar '("cmdecho" "osmode")))
(mapcar 'setvar '("cmdecho" "osmode") '(0 0))
(setq pt1 (getpoint "\n cho diem mun lay toa do:"))
(princ "\n")
(princ (strcat "X= " (rtos (car pt) 2 3) "; Y= " (rtos (cadr pt) 2 3) "; Z= " (rtos (last pt) 2 3)))
(mapcar 'setvar '("cmdecho" "osmode") old)
(princ)
)
;ve hinh chu nhat doi
(defun C:nhatt (/ pt1 pt2 pt3 pt4 d)
(setq d (getreal "\n nhap khoang cach offset:"))
(setq pt1 (getpoint "\n chon diem 1:"))
(setq pt2 (getpoint pt1 "\n chon diem 2:"))
(setq pt3 (list (+ (car pt1) d) (- (cadr pt1) d) 0))
(setq pt4 (list (- (car pt2) d) (+ (cadr pt2) d) 0))
(command "rectang" pt1 pt2)
(command "rectang" pt3 pt4)
)
;;loai bo 1 phan tu trong list
(defun remove ( tenphanturemove lst)
(append '(reverse (cdr (member tenphanturemove (reverse lst)))) '(cdr (member tenphanturemove lst)))
)

- có chỗ nhoc chưa rõ lắm, vậy 1 điểm mình pick thì thông số của nó mặc định có sẵn là 1 list gồm tọa độ x y z rùi hả a, mình chỉ dùng hàm để lôi nó ra ah ^^


<<

Filename: 308777_expp_nhatt.lsp
Tác giả: luhaivinh
Bài viết gốc: 310127
Tên lệnh: bt2-1 bt2-2
Chữa bài tập chương 2
;Chuong 2

 
(defun c:bt2-1(\ x y z e);cau 1
  (setq x (+ 2 7) y (- 3 1.25) z 5.0)
  (setq e (+ z (* 0.4 (- x y))))
  (setq  ketqua (+ x y z e))
 )

(defun c: bt2-2(\ ketqua);cau 2
  (setq a 2000)
  (setq b 1000)
  (setq c (/ (* a b) 2))
)
;cau 3
;o vi du nay ta co the nhan voi 0.5 hoac chia 2 dieu duoc.

(defun trungbinhcong(a b c);cau 4
  (/ (+ a b c) 3)
)

(defun tinhdientich(a b);cau 5
  (* a b 0.5)
)

  (defun gangiatri(d) ;cau 6
    (setq d 5)
  )
 ...
>>
;Chuong 2

 
(defun c:bt2-1(\ x y z e);cau 1
  (setq x (+ 2 7) y (- 3 1.25) z 5.0)
  (setq e (+ z (* 0.4 (- x y))))
  (setq  ketqua (+ x y z e))
 )

(defun c: bt2-2(\ ketqua);cau 2
  (setq a 2000)
  (setq b 1000)
  (setq c (/ (* a b) 2))
)
;cau 3
;o vi du nay ta co the nhan voi 0.5 hoac chia 2 dieu duoc.

(defun trungbinhcong(a b c);cau 4
  (/ (+ a b c) 3)
)

(defun tinhdientich(a b);cau 5
  (* a b 0.5)
)

  (defun gangiatri(d) ;cau 6
    (setq d 5)
  )
  (defun tichbonso(a b c d)
    (* (a b c d))
)

(defun lapphuongmotso(a);cau 7
  (*  a a a)
  
  

khi load file và gọi hàm thì nhận thông báo lỗi.nhờ thầy xêm em có sai chổ nào không.


<<

Filename: 310127_bt2-1_bt2-2.lsp
Tác giả: hochoaivandot
Bài viết gốc: 310242
Tên lệnh: ttt
Lisp xác định tỷ lệ khung Mview

Phải ri không bạn?


(defun C:ttt()
    (if (setq e (car (entsel "Chon mview")))
      (setq sc (vla-get-CustomScale (vlax-ename->vla-object e)))
    )
    (setvar "dimscale" sc)
)


Filename: 310242_ttt.lsp
Tác giả: thanhduan2407
Bài viết gốc: 310274
Tên lệnh: gcd
hỏi vấn đề tạo liên kết LSP và dialog DCL

Chào các bác! Cho em hỏi ké một chút về liênkeersst DCL

Em đang làm 1 lisp để ghi chú Text lên màn hình với lựa chọn nhập nội dung, cao chữ, Layer, TextStyle, Color

Có một điều sau đây em chưa biết cách làm:

1. Sau mỗi lần chạy thì start_list của em lại nhân đôi lên (em biết nguyên nhân do (mapcar 'add_list  khi chưa kiểm duyệt) )

2. Hộp thoại màu sắc em vẫn chưa biết cách...

>>

Chào các bác! Cho em hỏi ké một chút về liênkeersst DCL

Em đang làm 1 lisp để ghi chú Text lên màn hình với lựa chọn nhập nội dung, cao chữ, Layer, TextStyle, Color

Có một điều sau đây em chưa biết cách làm:

1. Sau mỗi lần chạy thì start_list của em lại nhân đôi lên (em biết nguyên nhân do (mapcar 'add_list  khi chưa kiểm duyệt) )

2. Hộp thoại màu sắc em vẫn chưa biết cách tạo

3. Nếu bỏ kiểu Layer,  TextStyle thì chạy ngon ạ.

 

Đây là Mã Code của em

GHICHU
: dialog
{
label = "Ch\U+01B0\U+01A1ng tr\U+00ECnh ghi ch\U+00FA";
	: boxed_column
	{
		: edit_box
		{
			label = "Nh\U+1EADp t\U+00EAn c\U+1EA7n vi\U+1EBFt ghi ch\U+00FA";
			key = "Text_ghichu";
			edit_width = 30;
			alignment = left;
			edit_limit = 50;
			value = "Vi\U+1EBFt ghi ch\U+00FA v\U+00E0o \U+0111\U+00E2y";

		}
		: edit_box
		{
			label = "Nh\U+1EADp chi\U+1EC1u cao ch\U+1EEF:";
			key = "Height_Text";
			edit_width = 3.0;
			alignment = left;
			edit_limit = 5;
			value = 1;
		}


	}
	: boxed_column
	{
        	: row
		{
		 : column
		 {
		      : popup_list
		      {
		          label       = "L\U+1EF1a ch\U+1ECDn Layer" ;
		          key         = "LTSLAY" ;
		          edit_width  = 50 ;  
		          list        = "" ;
		          alignment = left;
		      }
		      : popup_list
		      {
		          label       = "L\U+1EF1a ch\U+1ECDn TextStyle" ;
		          key         = "LTSTEXTSTYLE" ;
		          edit_width  = 50 ;  
		          list        = "" ;
		          alignment = left;
		      }
		 }
		}
	}	
	: boxed_column
	{
		: button
		{
			label = "Pick >>>";
			key = "Accept";
			is_default = true;
			fixed_width = centered;
		}
		: button
		{
			label = "H\U+1EE7y";
			key = "Cancel";
			is_default = false;
			fixed_width = centered;
		}

	}

}
(defun C:GCD ( / dcl_id  LtsLayer LtsStyle h Text_ghichu )
(setq dcl_id (load_dialog "GHICHU.DCL"))
(if (not (new_dialog "GHICHU" dcl_id))
 (exit)
)

  
(action_tile "Text_ghichu"  "(setq TextGhiChu $value)")
(mode_tile "Text_ghichu" 2)
(action_tile "Height_Text"  "(setq h $value)")
(mode_tile "Height_Text" 2)
(action_tile "Text_ghichu"  "(setq TextGhiChu $value)")

(setq LtsLayer (Getlayer))
(start_list "LTSLAY")
(mapcar 'add_list  LtsLayer)
(end_list)
(if #CurLay
	(set_tile "LTSLAY"  (setq CurLay #CurLay))
	(set_tile "LTSLAY"  (setq CurLay "0"))
)
(action_tile "LTSLAY" "(setq LayerText $value)")


(setq LtsStyle (GetTextStyle))
(start_list "LTSTEXTSTYLE")
(mapcar 'add_list  LtsStyle)
(end_list)
  
(if #CurStyle
	(set_tile "LTSTEXTSTYLE"  (setq CurStyle #CurStyle))
	(set_tile "LTSTEXTSTYLE"  (setq CurStyle "Standard"))
)
(action_tile "LTSTEXTSTYLE" "(setq TextStyle $value)")
  

(action_tile "Accept" "(setq UseButton 1)(done_dialog)")
(action_tile "Cancel" "(setq UseButton 2)(done_dialog)")

(start_dialog)
(unload_dialog dcl_id)
(if (= UseButton 1)
	(progn
		(GCT TextGhiChu h LayerText TextStyle)
	)
)
(if (= UseButton 2)
	(alert (strcat "\nTho\U+00E1t"))
)


(Princ)
)




(defun Getlayer ( / lyr)
(vlax-for lyr
	(vla-get-layers
		(vla-get-activedocument
			(vlax-get-acad-object)
	        )
        )		
(setq LstLayer (cons (vla-get-name lyr) LstLayer))
)
LstLayer
)




(defun GetTextStyle ( / styl_)
(vlax-for styl_
	(vla-get-textstyles
		(vla-get-activedocument
			(vlax-get-acad-object)
	        )
        )		
(setq LstTextStyle (cons (vla-get-name styl_) LstTextStyle))
)
LstTextStyle
)


(defun GCT(TextGhiChu h LayerText TextStyle / i Olmode Gocxoay);;;;GHI CHU TEXT
(setq i 0)
(while
  	(setvar "OSMODE" 0)
	(setq P1 (Getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m ch\U+00E8n TEXT ghi ch\U+00FA: :  "))
	(setq P2 (Getpoint  P1 "\nChon huong ghi chu TEXT:  "))
  	(setq Gocxoay (Angle (trans P1 1 0)
                             (trans P2 1 0)
		      )
	)
	(command "Style" "Times New Roman"  "Times New Roman"  0 1 0 "" "" "" )
	(entmake (list  (cons 0 "TEXT") (cons 10 P1) (cons 8 LayerText) (cons 40 (atof h)) (cons 50 Gocxoay) (cons 7 TextStyle) (cons 1 TextGhiChu)))
  	(setq i (1+ i))
)
)

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


Nhờ các bác chỉnh sửa giúp

Em cảm ơn nhiều


<<

Filename: 310274_gcd.lsp
Tác giả: Tot77
Bài viết gốc: 310286
Tên lệnh: gcd
hỏi vấn đề tạo liên kết LSP và dialog DCL

Sửa lại cho bạn.

(defun C:GCD ( / dcl_id  LtsLayer LtsStyle h Text_ghichu )
(setq dcl_id (load_dialog "GHICHU.DCL"))
(if (not (new_dialog "GHICHU" dcl_id))
 (exit)
)
  
(action_tile "Text_ghichu"  "(setq TextGhiChu $value)")
(mode_tile "Text_ghichu" 2)
(action_tile "Height_Text"  "(setq h $value)")
(mode_tile "Height_Text" 2)
 
(start_list "LTSLAY")
(mapcar 'add_list (setq LstLayer (Getlayer)))
(end_list)
  
(if...
>>

Sửa lại cho bạn.

(defun C:GCD ( / dcl_id  LtsLayer LtsStyle h Text_ghichu )
(setq dcl_id (load_dialog "GHICHU.DCL"))
(if (not (new_dialog "GHICHU" dcl_id))
 (exit)
)
  
(action_tile "Text_ghichu"  "(setq TextGhiChu $value)")
(mode_tile "Text_ghichu" 2)
(action_tile "Height_Text"  "(setq h $value)")
(mode_tile "Height_Text" 2)
 
(start_list "LTSLAY")
(mapcar 'add_list (setq LstLayer (Getlayer)))
(end_list)
  
(if #CurLay
(set_tile "LTSLAY" #CurLay)
(set_tile "LTSLAY"  "0")
)
(action_tile "LTSLAY" "(setq #CurLay $value)")
 
(start_list "LTSTEXTSTYLE")
(mapcar 'add_list (setq LstTextStyle (GetTextStyle)))
(end_list)
  
 
(if #CurStyle
(set_tile "LTSTEXTSTYLE" #CurStyle)
(set_tile "LTSTEXTSTYLE" "Standard")
)
(action_tile "LTSTEXTSTYLE" "(setq #CurStyle $value)")
 
(if (not TextGhiChu) (setq TextGhiChu (get_tile "Text_ghichu")))
(if (not #CurLay) (setq #CurLay (get_tile "LTSLAY")))
(if (not #CurStyle) (setq #CurStyle (get_tile "LTSTEXTSTYLE")))
  
(action_tile "Accept" "(setq UseButton 1)(done_dialog)")
(action_tile "Cancel" "(setq UseButton 2)(done_dialog)")
 
(start_dialog)
(unload_dialog dcl_id)
(if (= UseButton 1)
(progn 
 (GCT TextGhiChu h #CurLay #CurStyle)
)
)
(if (= UseButton 2)
(alert (strcat "\nTho\U+00E1t"))
)
(Princ)
)
 
(defun Getlayer ( / lyr l)
  (setq l nil)
  (vlax-for lyr
(vla-get-layers
(vla-get-activedocument
(vlax-get-acad-object)
       )
        ) 
    (setq l (cons (vla-get-name lyr) l))
  )
  l
)
 
(defun GetTextStyle ( / styl_ l)
  (setq l nil)
  (vlax-for styl_
(vla-get-textstyles
(vla-get-activedocument
(vlax-get-acad-object)
       )
        ) 
    (setq l (cons (vla-get-name styl_) l))
  )
  l
)
 
 
(defun GCT(TextGhiChu h LayerText TextStyle / i Olmode Gocxoay);;;;GHI CHU TEXT
  (command "Style" "Times New Roman"  "Times New Roman"  0 1 0 "" "" "" )
  (while (setq P1 (Getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m ch\U+00E8n TEXT ghi ch\U+00FA: "))
(setq P2 (Getpoint  P1 "\nChon huong ghi chu TEXT: "))
   (setq Gocxoay (Angle (trans P1 1 0)
                             (trans P2 1 0)
     )
) 
(entmake (list  (cons 0 "TEXT") (cons 10 P1) (cons 8 (nth (atoi LayerText) LstLayer))
(cons 40 (atof h)) (cons 50 Gocxoay)
(cons 7 (nth (atoi TextStyle) LstTextStyle)) (cons 1 TextGhiChu)))   
  )
)
 
;;;-------------------------------------------------------------
 
 

<<

Filename: 310286_gcd.lsp

Trang 170/313

170