Jump to content
InfoFile
Tác giả: Phiphi-
Bài viết gốc: 66899
Tên lệnh: ttoa
Viết Lisp theo yêu cầu
Lisp ttoa mà Tue_NV viết cho Phi phi dựa trên tiêu chí WYSIWYG

Các bạn chạy thử xem và cho mình biết ý kiến nhé :

;copyright by Tue_NV
(defun c:ttoa(/ dt n...
>>
Lisp ttoa mà Tue_NV viết cho Phi phi dựa trên tiêu chí WYSIWYG

Các bạn chạy thử xem và cho mình biết ý kiến nhé :

;copyright by Tue_NV
(defun c:ttoa(/ dt n i ss1 ent tval L kytunoi kytu j tname cao po10 po11 styl LA
mau dxf71 dxf72 dxf73 ang wid)
(command "undo" "be")
(setq dt (ssget '((0 . "TEXT"))) n (sslength dt) i 0 ss1 (ssadd))
(while (< i n)
(if dt
(progn
(setq ent (ssname dt i))
(setq tval (cdr(assoc 1 (entget ent))))

(setq L (strlen tval) j 1)
(setq kytunoi "")
(Repeat L
(setq kytu (substr tval j 1))
(if (= kytu " ")
(setq kytu "_") 
(setq kytu (substr tval j 1))
)
(setq kytunoi (strcat kytunoi kytu))

(setq j (1+ j))
)

(setq tname kytunoi)
(setq cao (cdr(assoc 40 (entget ent))))
(setq po10 (cdr(assoc 10 (entget ent))))
(setq po11 (cdr(assoc 11 (entget ent))))
(setq styl (cdr(assoc 7 (entget ent))))
(setq LA (cdr(assoc 8 (entget ent))))
(if (= (cdr(assoc 62 (entget ent))) nil)
(setq mau (cdr(assoc 62 (tblsearch "layer" LA))))
(setq mau (cdr(assoc 62 (entget ent))))
)
(setq ang (cdr(assoc 50 (entget ent))))
(setq wid (cdr(assoc 41 (entget ent))))
(setq dxf71 (cdr(assoc 71 (entget ent))))
(setq dxf72 (cdr(assoc 72 (entget ent))))
(setq dxf73 (cdr(assoc 73 (entget ent))))

(watt tname tval po10 po11 dxf71 dxf72 dxf73 cao styl mau ang wid)
(setq ss1 (ssadd (entlast) ss1))
(entdel ent)
)
)
(setq i (1+ i))
)
(sssetfirst ss1 ss1)
(command "copybase" po10 ss1 "")
(Command "pasteblock" po10)
(Command "erase" ss1 "")
(command "undo" "end")
(princ)
)
;
;
;
(defun watt (tagname tagval p1 p2 d71 d72 d73 h sty col goc rong / promp)
(setq promp tagname)
(entmake (list (cons 0 "ATTDEF") (cons 7 sty) (cons 62 col) (cons 2 Tagname) (cons 3 promp) 
(cons 1 tagval) (cons 71 d71) (cons 72 d72) (cons 74 d73) (cons 10 p1) (cons 11 p2) (cons 40 h)
(cons 50 goc) (cons 41 rong)
'(70 . 8) 
)
)
)

Cám ơn Tue_NV và Gia_bach đã viết LISP tự động chuyển các TEXT thành các ATTRIBUTE. PP hy vọng LISP này sẽ giúp ích rất nhiều cho các Drafters khi biết tận dụng các đặc tính hay của Attribute áp dụng trong các bản vẽ AutoCAD. Sẽ có rất nhiều cái để áp dụng với LISP này. Và nếu kết hợp với Excell thì phạm vi áp dụng sẽ đa dạng. Một thí dụ đơn giản như là Explode các dim rồi thay đổi các chử số của dim thành các tên gọi khác trước khi dùng LISP trên, như vậy sẽ có nhiều Attribute để sử dụng khi muốn thay đổi...


<<

Filename: 66899_ttoa.lsp
Tác giả: Doan Nguyen Van
Bài viết gốc: 444123
Tên lệnh: te
Lấy chiều dài của đối tượng trong BLOCK động

Các Parameter của bác ấy không tính ra tổng của chiều dài thép dọc, vì có 1 đoạn cuối bên phải chạy lung tung.

Viết tạm cái code này bác dùng tạm, nếu tổng các parameter cần thiết có thể tính ra chiều dài thép thì có thể dùng Field cũng rất tiện lợi

(vl-
>>

Các Parameter của bác ấy không tính ra tổng của chiều dài thép dọc, vì có 1 đoạn cuối bên phải chạy lung tung.

Viết tạm cái code này bác dùng tạm, nếu tổng các parameter cần thiết có thể tính ra chiều dài thép thì có thể dùng Field cũng rất tiện lợi

(vl-load-com)
(Defun c:te (/ ent ent2 ent3 lst tong)
  (setq ent (Car (entsel "Pick Block Dyn")))
  (setq ent2 (Car (entsel "Pick ATT Block")))
  (setq lst (mapcar '(lambda(x)  (vlax-vla-object->ename x) )
      (vlax-invoke (vlax-ename->vla-object ent) 'explode)))
  (setq tong 0.0)
  (foreach ent3 lst
    (IF (and (wcmatch (CDR (ASSOC 0 (ENTGET ENT3))) "*LINE")
	     (wcmatch (CDR (ASSOC 8 (ENTGET ENT3))) "THEPDOC"))
    (setq tong (+ tong (vla-get-length (vlax-ename->vla-object ent3)))) )
    (entdel ent3)
    )
  (ACET-INSERT-ATTRIB-SET ent2 (list (list "L" (rtos tong 2 0))) t)
  (princ)
  )

 


<<

Filename: 444123_te.lsp
Tác giả: truongthanh
Bài viết gốc: 66724
Tên lệnh: ist
Viết Lisp theo yêu cầu
Trước đây mình có viết cái này gần giống với yêu cầu của bạn, bạn dùng thử xem. Nó dùng cho các loại đường, k0 riêng gì pline.

(defun c:ist(/ chu os...
>>
Trước đây mình có viết cái này gần giống với yêu cầu của bạn, bạn dùng thử xem. Nó dùng cho các loại đường, k0 riêng gì pline.

(defun c:ist(/ chu os ent obj ndai p1 p2 pm ang caoc)
 (vl-load-com)
 (if (not caoc) (setq caoc 1))
 (setq chu (vla-get-TextString (vlax-ename->vla-object (car (entsel "\nChon chu :"))))
caoc1 (getreal (strcat "\nCao chu <" (rtos caoc) ">:"))
       os (getvar "OSMODE")
ent (car (entsel "\nChon duong de chen :")))
 (if caoc1 (setq caoc caoc1))

 (setvar "OSMODE" 0)  
 (while ent
   (setq obj  (vlax-ename->vla-object ent)
  ndai (/ (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj)) 2)
  pr   (vlax-curve-getParamAtDist obj ndai)  
  p1   (vlax-curve-getPointAtParam obj (- pr 0.1))
  p2   (vlax-curve-getPointAtParam obj (+ pr 0.1))
  pm   (vlax-curve-getPointAtParam obj pr)
  ang  (if (< (car p1) (car p2)) (angle p1 p2) (angle p2 p1))
   )
   (command "text" "j" "BC" pm caoc (* 180 (/ ang pi)) chu)
   (setq ent (car (entsel "\nChon duong de chen :")))
 )
 (setvar "OSMODE" os)
)

cảm ơn bạn nhé!nhưng sao mình dùng cái này ko giống với ý mình!nó hiện ra 1 dãy số gì đó dài nhằng và nó nằm 1 góc 1 độ chứ nó ko có xoay theo Pline!bạn coi lại giúp mình nhé!


<<

Filename: 66724_ist.lsp
Tác giả: Danh Cong
Bài viết gốc: 444182
Tên lệnh: sline
Lisp chỉ đúng khi sử dụng lần đâu
Vào lúc 12/2/2020 tại 05:55, 790312 đã nói:

Cảm ơn bác đã...

>>
Vào lúc 12/2/2020 tại 05:55, 790312 đã nói:

Cảm ơn bác đã bỏ thời gian check. Nhưng bác sử dụng lisp này vẽ mũi tên xong, sau đó bác zoom nhỏ hình lại và vẽ đoạn thẳng khác dài hơn thì nó sẽ bị lỗi là chỉ vẽ mũi tên ở một đầu thôi bác ah. E gửi bác lisp e down ở bài 12 từ trên xuống của chính chủ, bác check như e nói xem. Cảm ơn bác nhiều.

  • sline.lsp
    lisp help
  •  

;; free lisp from cadviet.com
;; this lisp was downloaded from https://www.cadviet.com/forum/topic/47541-%C4%91%C3%A3-xong-lisp-v%E1%BA%BD-pline-m%C5%A9i-t%C3%AAn-2-%C4%91%E1%BA%A7u/
(defun c:sline (/ loop p1 p2 lstPnt)   
 (grtext -1 "Free from Cadviet.com @Ketxu")
 (setq lstPnt '())
 (if (not asize) (setq asize 1))      
 (if (not PThk)  (setq PThk 0.01))                 
 (defun GETR (val msg / tm)
   (setq tm (getreal (strcat msg " <" (rtos val 2 4) ">: ")))
   (cond ((= (type tm) 'REAL) (eval tm))
         ((= tm nil) (eval val))
         (t (princ "\007 *error* Nh\U+1EADp sai lo\U+1EA1i d\U+1EEF li\U+1EC7u") (eval val)) ) )
 (defun loop ()
   (cond ((and(setq p2 (getpoint p1 "\n\U+0110i\U+1EC3m ti\U+1EBFp theo : "))(setq lstPnt (append (list p2) lstPnt))) (command p2) 
                                    (setq p0 p1) (setq p1 p2) (loop))
         ( t (command "u" (polar p1 (angle p1 p0) asize)
                      "w" (/ asize 3) 0.0 p1 ""))))
 (setq asize (getr asize "\nK\U+00EDch th\U+01B0\U+1EDBc m\U+0169i t\U+00EAn :"))
 (setq PThk  (getr PThk "\n B\U+1EC1 r\U+1ED9ng PLine :"))
 (setq p1 (getpoint "\n\U+0110i\U+1EC3m b\U+1EAFt \U+0111\U+1EA7u : "))
 (setq lstPnt (append (list p1) lstPnt))
 (command "pline" p1 "w" 0.0 0.0)
 (setq p2 (getpoint p1 "\n\U+0110i\U+1EC3m ti\U+1EBFp theo : "))
 (setq lstPnt (append (list p2) lstPnt))
 (command "w" 0.0 (/ asize 3) (polar p1 (angle p1 p2) asize) 
          "w" PThk PThk p2)
 (setq p1 p2)
 (loop)
(if  (ST:Geo-ListLinear lstPnt)
(foreach pt (cdr (vl-remove (last lstPnt) lstPnt)) (ST:Entmake-Circle pt 50))
)
 (eval "Done")
)
(defun ST:Geo-Linear ( p1 p2 p3 fuzz)
 (
   (lambda ( a b c )
     (or
       (equal (+ a B) c fuzz)
       (equal (+ b c) a fuzz)
       (equal (+ c a) b fuzz)
     )
   )
   (distance p1 p2) (distance p2 p3) (distance p1 p3)
 )
)
(defun ST:Geo-ListLinear (lst / tmp)
(setq i 2)
(cond ((and (= (length lst) 3)(ST:Geo-Linear(car lst)(cadr lst)(caddr lst) 1e-8))(setq tmp T))
	(T (while (and (< i (1- (length lst)))
			(setq tmp (ST:Geo-Linear (nth 0 lst)(nth 1 lst) (nth (setq i (1+ i)) lst) 1e-8)))
			tmp
		)
	)
)
tmp
)
(defun ST:Entmake-Circle ( Pt Rad )(entmakex (list '(0 . "CIRCLE") (cons 10 pt)(cons 40 Rad))))

Đúng là có lúc lisp lỗi thật, đúng như bác NTDNV nói trên. Lỗi thì do anh KetXu chưa xử lý chế độ bắt điểm khi viết lisp thôi.

Tôi sửa thêm 1 số chỗ về bắt điểm nữa, bạn có thể tải về kiểm tra:



;; free lisp from cadviet.com
;; this lisp was downloaded from https://www.cadviet.com/forum/topic/47541-đã-xong-lisp-vẽ-pline-mũi-tên-2-đầu/
(defun c:sline (/ loop p1 p2 lstPnt)   
 (grtext -1 "Free from Cadviet.com @Ketxu")
 (setq lstPnt '())
 (if (not asize) (setq asize 1))      
 (if (not PThk)  (setq PThk 0.01))                 
 (defun GETR (val msg / tm)
   (setq tm (getreal (strcat msg " <" (rtos val 2 4) ">: ")))
   (cond ((= (type tm) 'REAL) (eval tm))
         ((= tm nil) (eval val))
         (t (princ "\007 *error* Nh\U+1EADp sai lo\U+1EA1i d\U+1EEF li\U+1EC7u") (eval val)) ) )
 (defun loop ()
   (cond ((and(setq p2 (getpoint p1 "\n\U+0110i\U+1EC3m ti\U+1EBFp theo : "))(setq lstPnt (append (list p2) lstPnt))) (command "non" p2) 
                                    (setq p0 p1) (setq p1 p2) (loop))
         ( t (command "u" (polar p1 (angle p1 p0) asize)
                      "w" (/ asize 3) 0.0 "non" p1 ""))))
 (setq asize (getr asize "\nK\U+00EDch th\U+01B0\U+1EDBc m\U+0169i t\U+00EAn :"))
 (setq PThk  (getr PThk "\n B\U+1EC1 r\U+1ED9ng PLine :"))
 (setq p1 (getpoint "\n\U+0110i\U+1EC3m b\U+1EAFt \U+0111\U+1EA7u : "))
 (setq lstPnt (append (list p1) lstPnt))
 (command "pline" "non" p1 "w" 0.0 0.0)
 (setq p2 (getpoint p1 "\n\U+0110i\U+1EC3m ti\U+1EBFp theo : "))
 (setq lstPnt (append (list p2) lstPnt))
 (command "w" 0.0 (/ asize 3) (polar p1 (angle p1 p2) asize) 
          "w" PThk PThk "non" p2)
 (setq p1 p2)
 (loop)
(if  (ST:Geo-ListLinear lstPnt)
(foreach pt (cdr (vl-remove (last lstPnt) lstPnt)) (ST:Entmake-Circle pt 50))
)
 (eval "Done")
)
(defun ST:Geo-Linear ( p1 p2 p3 fuzz)
 (
   (lambda ( a b c )
     (or
       (equal (+ a B) c fuzz)
       (equal (+ b c) a fuzz)
       (equal (+ c a) b fuzz)
     )
   )
   (distance p1 p2) (distance p2 p3) (distance p1 p3)
 )
)
(defun ST:Geo-ListLinear (lst / tmp)
(setq i 2)
(cond ((and (= (length lst) 3)(ST:Geo-Linear(car lst)(cadr lst)(caddr lst) 1e-8))(setq tmp T))
    (T (while (and (< i (1- (length lst)))
            (setq tmp (ST:Geo-Linear (nth 0 lst)(nth 1 lst) (nth (setq i (1+ i)) lst) 1e-8)))
            tmp
        )
    )
)
tmp
)
(defun ST:Entmake-Circle ( Pt Rad )(entmakex (list '(0 . "CIRCLE") (cons 10 pt)(cons 40 Rad))))v


<<

Filename: 444182_sline.lsp
Tác giả: 790312
Bài viết gốc: 444193
Tên lệnh: sd sline
Lisp chỉ đúng khi sử dụng lần đâu
9 giờ trước, Danh Cong đã nói:

Đúng là có lúc lisp lỗi thật,...

>>
9 giờ trước, Danh Cong đã nói:

Đúng là có lúc lisp lỗi thật, đúng như bác NTDNV nói trên. Lỗi thì do anh KetXu chưa xử lý chế độ bắt điểm khi viết lisp thôi.

Tôi sửa thêm 1 số chỗ về bắt điểm nữa, bạn có thể tải về kiểm tra:

 

  • sline.lsp
    lisp help
  •  




;; free lisp from cadviet.com
;; this lisp was downloaded from https://www.cadviet.com/forum/topic/47541-đã-xong-lisp-vẽ-pline-mũi-tên-2-đầu/
	(defun c:sline (/ loop p1 p2 lstPnt)   
	 (grtext -1 "Free from Cadviet.com @Ketxu")
	 (setq lstPnt '())
	 (if (not asize) (setq asize 1))      
	 (if (not PThk)  (setq PThk 0.01))                 
	 (defun GETR (val msg / tm)
	   (setq tm (getreal (strcat msg " <" (rtos val 2 4) ">: ")))
	   (cond ((= (type tm) 'REAL) (eval tm))
	         ((= tm nil) (eval val))
	         (t (princ "\007 *error* Nh\U+1EADp sai lo\U+1EA1i d\U+1EEF li\U+1EC7u") (eval val)) ) )
	 (defun loop ()
	   (cond ((and(setq p2 (getpoint p1 "\n\U+0110i\U+1EC3m ti\U+1EBFp theo : "))(setq lstPnt (append (list p2) lstPnt))) (command "non" p2) 
	                                    (setq p0 p1) (setq p1 p2) (loop))
	         ( t (command "u" (polar p1 (angle p1 p0) asize)
	                      "w" (/ asize 3) 0.0 "non" p1 ""))))
	 (setq asize (getr asize "\nK\U+00EDch th\U+01B0\U+1EDBc m\U+0169i t\U+00EAn :"))
	 (setq PThk  (getr PThk "\n B\U+1EC1 r\U+1ED9ng PLine :"))
	 (setq p1 (getpoint "\n\U+0110i\U+1EC3m b\U+1EAFt \U+0111\U+1EA7u : "))
	 (setq lstPnt (append (list p1) lstPnt))
	 (command "pline" "non" p1 "w" 0.0 0.0)
	 (setq p2 (getpoint p1 "\n\U+0110i\U+1EC3m ti\U+1EBFp theo : "))
	 (setq lstPnt (append (list p2) lstPnt))
	 (command "w" 0.0 (/ asize 3) (polar p1 (angle p1 p2) asize) 
	          "w" PThk PThk "non" p2)
	 (setq p1 p2)
	 (loop)
	(if  (ST:Geo-ListLinear lstPnt)
	(foreach pt (cdr (vl-remove (last lstPnt) lstPnt)) (ST:Entmake-Circle pt 50))
	)
	 (eval "Done")
	)
	(defun ST:Geo-Linear ( p1 p2 p3 fuzz)
	 (
	   (lambda ( a b c )
	     (or
	       (equal (+ a B) c fuzz)
	       (equal (+ b c) a fuzz)
	       (equal (+ c a) b fuzz)
	     )
	   )
	   (distance p1 p2) (distance p2 p3) (distance p1 p3)
	 )
	)
	(defun ST:Geo-ListLinear (lst / tmp)
	(setq i 2)
	(cond ((and (= (length lst) 3)(ST:Geo-Linear(car lst)(cadr lst)(caddr lst) 1e-8))(setq tmp T))
	    (T (while (and (< i (1- (length lst)))
	            (setq tmp (ST:Geo-Linear (nth 0 lst)(nth 1 lst) (nth (setq i (1+ i)) lst) 1e-8)))
	            tmp
	        )
	    )
	)
	tmp
	)
	(defun ST:Entmake-Circle ( Pt Rad )(entmakex (list '(0 . "CIRCLE") (cons 10 pt)(cons 40 Rad))))v

Cảm ơn bác nhiều. Lisp chạy ok, nhưng nếu để nó là một file thì OK, còn nếu mình đưa nó vào chung file với một lisp khác thì nó k chạy. Mong các bác bỏ tí thời gian check giùm mình với.

;; ===========SAP XEP DIM CACH DEU NHAU==============================

(defun c:sd ()
  (defun ss2ent	(ss / sodt index lstent)
    (setq
      sodt  (cond
	      (ss (sslength ss))
	      (t 0)
	    )
      index 0
    )
    (repeat sodt
      (setq ent	   (ssname ss index)
	    index  (1+ index)
	    lstent (cons ent lstent)
      )
    )
    (reverse lstent)
  )
  (defun hoanh_newerror	(msg)
    (if	(and (/= msg "Function cancelled")
	     (/= msg "quit / exit abort")
	)
      (princ (strcat "\n" msg))
    )
    (done)
  )
  ;;----------
  (defun init ()
    (setq
      HOANH_CMD	     (getvar "CMDECHO")
      HOANH_OLDERROR *error*
      *error*	     hoanh_newerror

    )
    (setvar "CMDECHO" 0)
    (command ".undo" "BE")
  )
  ;;----------
  (defun done ()
    (command ".redraw")
    (command ".undo" "E")
    (if	HOANH_CMD
      (setvar "CMDECHO" HOANH_CMD)
    )
    (if	HOANH_OLDERROR
      (setq *error* HOANH_OLDERROR)
    )
    (princ)
  )
  ;;----------

  (defun cdim (entdt	pchan	 pduong	  /	   tt	    old10
	       old13	old14	 new10	  new13	   new14    p10n
	       p13n	p14n	 p10o	  p13o	   p14o	    gocduong
	       gocchan	pchanb	 pduongb  loaidim
	      )
    (defun chanvuonggoc	(ph p1 p2 / ptemp pkq goc)
      (setq
	goc   (+ (angle p1 p2) (/ pi 2.0))
	ptemp (polar ph goc 1000.0)
	pkq   (inters ph ptemp p1 p2 nil)
      )
      pkq
    )
    (setq
      tt       (entget entdt)
      old10    (assoc '10 tt)
      old13    (assoc '13 tt)
      old14    (assoc '14 tt)
      p10o     (cdr old10)
      p13o     (cdr old13)
      p14o     (cdr old14)
      loaidim  (logand (cdr (assoc '70 tt)) 7)
      gocduong (cond
		 ((= loaidim 1) (angle p13o p14o))
		 ((= loaidim 0) (cdr (assoc '50 tt)))
		 (t nil)
	       )
      pchan    (cond
		 (pchan (list (car pchan) (cadr pchan) 0.0))
		 (t pchan)
	       )
      pduong   (cond
		 (pduong (list (car pduong) (cadr pduong) 0.0))
		 (t pduong)
	       )

    )
    (if	gocduong
      (progn
	(if pchan
	  (setq
	    pchanb (polar pchan gocduong 1000.0)
	    p13n   (chanvuonggoc
		     (list (car p13o) (cadr p13o) 0.0)
		     pchan
		     pchanb
		   )
	    p14n   (chanvuonggoc
		     (list (car p14o) (cadr p14o) 0.0)
		     pchan
		     pchanb
		   )
	    new13  (cons 13 p13n)
	    new14  (cons 14 p14n)
	    tt	   (subst new13 old13 tt)
	    tt	   (subst new14 old14 tt)
	  )
	)
	(if pduong
	  (setq
	    pduongb (polar pduong gocduong 1000.0)
	    p10n    (chanvuonggoc
		      (list (car p10o) (cadr p10o) 0.0)
		      pduong
		      pduongb
		    )
	    new10   (cons 10 p10n)
	    tt	    (subst new10 old10 tt)
	  )
	)
	(entmod tt)
      )
    )
    gocduong
  )

  (defun textdimheight (ent / tmp)
    (command ".copy" ent "" (list 0.0 0.0 0.0) "@")
    (command ".explode" (entlast) "")
    (setq tmp (cdr (assoc 40 (entget (entlast)))))
    (command ".erase" "p" "")
    tmp
  )
  (defun phia (p1 p2 p3 / x1 y1 z1 x2 y2 z2 x3 y3 z3)
    (setq
      x1  (car p1)
      y1  (cadr p1)
      z1  (caddr p1)
      x2  (car p2)
      y2  (cadr p2)
      z2  (caddr p2)
      x3  (car p3)
      y3  (cadr p3)
      z3  (caddr p3)
      tmp (+ (* (- x1 x2) x3)
	     (* (- y1 y2) y3)
	     (* (- z1 z2) z3)
	  )
    )
    (cond
      ((= tmp 0.0) 0.0)
      (t (/ tmp (abs tmp)))
    )
  )
  (defun khoangcachdim (p1 ent goc / tt p2 A B D)
    (setq tt (entget ent)
	  p2 (cdr (assoc 10 tt))
	  B  (cdr (assoc 50 tt))
	  A  (angle p1 p2)
	  D  (distance p1 p2)
    )
    (* (* D (sin (- A B))) (phia p1 (polar p1 goc 1.0) p2))
  )

  (defun phanloai (ent)
    (setq
      kc   (khoangcachdim pgoc ent goc)
      loai (fix (/ kc heightdimgoc 0.93))
    )
    (cons loai ent)
  )

  (init)
  (princ "\nSap xep dim © CADViet.com")
  (while (not (setq entgoc (car (entsel "\nSelect orginal dimension: "))))
  )
  (setq
    ttgoc	 (entget entgoc)
    p13goc	 (cdr (assoc 13 ttgoc))
    pgoc	 (cdr (assoc 10 ttgoc))
    goc		 (cdr (assoc 50 ttgoc))
    heightdimgoc (textdimheight entgoc)
    ssd		 (ssget	(list
			  (cons 0 "DIMENSION")
			  (cons -4 "<OR")
			  (cons 70 32)
			  (cons 70 64)
			  (cons 70 96)
			  (cons 70 128)
			  (cons 70 160)
			  (cons 70 196)
			  (cons 70 224)
			  (cons -4 "OR>")
			  (cons -4 "<OR")
			  (cons 50 goc)
			  (cons 50 (+ goc pi))
			  (cons 50 (- goc pi))
			  (cons -4 "OR>")
			)
		 )
    lstd	 (ss2ent ssd)
    lstd	 (mapcar 'phanloai lstd)
    lstlevel	 nil
  )
  (foreach pp lstd
    (if	(not (member (car pp) lstlevel))
      (setq lstlevel (append lstlevel (list (car pp))))
    )
  )
  (setq	lstlevel    (vl-sort lstlevel '(lambda (x1 x2) (< x1 x2)))
	lstam	    nil
	lstduong    nil
	lstamtmp    nil
	lstduongtmp nil
  )
  (foreach pp lstlevel
    (if	(< pp 0.0)
      (setq lstam (append lstam (list pp)))
    )
    (if	(> pp 0.0)
      (setq lstduong (append lstduong (list pp)))
    )
  )
  (setq index 0)
  (foreach pp (reverse lstam)
    (setq
      index    (1+ index)
      lstamtmp (append lstamtmp (list (cons pp index)))
    )
  )
  (setq
    lstam lstamtmp
    index 0
  )
  (foreach pp lstduong
    (setq
      index	  (1+ index)
      lstduongtmp (append lstduongtmp (list (cons pp index)))
    )
  )
  (setq lstduong lstduongtmp)
  (setq lstlevel (append lstduong lstam (list (cons 0.0 0))))

  (setq kcdimstandard (* 2.8 heightdimgoc))
  (foreach pp lstd
    (setq plht (car pp))
    (progn
      (setq
	kcdimht	   (khoangcachdim pgoc (cdr pp) goc)
	duongthu   (cdr (assoc plht lstlevel))
	heso	   (cond
		     ((/= 0 kcdimht)
		      (abs (* (/ kcdimstandard kcdimht) duongthu))
		     )
		     (t 0.0)
		   )
	diemchenht (cdr (assoc 10 (entget (cdr pp))))
	pmoi	   (polar pgoc
			  (angle pgoc diemchenht)
			  (* heso (distance pgoc diemchenht))
		   )
      )

      (cdim (cdr pp) p13goc pmoi)
    )
  )
  (done)
)
(princ)
)

;; free lisp from cadviet.com
;; this lisp was downloaded from https://www.cadviet.com/forum/topic/47541-đã-xong-lisp-vẽ-pline-mũi-tên-2-đầu/
	(defun c:sline (/ loop p1 p2 lstPnt)   
	 (grtext -1 "Free from Cadviet.com @Ketxu")
	 (setq lstPnt '())
	 (if (not asize) (setq asize 1))      
	 (if (not PThk)  (setq PThk 0.01))                 
	 (defun GETR (val msg / tm)
	   (setq tm (getreal (strcat msg " <" (rtos val 2 4) ">: ")))
	   (cond ((= (type tm) 'REAL) (eval tm))
	         ((= tm nil) (eval val))
	         (t (princ "\007 *error* Nh\U+1EADp sai lo\U+1EA1i d\U+1EEF li\U+1EC7u") (eval val)) ) )
	 (defun loop ()
	   (cond ((and(setq p2 (getpoint p1 "\n\U+0110i\U+1EC3m ti\U+1EBFp theo : "))(setq lstPnt (append (list p2) lstPnt))) (command "non" p2) 
	                                    (setq p0 p1) (setq p1 p2) (loop))
	         ( t (command "u" (polar p1 (angle p1 p0) asize)
	                      "w" (/ asize 3) 0.0 "non" p1 ""))))
	 (setq asize (getr asize "\nK\U+00EDch th\U+01B0\U+1EDBc m\U+0169i t\U+00EAn :"))
	 (setq PThk  (getr PThk "\n B\U+1EC1 r\U+1ED9ng PLine :"))
	 (setq p1 (getpoint "\n\U+0110i\U+1EC3m b\U+1EAFt \U+0111\U+1EA7u : "))
	 (setq lstPnt (append (list p1) lstPnt))
	 (command "pline" "non" p1 "w" 0.0 0.0)
	 (setq p2 (getpoint p1 "\n\U+0110i\U+1EC3m ti\U+1EBFp theo : "))
	 (setq lstPnt (append (list p2) lstPnt))
	 (command "w" 0.0 (/ asize 3) (polar p1 (angle p1 p2) asize) 
	          "w" PThk PThk "non" p2)
	 (setq p1 p2)
	 (loop)
	(if  (ST:Geo-ListLinear lstPnt)
	(foreach pt (cdr (vl-remove (last lstPnt) lstPnt)) (ST:Entmake-Circle pt 50))
	)
	 (eval "Done")
	)
	(defun ST:Geo-Linear ( p1 p2 p3 fuzz)
	 (
	   (lambda ( a b c )
	     (or
	       (equal (+ a B) c fuzz)
	       (equal (+ b c) a fuzz)
	       (equal (+ c a) b fuzz)
	     )
	   )
	   (distance p1 p2) (distance p2 p3) (distance p1 p3)
	 )
	)
	(defun ST:Geo-ListLinear (lst / tmp)
	(setq i 2)
	(cond ((and (= (length lst) 3)(ST:Geo-Linear(car lst)(cadr lst)(caddr lst) 1e-8))(setq tmp T))
	    (T (while (and (< i (1- (length lst)))
	            (setq tmp (ST:Geo-Linear (nth 0 lst)(nth 1 lst) (nth (setq i (1+ i)) lst) 1e-8)))
	            tmp
	        )
	    )
	)
	tmp
	)
	(defun ST:Entmake-Circle ( Pt Rad )(entmakex (list '(0 . "CIRCLE") (cons 10 pt)(cons 40 Rad))))

 


<<

Filename: 444193_sd_sline.lsp
Tác giả: truongthanh
Bài viết gốc: 127495
Tên lệnh: cdc
Viết lisp theo yêu cầu [phần 2]
Chào bạn Truongthanh,

Hề hề hề,

Của bạn đây, hy vọng lần này bạn sẽ hài lòng.

;tinh cao do cong
(defun C:cdc (/ s1 L1 i1 txt i n...
>>
Chào bạn Truongthanh,

Hề hề hề,

Của bạn đây, hy vọng lần này bạn sẽ hài lòng.

;tinh cao do cong
(defun C:cdc (/ s1 L1 i1 txt i n k m t1 t2 t3 m1 s2 p2 p3 p4 p5 p6 )
   ;;;;;(setq s1 (getreal "\nCAO DO DAY CONG DIEM DAU: "))
   ;;;;;(setq L1 (getreal "\nCHIEU DAI CONG: "))
   ;;;;;(setq i1 (getreal "\nDO DOC CONG: "))
   (setq s1 (atof (cdr (assoc 1 (entget (car (entsel "\n Chon text cao do day cong diem dau")))))))
   (setq txt (cdr (assoc 1 (entget (car (entsel "\n Chon text chuan " )))))
       i 1
      n (strlen txt)
      k nil
   ) 
   (while (<= i n)
        (setq kt (substr txt i 1))
        (if (= kt "-")
            (progn
                    (setq k i
                            i n)
            )
         )
         (setq i (1+ i))
)
(if k
(progn
(setq t1 (substr txt 1 (- k 2))
       t2 (substr txt (+ k 3) n)
)
(setq n (strlen t2)
       i 1
       m nil
)
(while (<= i n)
        (setq kt (substr t2 i 1))
        (if (= kt "-")
            (progn
                    (setq m i
                            i n)
            )
         )
         (setq i (1+ i))
)
(if m
  (progn   
  (setq t3 (substr t2 (+ m 3) n))
  (setq t2 (substr t2 1 (- m 2)))
  )
)
)
)
   (setq L1 (atof t2)
           i1 ( / (atof t3) 1000)
   )
   (setq m1 (getreal "\nNHAP CAO DO THIET KE DIEM: "))
   (setq s2 (- s1 (* L1 i1)))
   (setq p2 (getpoint "\nchon diem cuoi doan cong"))
   (setq p3 (getpoint "\nchon diem dat text"))
   (if (>= (car p3) (car p2))
       (progn
       (setq p4 (polar p3 (/ pi 4) 1))
   (setq p5 (polar p3 0 6))
   (setq p6 (polar p3 (/ (- 0 pi) 4) 1))
       (setvar "snapmode" 0)
   (setvar "osmode" 0)
               (command ".text" p4 "" 0 (strcat (RTOS S2 2 2))
	         ".text" "j" "tl" p6 "" "" (strcat (RTOS m1 2 2))
      		   	 ".pline" p2 "w" 0.1 0.1 p3 p5 "" )
        )
       (progn
       (setq p4 (polar p3 (* (/ pi 4) 3) 1))
   (setq p5 (polar p3 pi 6))
   (setq p6 (polar p3 (* (/ (- 0 pi) 4) 3) 1))
       (setvar "snapmode" 0)
   (setvar "osmode" 0)
               (command ".text" "j" "r" p4 "" 0 (strcat (RTOS S2 2 2))
	         ".text" "j" "tr" p6 "" "" (strcat (RTOS m1 2 2))
      		   	 ".pline" p2 "w" 0.1 0.1 p3 p5 "" )
       )
    )

   (setvar "snapmode" 0)
   (setvar "osmode" 16383)

(princ)
)

Hề hề hề,...

Anh Bình ởi! Nhờ anh sửa cái này dùm em lại 1 chút! Cái chỗ "NHAP CAO DO THIET KE DIEM:" nhờ anh sửa lại là "CHON CAO DO THIET KE DIEM" dùm em lun anh!Em đã có sẵn text trên màn hình rồi!Thanks anh nhiều!Làm phiền anh tí nữa nhé! Chứ cài này em xài OK rùi!


<<

Filename: 127495_cdc.lsp
Tác giả: dung_can
Bài viết gốc: 208271
Tên lệnh: dimnh
Lisp đo khoảng cách các điểm.

Gửi bạn xài thử

;; Free lisp code from CADViet.com - Code by mathan
;; Dim nhanh
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:dimnh (/...
>>

Gửi bạn xài thử

;; Free lisp code from CADViet.com - Code by mathan
;; Dim nhanh
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:dimnh (/ )
(setq dimstyle1 "dim ngang") ;; Sua ten dimstyle tuong ung
(setq dimstyle2 "dim doc") ;; Sua ten dimstyle tuong ung
(setq p1 (getpoint "\nDiem 1..."))
(setq diemmoi (getpoint "\nDiem 2..."))
(setq p3 (getpoint "\nDiem dat dim..."))
(mathan p1 diemmoi)
(setq ktra "OK")
(while (= ktra "OK")
(setq diemcu diemmoi)
(setq diemmoi (getpoint "\nDiem dat dim..."))
(if (= diemmoi nil) (setq ktra "NOT OK") (mathan diemcu diemmoi))
)
)
;;;;;; Dim
(defun mathan ( diemdau diemcuoi / )
(command "-dimstyle" "r" dimstyle1 "")
(command "DIMLINEAR" diemdau diemcuoi p3 "" )
(command "-dimstyle" "r" dimstyle2 "")
(command "DIMLINEAR" p1 diemcuoi p3 "" )
)

Lưu ý: trong đó bạn phải tạo hai dimstyle cho 1 dim ngang và 1 dim dọc và sửa tên dimstyle vào vị trí đánh dấu trong lisp

Bạn có thể tham khảo file cad đính kèmhttp://www.cadviet.c.../102268_dim.dwg

Tuyệt vời quá, em cám ơn bác nhiều lắm.


<<

Filename: 208271_dimnh.lsp
Tác giả: shatashi
Bài viết gốc: 322523
Tên lệnh: cl
Routine tính tổng chiều dài các đối tượng

 

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

 

Đây là link của chương trìn đã compile.

Trong lúc chờ vợ về ăn cơm, viết cái này tặng Bommak nè:

Cái này thì chẳng chuyên nghiệp đâu, cũng chẳng sáng tạo, cần cù một chút là OK:

 

Chuong trinh tinh tong chieu dai cac object - file LISP

;Form chuong trinh va cac thao tac
(DEFUN CALLINE(/ DCL_ID_CALLINE cd_temp ID_ha ss)  
  (setq DCL_ID_CALLINE (load_dialog "CALLINE.DCL"))
  (if (not(new_dialog "CALLINE" DCL_ID_CALLINE)) (exit))  
  (start_list "La_CL")  
  (mapcar 'add_list LiLa)
  (end_list)  
  (Setvalue_CL)
  (action_tile "Sele_CL" "(Getvalue_CL) (done_dialog 2)")
  (action_tile "Info" "(ABOUT)")
  (action_tile "ChkLa_CL" "(IsChkLa_CL)")
  (setq RES (start_dialog))  
  (if (= RES 2)
	(progn	  
	  (prompt "Chon doi tuong:")
	  (setq la_name (LANAME LiLa (atoi la_CL)))	 
	  (if (= chk_CL "1")	
	(setq ss (ssget (List (cons 8 la_name))))
	(setq ss (ssget))
	  )
	  (if (/= ss Nil)
	(progn
	  (setq n (sslength ss))
		  (setq i 0)
		  (While (< i n)
			(setq dt (ssname ss i))
		(if (OR (= (TENDOITUONG dt) "LINE")
				(= (TENDOITUONG dt) "LWPOLYLINE")
								(= (TENDOITUONG dt) "POLYLINE")
				(= (TENDOITUONG dt) "SPLINE")
				(= (TENDOITUONG dt) "ARC")
				(= (TENDOITUONG dt) "CIRCLE"))
		  (progn	  
			(setq ID_ha (ID_HANDLE dt))
			(if (IsNotExist ID_ha)
			  (progn		
				(setq List_obj (Append List_obj (List ID_ha)))
				(setq cd_temp (CDAIOBJ dt))
				(setq chieudai_CL (+ chieudai_CL cd_temp))
			  )
			  (alert "Doi tuong nay da duoc chon")
			)	  
		  )
		)  
			(setq i (+ 1 i))					   
		  )
	)  
	(alert "Khong co doi tuong nao duoc chon!")
	  )
	  (CALLINE)
	)
  )  
  (unload_dialog DCL_ID_CALLINE) 
)
;Khoi dong
(DEFUN CALINIT()
  (CREALILA)
  (if (Null La_CL)
	(setq la_CL "0")
  )  
  (setq chieudai_CL 0)
  (if (Null chk_CL)
	(setq chk_CL "0")
  )
  (setq List_obj Nil)
)
;Cai dat cac gia tri
(DEFUN Setvalue_CL()
  (set_tile "L_CL" (rtos chieudai_CL 2 2))
  (set_tile "La_CL" la_CL)
  (set_tile "ChkLa_CL" chk_CL)
  (IsChkLa_CL)
)
;Nhan gia tri
(DEFUN Getvalue_CL()
  (setq chk_CL (get_tile "ChkLa_CL"))
  (setq chieudai (atof (get_tile "L_CL")))
  (setq la_CL (get_tile "La_CL"))
)
;Nhan handle
(DEFUN ID_HANDLE (obj / idha)
  (setq idha (CDR (ASSOC 5 (ENTGET obj))))  
  idha
)
;Thay doi trang thai
(DEFUN IsChkLa_CL ()
  (if (= (get_tile "ChkLa_CL") "1")
	(mode_tile "La_CL" 0)
	(mode_tile "La_CL" 1)
  )
)
;Kiem tra ton tai
(DEFUN IsNotExist (id / l in IsOK id_temp)
  (setq IsOK T)
  (setq l (length List_obj))
  (If (= l 0)
	(setq IsOK T)
	(progn
	  (setq in 0)
	  (while (< in l)
	(setq id_temp (nth in List_obj))
	(If (= id id_temp)
	  (setq IsOK Nil)
	)
	(setq in (1+ in))
	  )
	)
  )
  IsOK
)
;Ham thong tin
(DEFUN ABOUT(/ DCL_ID_ABOUT)
  (setq DCL_ID_ABOUT (load_dialog "CALLINE.DCL"))
  (if (not(new_dialog "ABOUT" DCL_ID_ABOUT))(exit))  
  (start_list "aboutme")
  (add_list " ")  
  (add_list "  VO KIEN CUONG - Bachelor of IT")
  (add_list "  =====================================================")
  (add_list "  Email : vkcuong_23@yahoo.com")
  (add_list "  Mobile: 0983616182 - 0977352125")
  (add_list "  CAD developer (LISP, DCL, VBA for AutoCad, ObjectARX...)")  
  (add_list "  ")
  (end_list)
  (start_dialog)
  (unload_dialog DCL_ID_ABOUT)
)
;Ham thuc thi chuong trinh
(DEFUN C:CL()
  (setvar "CMDECHO" 0)
  (CALINIT)  
  (CALLINE)
  (setvar "CMDECHO" 1)
)
;Ham lai chieu dai
(DEFUN CDAIOBJ(obj / cdai)
  (command "LENGTHEN" obj "")
  (setq cdai (getvar "PERIMETER"))
  cdai
)
;ham lay ten doi tuong
(DEFUN TENDOITUONG (obj / name)
  (setq name (CDR (ASSOC 0 (ENTGET obj))))  
  name  
)
;Ham tao danh sach layer
(DEFUN CREALILA (/ NL)
  (setq LiLa (List))
  (setq NL (tblnext "LAYER" T))  
  (while NL	
	(setq LiLa (append LiLa (list (cdr (assoc 2 NL)))))
	(setq NL (tblnext "LAYER"))
  )
  (setq LiLa (Acad_strlsort LiLa))
)
;Ham lay layer
(DEFUN LANAME(LiLa index / la)
  (setq la (nth index LiLa))
  la
)
Chuong trinh tinh tong chieu dai cac object - file DCL

//Form tinh chieu dai cua PolyLine
CALLINE:dialog	{
	label="Calculation Line - Free Ware";
	:edit_box{
		label="Chieu dai (m):";
		key="L_CL";
		}
	:toggle	{
		label="Khoa Layer";
		key="ChkLa_CL";		
	 	}
	:popup_list{
		label="Layer:";
		key="La_CL";
		is_enabled="0";
		}
	:row	{
		:button	{
			label="Chon doi tuong";
			key="Sele_CL";		
			}
		:button {
			label="Info..";
			key="Info";
			}
		}
	ok_only;
 	}
 ABOUT:dialog{
	label="About me...";
	spacer_1;
	:list_box{				
		key="aboutme";
		width=55;
		height=9;
		}
	ok_only;
	}

Dùng thế nào vậy. Mình đánh lệnh cl vào ko đc


<<

Filename: 322523_cl.lsp
Tác giả: ketxu
Bài viết gốc: 444404
Tên lệnh: abc
Nhờ vả - lisp Nối 02 đối tượng text lại với nhau.

As you wish ^^
 

(defun c:abc(/ f e1 e2)
(and
	(setq f (lambda(id e)(cdr (assoc id (entget e)))))
	(setq e1 (entsel "\nText A:"))
	(= (f 0 (setq e1 (car e1))) "TEXT")
	(setq e2 (entsel "\nText B:"))
	(= (f 0 (setq e2 (car e2))) "TEXT")	
	(entmod (append (entget e1) (list (cons 1 (strcat (f 1 e1) " " (f 1 e2)))))) 
	(entdel e2)
)
)

 


Filename: 444404_abc.lsp
Tác giả: ngokiet
Bài viết gốc: 436152
Tên lệnh: vbk
Lisp đo bán kính sau khi Fillet

Bác viết hàm giống lệnh fillet luôn rồi thì cần gì biến bkinh nữa. Nó có biến filletrad rồi mà

Nếu bác muốn đọc bkinh thì (getvar 'filletrad) là được.

Còn bác muốn điền bán kính bằng text hay dim thì bạn thêm lệnh command đó vào vì dù sao cũng cần có vị trí đặt text.

 

Ví dụ như chèn text. Mình tao text ở vị trí '(0 0 0) rồi move lên

>>

Bác viết hàm giống lệnh fillet luôn rồi thì cần gì biến bkinh nữa. Nó có biến filletrad rồi mà

Nếu bác muốn đọc bkinh thì (getvar 'filletrad) là được.

Còn bác muốn điền bán kính bằng text hay dim thì bạn thêm lệnh command đó vào vì dù sao cũng cần có vị trí đặt text.

 

Ví dụ như chèn text. Mình tao text ở vị trí '(0 0 0) rồi move lên

(defun c:vbk(/ ent)
  (command "fillet" "r" pause)
  (While (/= (getvar 'cmdactive) 0) (command pause))
  (command "fillet" pause pause)
  (command "text" '(0 0 0) "" "" (rtos (getvar 'filletrad) 2 2) "")
  (command "move" (entlast) "" '(0 0 0) pause))

 


<<

Filename: 436152_vbk.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 444496
Tên lệnh: cnn
(Yêu cầu): Lsp cộng vào dãy số ngẫu nhiên

Buồn ngủ rồi


;----- Ranom cong ngau nhien vao cac Text co san tren ban ve. By HA, 26/02/2020
(defun C:CNN(/ nho lon sle ss i txt rdm)
 (command "undo" "be")
 (setq nho (getreal "\nNhap so nho nhat: "))
 (setq lon (getreal "\nNhap so lon nhat: "))
 (setq sle (getint "\nSo luong so le can lay: "))
 (princ "\nChon tap hop Text can Random...")
 (setq ss (ssget '((0 . "Text"))))
 (repeat (setq i (sslength ss))
  (setq txt (cdr (assoc 1 (setq...
>>

Buồn ngủ rồi


;----- Ranom cong ngau nhien vao cac Text co san tren ban ve. By HA, 26/02/2020
(defun C:CNN(/ nho lon sle ss i txt rdm)
 (command "undo" "be")
 (setq nho (getreal "\nNhap so nho nhat: "))
 (setq lon (getreal "\nNhap so lon nhat: "))
 (setq sle (getint "\nSo luong so le can lay: "))
 (princ "\nChon tap hop Text can Random...")
 (setq ss (ssget '((0 . "Text"))))
 (repeat (setq i (sslength ss))
  (setq txt (cdr (assoc 1 (setq lst (entget (ssname ss (setq i (1- i))))))))
  (setq rdm (* (- lon nho) (LM:rand)))
  (entmod (subst (cons 1 (rtos (+ (atof txt) rdm) 2 sle)) (cons 1 txt) lst)))
 (command "undo" "e") 
 (princ))
(defun LM:rand ( / a c m )
 (setq m 4294967296.0 a 1664525.0 c 1013904223.0 $xn (rem (+ c (* a (cond ($xn) ((getvar 'date))))) m))
 (/ $xn m))


<<

Filename: 444496_cnn.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 444498
Tên lệnh: cnn
(Yêu cầu): Lsp cộng vào dãy số ngẫu nhiên

Âm dương


;----- Ranom cong them ngau nhien vao cac Text co san tren ban ve. By HA, 26/02/2020
(defun C:CNN(/ nho lon sle ss i txt rdm)
 (command "undo" "be")
 (setq nho (getreal "\nNhap so nho nhat: "))
 (setq lon (getreal "\nNhap so lon nhat: "))
 (setq sle (getint "\nSo luong so le can lay: "))
 (princ "\nChon tap hop Text can Random...")
 (setq ss (ssget '((0 . "Text"))))
 (repeat (setq i (sslength ss))
  (setq txt (cdr (assoc 1 (setq...
>>

Âm dương


;----- Ranom cong them ngau nhien vao cac Text co san tren ban ve. By HA, 26/02/2020
(defun C:CNN(/ nho lon sle ss i txt rdm)
 (command "undo" "be")
 (setq nho (getreal "\nNhap so nho nhat: "))
 (setq lon (getreal "\nNhap so lon nhat: "))
 (setq sle (getint "\nSo luong so le can lay: "))
 (princ "\nChon tap hop Text can Random...")
 (setq ss (ssget '((0 . "Text"))))
 (repeat (setq i (sslength ss))
  (setq txt (cdr (assoc 1 (setq lst (entget (ssname ss (setq i (1- i))))))))
  (setq rdm (LM:HA:randrange lon nho))
  (entmod (subst (cons 1 (rtos (+ (atof txt) rdm) 2 sle)) (cons 1 txt) lst)))
 (command "undo" "e") 
 (princ))
(defun LM:HA:randrange ( a b )
  (+ (min a b) (* (LM:rand) (abs (- a b)))))
(defun LM:rand ( / a c m )
 (setq m 4294967296.0 a 1664525.0 c 1013904223.0 $xn (rem (+ c (* a (cond ($xn) ((getvar 'date))))) m))
 (/ $xn m))


<<

Filename: 444498_cnn.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 89698
Tên lệnh: vd1 vd2 vd3 vd4 vd5
AutoCAD với Excel
Góp ý: với các code khá dài, bạn nên cho nó vào hộp codebox để bài viết gọn gàng (mình đã làm giúp bạn như trên)

 

Chương trình này rất hay, tập hợp một loạt...

>>
Góp ý: với các code khá dài, bạn nên cho nó vào hộp codebox để bài viết gọn gàng (mình đã làm giúp bạn như trên)

 

Chương trình này rất hay, tập hợp một loạt functions để làm việc với excel bằng lisp.

Công dụng các functions:

- getexcel: 3 đối số là file_name, sheet_name và max_range. Return: list dữ liệu từ cell A1 đến cell ứng với max_range

- getcell: lấy dữ liệu tại 1 cell, được chỉ định bằng địa chỉ cell

- openexcel: mở file *.xls có trên đĩa

- putcell: gán giá trị cho cell

- closeexcel: đóng file *xls đã open ở trên

Để hiểu rõ hơn, bạn ghép thêm vào code có sẵn của bạn đoạn sau:

;;;Vi du ap dung cac function tren
;;;---------------------------------------------------------------------
(defun C:VD1()
(vl-load-com)
(setq fn (getfiled "Select Excel File" "" "xls" 0))
(getexcel fn "sheet1" "D5")
)
;;;---------------------------------------------------------------------
(defun C:VD2() (alert (strcat "B3 = " (getcell "B3"))))
;;;---------------------------------------------------------------------
(defun C:VD3() (openexcel fn "sheet4" T))
;;;---------------------------------------------------------------------
(defun C:VD4() (putcell "B10" (list "How"  "are you?")))
;;;---------------------------------------------------------------------
(defun C:VD5() (closeExcel fn))

 

Tạo 1 file *.xls, ghi ở sheet1 các số liệu tuỳ ý, khoảng chừng 4 cột, 6 hàng. Save và thoát hẳn excel

lần lượt các lệnh từ VD1 đến VD5:

- VD1: lấy dữ liệu trong sheet1, từ cell A1 đến cell D5 của file mà bạn chỉ định và chuyển thành list. Bạn bấm F2 sau khi chạy xong sẽ thấy

- VD2: lấy dữ liệu ở cell B3

- VD3: mở file, tạo sheet mới có tên sheet4

- Vẫn để Excel hiện hành, quay lại Acad gõ VD4 -> Cell B10 sẽ được gán nội dung "How" và cell C10 là "are you?"

- VD5: save và thoát Excel

 

Thông suốt được những cái trên đây thì những functions còn lại không thành vấn đề. Chúng chỉ là những tiện ích hỗ trợ thêm (bạn đọc comments và examples của họ sẽ hiểu)

Khi đã nắm được toàn bộ, bạn sẽ giải quyết được vấn đề đã nêu ở topic "Ghi dữ liệu từ Cad sang file Excel đã có".

Chào bác SSG,

Lâu lắm rồi, bây giờ mình mới dám sờ mó một chút tới cái thằng Excel to Cad này. Sau khi đọc cái lisp của bác mình thấy có một vấn đề là trong lệnh VD1, khi mình thay (getexcel fn "sheet1" "D5") bằng (getexcel fn "sheet2" "D5") thì kết quả nó vẫn y chang nhau, nghĩa là lisp chỉ lấy dữ liệu trên file được mở ở đúng cái sheet đang hiện hành, bất chấp việc thay tham số "sheet1" bằng "sheet2" bác ạ.

Điều này theo mình đoán là nó do cái hàm (getexcel ....) mà ra. Thế nhưng do cái lisp này hơi rậm rì rắc rối mà mình thì chưa thạo về mấy cái hàm (vlax- .....) nên chưa dám mò mẫm vào.

Về các hàm (vlax- .....) này bác có thể chỉ giùm cách để mình tham khảo được không chứ mình mò hoài trong Help cũng như help Developer mà chưa vỡ ra được bác ạ.

Chúc bác khỏe và luôn thành công.


<<

Filename: 89698_vd1_vd2_vd3_vd4_vd5.lsp
Tác giả: hungvq
Bài viết gốc: 128000
Tên lệnh: tdt
Viết lisp theo yêu cầu [phần 2]

Mình vẫn dùng có thấy sao đâu nhỉ ^^ Đoạn lisp này của bác nào vào confirm lại giúp e với.Ngày xưa cứ cặm cụi down,giờ hok nhớ của ai để hỏi nữa :) E Dùng Cad08 thì...
>>
Mình vẫn dùng có thấy sao đâu nhỉ ^^ Đoạn lisp này của bác nào vào confirm lại giúp e với.Ngày xưa cứ cặm cụi down,giờ hok nhớ của ai để hỏi nữa :) E Dùng Cad08 thì không còn phần định chiều cao text trong lệnh text nữa, mà nó đi kèm theo Style, nên phải sửa lại trong các hàm tạo text bằng command ^^ Có lẽ nên chuyển sang entmake thì hay hơn :) Nhưng tạm thời cứ chữa cháy để bạn ấy dùng đã


;; free lisp from cadviet.com
(defun c:tdt()
 (setvar "cmdecho" 0)
 (setq lacol (getvar "CEColor"))
 (setq ladin (getvar "dimzin"))
 (setq laos (getvar "osmode"))  
 (if (not tl) (setq tl 1))
 (setq tl1 (getreal (strcat "\nty le ban ve < 1/" (rtos tl 2 0) " >: 1/")))
 (if tl1 (setq tl tl1))

 (setq     k 0 
   tdt 0)
 (setq ss (ssadd))

(setvar "dimzin" 0)
(setvar "OSMODE" 0)
(setq PT (getpoint "\nChon diem xuat bang thong ke dien tich (mep trai):"))
(setq     P1 (list (+ (car PT)(* 6 h)) (cadr PT))
   P2 (list (+ (car PT)(* 22 h)) (cadr PT))
   P3 (list (car PT) (- (cadr PT)(* 3 h)))
   P4 (list (car P1) (cadr P3))
   P5 (list (car P2) (cadr P3))
   P6 (list (+ (car PT)(* 11 h)) (+ (cadr PT)(* 2 h)))
   P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
   P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
);setq
(command     "pline" PT P2 P5 P3 "C"
       "pline" P1 P4 ""
       "text" "m" P6  0 "Bang thong ke dien tich"
       "text" "m" P7  0 "STT"
       "text" "m" P8  0 "Dien tich (m2)"
);command

(setq pt1 (getpoint "\n Chon mien tinh dien tich : "))
 (while (/= pt1 nil)
   (setq k (+ 1 k))
   (command "TEXT" "m" pt1  0 (rtos k 2 0))
   (setq     PT (list (car P3) (cadr P3))
   P1 (list (+ (car PT)(* 6 h)) (cadr PT))
   P2 (list (+ (car PT)(* 22 h)) (cadr PT))
   P3 (list (car PT) (- (cadr PT)(* 3 h)))
   P4 (list (car P1) (cadr P3))
   P5 (list (car P2) (cadr P3))
   P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
   P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
   P9 (list (car PT) (- (cadr P3)(* 3 h)))
   P10 (list (car P1) (cadr P9))
   P11 (list (car P2) (cadr P9))
   P12 (list (car P7) (- (cadr P3)(* 1.5 h)))
   P13 (list (car P8) (cadr P12))
   );setq
   (command "CECOLOR" 4 "-boundary" pt1 "" )
   ;(setvar "CECOLOR" lacol)
   (setq et (entlast))
   (ssadd et ss)
   (command "area" "o" "last")                
   (setq et (entlast))
   (ssadd et ss)
   (setq dtcon (/ (* (getvar "AREA") tl tl) 1000000))
   (setq tdt (+ dtcon tdt))

(command "erase" ss "")

   (command "pline" PT P2 P5 P3 "C"
       "pline" P1 P4 ""
       "text" "m" P7  0 (rtos k 2 0)
       "text" "m" P8  0 (rtos dtcon 2 2))

   (setq pt1 (getpoint "\n Chon mien tinh dien tich tiep theo hoac enter de ket thuc lenh..."))
);while
(setq ss nil)
(setvar "DIMZIN" ladin)
(command     "pline" P3 P9 P11 P5 "C"
       "pline" P10 P4 ""
       "text" "m" P12  0 "Tong"
       "text" "m" P13  0 (rtos tdt 2 2)
);command
(setvar "OSMODE" laos)
(setvar "cmdecho" 1)
) 

Chào bạn Ketxu! Rất cám ơn bạn đã post cho mình cái lip này. Nhưng mình vẫn chưa sử dụng được.

Mình bị vấp ngay ở đầu, có lẽ mình chưa hiểu việc chọn tỷ lệ bản vẽ. Mình đã chọn tỷ lệ 1/1; 1/200; 1/500; 1/1000; 1/2000... nhưng không thể tiếp tục được. Máy báo lỗi:

ty le ban ve < 1/1 >: 1/1

Chon diem xuat bang thong ke dien tich (mep trai):; error: bad argument type:

numberp: nil

Có phải tỷ lệ này chính là tỷ lệ bản vẽ cần tính diện tích không nhỉ? Mong bạn chỉ giáo tiếp nhé!


<<

Filename: 128000_tdt.lsp
Tác giả: ledanh20275
Bài viết gốc: 194681
Tên lệnh: 2csv
nhờ giúp list tính diện tích trong cad và tự động nhập trong excel

Bạn chạy thử Lisp xuất ra file CSV

sau đó dùng Excel mở file này, save as qua file *.xls

 

Cách sử dụng : tên lệnh...

>>

Bạn chạy thử Lisp xuất ra file CSV

sau đó dùng Excel mở file này, save as qua file *.xls

 

Cách sử dụng : tên lệnh 2CSV

lần luơt chọn :

- Text để lấy số lô

- đối tuơng để lấy Diện tích

- đối tuơng để lấy Khoảng lùi

 

lặp lại các buớc trên, nhấn Enter để kết thúc quá trình chọn.

- Chỉ ra ten file -> kết thúc.

 

(defun c:2Csv (/ chdai dtich ent1 ent2 ent3 lst solo tmp)  (vl-load-com)    (while (and       (setq ent1 (car (entsel "\nchon Text de lay So lo :")))       (= (cdr (assoc 0 (entget ent1))) "TEXT")       (setq solo (vlax-get(vlax-Ename->Vla-Object ent1)'TextString))              (setq ent2 (car (entsel "\nchon doi tuong de lay Dien tich :"))	     ent2 (vlax-Ename->Vla-Object ent2))       (and (vlax-property-available-p ent2 'area)         (setq dtich (vlax-get ent2 'Area) )  )              (setq ent3 (car (entsel "\nchon doi tuong de lay Khoang lui :"))	     ent3 (vlax-Ename->Vla-Object ent3))       (and (vlax-property-available-p ent3 'Length)         (setq chdai (vlax-get ent3 'Length) )  )  )    (princ "\n")   	(princ (setq tmp (strcat solo "," (rtos dtich) "," (rtos chdai))))    (setq lst (append lst (list tmp)))  )    (if (setq tmp (getfiled "Ten file " (getvar "dwgprefix") "csv" 1))    (progn      (setq tmp (open tmp "a"))      (write-line "So lo,Dien tich,Khoang lui" tmp)            (foreach txt lst	(write-line txt tmp)   )      (close tmp)))  (princ))

bác gia_bach cho em hỏi với.tại sao em dùng ap -> load 2csv.lish-> gõ lệch 2csv / enter:chọn text để lấy số lô :kích chuột trái vào dt text->chọn đt để lấy diện tích: kích chuột trái vào vùng cần tính diện tích thì trên thanh comand trở về trạng thái bình thường.help me!


<<

Filename: 194681_2csv.lsp
Tác giả: truongbv
Bài viết gốc: 54099
Tên lệnh: xdt2
Nhờ các bác Viết Lisp kiểm tra Overlay của Polyline
Chào bạn Truongbv,

Đây là cái lisp xác định text trùng nhau hoàn toàn.

(defun c:xdt2 ()
(setq ss (ssget '((0 . "TEXT")))
  n (sslength ss)
  i 0
  lst...
>>
Chào bạn Truongbv,

Đây là cái lisp xác định text trùng nhau hoàn toàn.

(defun c:xdt2 ()
(setq ss (ssget '((0 . "TEXT")))
  n (sslength ss)
  i 0
  lst (list)
)
(While (< i n)
  (setq en (ssname ss i)
		elst (entget en)
		lst (append lst (list elst))
		i (1+ i)
  )
)
(setq j 0)
(while (/= nil (cdr lst))
   (setq a (cddddr (car lst))
		 lstp (cdr lst)
		 p (cdr (assoc 10 a))
   )
   (foreach b lstp
			(setq c (cddddr b))
			(if (equal a c)
				(progn
					  (setq j (1+ j))
					  (command "layer" "m" "Loi overlay text" "c" 6 "" "")
					  (command "circle" p 5)
					  (command "text" (list (car p) (- (cadr p) 2)) 1 0 "O day co text trung nhau hoan toan")
				)
			)
   )
   (setq lst lstp)
)
(alert (strcat "Co " (itoa j) " cap text trung nhau hoan toan"))
(princ)
)

 

Cũng như lisp trườc lệnh là xdt2, bạn có thể thay đổi bán kính vòng tròn, vị trí đặt text, chiếu cao text theo ý bạn nhé. Mình cũng tạo một lớp mới là Loi overlay text để lưu các thông báo phát hiện lỗi.

Bạn chú ý rằng tâm vòng tròn chính là điểm đặt của text bị trùng.

Chúc bạn vui.

Thanks bác rất nhiều.

ct đã chạy ổn rồi


<<

Filename: 54099_xdt2.lsp
Tác giả: hhhhgggg
Bài viết gốc: 43415
Tên lệnh: ttt
Lisp biến Text thành 1 text hay một giá trị mình nhập vào ??????????
Bạn dùng thử cái này, lệnh TTT:

 

(defun C:TTT( / ss txt e d)
(setq
   ss (ssget '((0 . "TEXT,MTEXT")))
   txt (getstring "\nGia tri text thay the:" T)
)
(while (setq e...
>>
Bạn dùng thử cái này, lệnh TTT:

 

(defun C:TTT( / ss txt e d)
(setq
   ss (ssget '((0 . "TEXT,MTEXT")))
   txt (getstring "\nGia tri text thay the:" T)
)
(while (setq e (ssname ss 0))
   (setq
       d (entget e)
       d (subst (cons 1 txt) (assoc 1 d) d)
   )
   (entmod d)
   (ssdel e ss)
)
(princ)
)

ok ! Lisp của bác SSG chính là lời giải của bài toán. Em đã Test và chạy ok ! Em tặng bác 1 con gà quay ( Hình vẽ) để hậu tạ ! kekeke


<<

Filename: 43415_ttt.lsp
Tác giả: Tue_NV
Bài viết gốc: 367206
Tên lệnh: test
Hỏi về Lisp (thuật toán, ý tưởng, coding,...)

Cảm ơn bạn đã góp ý !!

Mình toàn học mót Lisp trên cadviet nên trình độ còn kém,những cái tự viết được thì mình đã...

>>

Cảm ơn bạn đã góp ý !!

Mình toàn học mót Lisp trên cadviet nên trình độ còn kém,những cái tự viết được thì mình đã làm,nhưng những cái khó quá mình mới nhờ anh em code giúp thôi

Thật ra ,2 lisp trên cũng gần đúng ý mình,nên mình mót và chế lại theo đúng ý mình rồi

Do đang thử code a Hạ thì mình bị như vậy mà mình xử lý không được nên mới đành post bài nhờ anh em chỉ bảo  thêm

Đoạn xanh mong bạn giải thích rõ thêm tí được ko,do hàm grread mình chưa rõ lắm nên sửa mãi mà chưa được (mục đích của mình thì chỉ khi mình pick chon điểm để quét vùng nó mới nhảy dòng Princ ,chứ ko muốn nhảy liên tục như code của a snowman.hms )

Hơi tham lam tí nên anh chị thông cảm.Hi

 

Chỉ cần hoán đổi vị trí code trong li sp của bạn snowman là được

Và mình có chỉnh 1 tí để có thể sử dụng lệnh như 1 transparent command

 

(defun c:test ( / gr_rec gr gr1 gr2 p1 p2 tm lst s)
  (defun gr_rec (p1 p2 / l)
    (mapcar '(lambda (a b) (grdraw a b 6 1))
   (setq l (list p1 (list (car p1) (cadr p2))
 p2 (list (car p2) (cadr p1))))
   (cons (last l) l)))
  (princ (strcat "\nSpecify the First point ..."
    "\nPress  to EXIT"
    )
      )
  (while
    (progn
      (setq gr1 (grread t 15 0)
   gr2 (cadr gr1)
   gr1 (car gr1)
      )
      
      (cond
((= 5 gr1)
(redraw)
(if lst (mapcar '(lambda (x) (gr_rec (car x) (cadr x))) lst) t)
)
((= 3 gr1)
(princ "\nSpecify the Second point ...")
(setq p1 gr2)
(while
  (progn
    (setq gr1 (grread t 15 0)
  gr2 (cadr gr1)
  gr1 (car gr1)
    )
    
    (cond
      ((= 5 gr1)
(redraw)
(if lst (mapcar '(lambda (x) (gr_rec (car x) (cadr x))) lst) t)
(setq tm gr2)
(gr_rec p1 tm)
      )
      ((= 3 gr1)
 (princ (strcat "\nSpecify the First point ..."
    "\nPress  to EXIT"
    )
      )
(setq p2 gr2)
(setq lst (cons (list p1 p2) lst))
nil
      )
    )
  )
)
t
)
((and (= 2 gr1) (member gr2 '(13 32))) nil)
(t)
      )
    )
  )
  (if lst
    (progn
      (setq s (ss_union (mapcar '(lambda (x) (ssget "_C" (car x) (cadr x))) lst)))
      (redraw)
      (sssetfirst nil s)
    )
  )
s
)
(defun ss_union (lst / i s)
  (setq lst (vl-sort lst '(lambda (a b) (> (sslength a) (sslength b))))
s   (car lst)
  )
  (foreach x (cdr lst)
    (repeat (setq i (sslength x))
      (ssadd (ssname x (setq i (1- i))) s)
    )
  )
  s
) 

<<

Filename: 367206_test.lsp
Tác giả: Doan Nguyen Van
Bài viết gốc: 444956
Tên lệnh: te
Xin được trợ giúp về lọc layer
(vl-load-com)
(defun c:te ()
  (setq ss...
>>
(vl-load-com)
(defun c:te ()
  (setq ss (acet-ss-to-list (ssget (list (Cons 0 "LINE") (Cons 8 "13")))))
  (foreach ent ss
    (setq p1 (dxf 10 ent)
	  p2 (dxf 11 ent))
    (if (< (car p1)(car p2)) (setq pt1 p1 pt2 p2) (setq pt1 p2 pt2 p1))
    (setq pt0 (polar pt1 (angle pt2 pt1) 10))
    (setq pm (acet-geom-midpoint p1 p2))
    (setq pt3 (polar pm (+ (* pi 0.5) (angle p1 p2)) (/ (distance p1 p2) 4))
	  pt4 (polar pm (+ (* pi 1.5) (angle p1 p2)) (/ (distance p1 p2) 4)))
    (setq l1 (vl-sort (list pt0 pt2 pt3 pt4) '(lambda (x y) (< (car x) (car y)))))
    
    (setq x1 (car (car l1))
	  x2 (car (last l1)))
    (setq l2 (vl-sort (list pt0 pt2 pt3 pt4) '(lambda (x y) (< (cadr x) (cadr y)))))
    (setq y1 (cadr (car l2))
	  y2 (cadr (last l2)))
    (setq p1 (list x1 y1 0.0) p2 (list x2 y2 0.0))
    (vlax-invoke (vlax-get-acad-object) 'zoomwindow  p1 p2)
    (setq sst (acet-ss-to-list (ssget "_C" (trans p1 0 1) (trans p2 0 1)
				      (list (Cons 0 "TEXT") (Cons 8 "13")))))
    (if (= (length sst) 3) (progn
	(foreach e sst
	  (if (not (distof (dxf 1 e)))(progn
	    (setq et e)
	    (setq sst (vl-remove e sst))))
	  )
	(changelayer et "T1")
	(setq e1 (car sst) e2 (cadr sst))
	(if (> (cadr (dxf 10 e1)) (cadr (dxf 10 e2)))
	  (progn
	    (changelayer e1 "T2")
	    (changelayer e2 "T3") )
	  (progn
	    (changelayer e1 "T3")
	    (changelayer e2 "T2") ) )
	))
   (vla-zoomprevious (vlax-get-acad-object))
    )
  )
(defun changelayer (ent_ la_)
  (if (not (tblsearch "layer" "T1")) (COMMAND "-LAYER" "M" "T1" "C" "1" "" "" ""))
  (if (not (tblsearch "layer" "T2")) (COMMAND "-LAYER" "M" "T2" "C" "2" "" "" ""))
  (if (not (tblsearch "layer" "T3")) (COMMAND "-LAYER" "M" "T3" "C" "3" "" "" ""))
(vla-put-layer (vd_vl ent_) la_)
  (vla-put-color (vd_vl ent_) 256)
  )
(defun Dxf (Id Obj)
    (cdr (assoc Id (entget Obj)))
  )
  
  

Mấy bữa để lisp ở cty giờ mới gửi lên được

 


<<

Filename: 444956_te.lsp
Tác giả: thiep
Bài viết gốc: 444964
Tên lệnh: llo
Xin được trợ giúp về lọc layer
2 giờ trước, quocmanh04tt đã nói:

Mình tham gia 1 cái, phân...

>>
2 giờ trước, quocmanh04tt đã nói:

Mình tham gia 1 cái, phân biệt bằng Alignment: 

(defun c:tt  (/ a e s lays _ent _lay)
    (setq lays (vla-get-layers (vla-get-ActiveDocument (vlax-get-acad-object)))
          _ent '((n) (entmod (list (cons -1 e) (cons 8 n) '(62 . 256))))
          _lay '((n c) (or (tblsearch "LAYER" n) (vla-put-color (vla-add lays n) c)) n))
    (if (setq s (ssget '((0 . "TEXT"))))
        (while (and (setq e (ssname s 0)) (ssdel e s))
            (setq a (vlax-get (vlax-ename->vla-object e) 'Alignment))
            (cond ((eq a 11) (_ent (_lay "thua" 1)))
                  ((eq a 1) (_ent (_lay "sohieu_thua" 2)))
                  ((eq a 7) (_ent (_lay "dien_tich" 3))))))
    (princ))

Công nhận quocmanh04tt viết nhiều hàm rất phức tạp, siêu tưởng. Nhưng có điều thời gian chạy nó cũng lâu hơn lisp tôi viết kiếu tách text - lớp bằng Alignment, viết thông thường dễ nhìn: chênh nhau 3/triệu giây:

(Defun c:llo (/ *lay* ss ent_lst obj_lst d1 d2)
    (setq d1 (getvar "date"))
    (setq
        *lay* (vla-get-layers (vla-get-ActiveDocument (vlax-get-acad-object)))
    )
    (mapcar '(lambda (lay col)
                 (or (tblobjname "LAYER" lay)
                     (vla-put-color (vla-add *lay* lay) col)
                 )
             )
            '("thua" "sohieu_thua" "dien_tich")
            '(1 2 3)
    )
    (if (setq ss (ssget "X" '((0 . "TEXT") )));(8 . "13")
        (progn 
               (setq ent_lst (acet-ss-to-list ss))
               (setq obj_lst (mapcar 'vlax-ename->vla-object ent_lst))
               (mapcar '(lambda (x y)
                            (setq j (acet-tjust-keyword (entget x)))
                            (cond ((eq J "MR")
                                   (vla-put-layer y "thua")
                                   (vla-put-color y acByLayer)
                                  )
                                  ((eq J "Center")
                                   (vla-put-layer y "sohieu_thua")
                                   (vla-put-color y acByLayer)
                                  )
                                  ((eq J "TC")
                                   (vla-put-layer y "dien_tich")
                                   (vla-put-color y acByLayer)
                                  )
                            )
                        )
                       ent_lst
                       obj_lst
               )
        )
    )
    (setq d2 (getvar "date"))
    (setq tex (acet-str-format "th\U+1EDDi gian ch\U+1EA1y lisp là: %1 giây" (rtos (- d2 d1) 2 9)))
    (princ tex)
)

 


<<

Filename: 444964_llo.lsp

Trang 308/330

308