Jump to content
InfoFile
Tác giả: thanhduan2407
Bài viết gốc: 332606
Tên lệnh: 00
xuất cao độ các đỉnh 3D Polyline ra text
(defun C:00 (/
	     FZ
	     SSPLINE
	    )
  (setvar "CMDECHO" 0)
  (or *Caochu* (setq *Caochu* 1.0))
  (setq	Caochu (getreal	(strcat	"Nhap cao chu:  <"
				(rtos *Caochu* 2 2)
				">: "
			)
	       )
  )
  (if (not Caochu)
    (setq Caochu *Caochu*)
    (setq *Caochu* Caochu)
  )
  (setq	ssPline	(acet-ss-to-list
		  (ssget (list (cons 0 "*LWPOLYLINE,POLYLINE")))
		)
  )
  (mapcar '(lambda (x) (GCD1PL x 0.000001 Caochu)) ssPline)
  (princ)
)

(defun...
>>
(defun C:00 (/
	     FZ
	     SSPLINE
	    )
  (setvar "CMDECHO" 0)
  (or *Caochu* (setq *Caochu* 1.0))
  (setq	Caochu (getreal	(strcat	"Nhap cao chu:  <"
				(rtos *Caochu* 2 2)
				">: "
			)
	       )
  )
  (if (not Caochu)
    (setq Caochu *Caochu*)
    (setq *Caochu* Caochu)
  )
  (setq	ssPline	(acet-ss-to-list
		  (ssget (list (cons 0 "*LWPOLYLINE,POLYLINE")))
		)
  )
  (mapcar '(lambda (x) (GCD1PL x 0.000001 Caochu)) ssPline)
  (princ)
)

(defun GCD1PL (ObjPline fz Caochu / L0 DsDinh)
  (setq L0 (acet-geom-vertex-list ObjPline))
  (setq DsDinh (TD:Filter1 L0 fz))
  (mapcar '(lambda (x)
	     (entmake (list (cons 0 "TEXT")
			    (cons 1 (rtos (nth 2 x) 2 3))
			    (cons 40 Caochu)
			    (cons 10 x)
		      )
	     )
	   )
	  DsDinh
  )
)


(defun TD:Filter1 (l fz)
  (if l
    (cons (car l)
	  (TD:Filter1
	    (vl-remove-if
	      '(lambda (x)
		 (equal	(list (car x) (cadr x))
			(list (car (car l)) (cadr (car l)))
			fz
		 )
	       )
	      (cdr l)
	    )
	    fz
	  )
    )
  )
)

<<

Filename: 332606_00.lsp
Tác giả: trinhhoanghieu090
Bài viết gốc: 332618
Tên lệnh: tdd
xuất cao độ các đỉnh 3D Polyline ra text

hì hì hì, bác Duan nhanh thật, thôi thì đã làm rồi đành post lên đây cho chủ thớt vậy, ngó qua cái của bác Duan hình như phải cài expresstool, còn của mình thì không cần phải cài cũng được.

P/S: Trong lisp em có dùng đoạn code mót của bác Duan hồi trước :D, rõ ngại.\

(defun c:tdd( / TD:Filter ktext cao_chu tapchon dt n pt text...
>>

hì hì hì, bác Duan nhanh thật, thôi thì đã làm rồi đành post lên đây cho chủ thớt vậy, ngó qua cái của bác Duan hình như phải cài expresstool, còn của mình thì không cần phải cài cũng được.

P/S: Trong lisp em có dùng đoạn code mót của bác Duan hồi trước :D, rõ ngại.\

(defun c:tdd( / TD:Filter ktext cao_chu tapchon dt n pt text list_point)
(vl-load-com)
;==============================================================
(defun TD:Filter (l fz)
  (if l
    (cons (car l)
      (TD:Filter
        (vl-remove-if
          '(lambda (x)
         (equal    (list (car x) (cadr x))
            (list (car (car l)) (cadr (car l)))
            fz
         )
           )
          (cdr l)
        )
        fz
      )
    )
  )
)
;===============================================================================================
    (defun Ktext(pt height string justify layer textstyle mau ang / lst)
    (setq lst (list '(0 . "TEXT")
                              (cons 10 pt)
                              (cons 40 (if height height (getvar 'textsize)))
                              (cons 1 string)
                              (cons 50 (if ang ang 0))
                              (cons 8 (if layer layer (getvar 'clayer)))
                              (cons 7 (if textstyle textstyle (getvar 'textstyle)))
                              (cons 62 (if mau mau 7))
                              
            )
            justify (strcase justify))
        (cond   ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 11 pt)))))
                ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 pt)))))
                ((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 pt)))))
                ((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 pt)))))
                )
    (entmakex Lst)
    )    ;end Ktext
;============================================================================================    
    (or *cao_chu* (setq *cao_chu* 0.2))
    (initget (+ 2 4))
    (setq cao_chu (getreal
                        (strcat "\nNhap Cao Chu <" (rtos *cao_chu* 2 2) ">:")
                    )
    )
    (if    cao_chu
        (setq *cao_chu* cao_chu)
        (setq cao_chu *cao_chu*)
    )
    
    (setq tapchon (ssget '((0 . "LWPOLYLINE,POLYLINE")) ))
    (repeat (sslength tapchon)
            (setq    dt    (ssname tapchon 0)
                    tapchon    (ssdel    dt tapchon)
                    n -1
            )
            (while    (setq pt
                            (vlax-curve-getPointAtParam dt
                                                            (setq n (1+ n))
                            )
                    )
                    (setq list_point
                                    (append (list pt) list_point)
                    )
            )

            (setq list_point (TD:Filter list_point  0.00011))
            (foreach x list_point
                                (progn
                                (setq text (rtos (last x) 2 4) )
                                (Ktext x cao_chu text "L" nil nil nil nil)
                                )
            )
    )
)

<<

Filename: 332618_tdd.lsp
Tác giả: thanhduan2407
Bài viết gốc: 332609
Tên lệnh: clt
Nội suy cao độ thiết kế tim đường

Bạn thử dùng xem

(defun c:CLT (/	     CAODO1 CAODO2 CAODO3 CHIEUCAO	D      D1
	      D2     DH	    DHZ	   ITEM1  ITEM2	 PT1	PT2    PT3
	      STT    TDO1   TDO2   TEMP1  TEMP2	 X1	X2     X3
	      Y1     Y2	    Y3	   Z1	  Z2	 Z3	loop
	     )
  (defun *error* (msg)
    (if	Olmode
      (setvar 'osmode Olmode)
    )
    (if	(not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )
  (prompt "Made by...
>>

Bạn thử dùng xem

(defun c:CLT (/	     CAODO1 CAODO2 CAODO3 CHIEUCAO	D      D1
	      D2     DH	    DHZ	   ITEM1  ITEM2	 PT1	PT2    PT3
	      STT    TDO1   TDO2   TEMP1  TEMP2	 X1	X2     X3
	      Y1     Y2	    Y3	   Z1	  Z2	 Z3	loop
	     )
  (defun *error* (msg)
    (if	Olmode
      (setvar 'osmode Olmode)
    )
    (if	(not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )
  (prompt "Made by thanhduan2407")

  (or *chieucao* (setq *chieucao* 1))
  (setq
    chieucao (getreal (strcat "\nNh\U+1EADp chi\U+1EC1u cao Text <"
			      (rtos *chieucao* 2 2)
			      "> :"
		      )
	     )
  )
  (if (not chieucao)
    (setq chieucao *chieucao*)
    (setq *chieucao* chieucao)
  )
  (setq Olmode (getvar "OSMODE"))
  (if (not sle)
    (setq sle 2)
  )
  (setq	sle0
	 (getint
	   (strcat
	     "\nS\U+1ED1 l\U+1EBB sau ph\U+1EA7n th\U+1EADp ph\U+00E2n (T\U+1ED1i \U+0111a = 10, t\U+1ED1i thi\U+1EC3u = 0) <"
	     (itoa sle)
	     ">: "
	   )
	 )
  )
  (if sle0
    (progn
      (if (< sle0 0)
	(setq sle0 0)
      )
      (if (> sle0 10)
	(setq sle0 10)
      )
      (setq sle sle0)
    )
  )
  (if (and (setq item1 (entsel "\nCh\U+1ECDn Text th\U+1EE9 nh\U+1EA5t:  "))
	   (setq item2 (entsel "\nCh\U+1ECDn Text th\U+1EE9 hai:  "))
      )
    (progn
      (progn

	(setq temp1 (entget (car item1)))
	(setq Tdo1 (TD:Text-Base (car item1)))
	(setq Caodo1 (cdr (assoc 1 temp1))
	      x1     (car Tdo1)
	      y1     (cadr Tdo1)
	)
	(setq pt1 (list x1 y1))
	(setq z1 (atof Caodo1))

	(setq temp2 (entget (car item2)))
	(setq Tdo2 (TD:Text-Base (car item2)))
	(setq Caodo2 (cdr (assoc 1 temp2))
	      x2     (car Tdo2)
	      y2     (cadr Tdo2)
	)
	(setq pt2 (list x2 y2))
	(setq z2 (atof Caodo2))
      )
      (setq loop T)
      (while loop
	(setq
	  pt3 (getpoint
		"\nV\U+1ECB tr\U+00ED ch\U+00E8n \U+0111i\U+1EC3m : "
	      )
	)
	(cond
	  (T
	   (if pt3
	     (progn
	       (setvar "OSMODE" 512)
	       (setq x3 (car pt3))
	       (setq y3 (cadr pt3))
	       (setq d1 (distance pt1 pt3))
	       (setq d2 (distance pt2 pt3))
	       (setq d (+ d1 d2))
	       (setq dh (- z2 z1))
	       (setq dhz (* dh (/ d1 d)))
	       (setq z3 (+ z1 dhz))
	       (setq Caodo3 (rtos z3 2 sle))
	       (setq pt3 (list x3 y3 z3))
	       (entmake	(list (cons 0 "TEXT")
			      (cons 10 pt3)
			      (cons 1 Caodo3)
			      (cons 40 chieucao)
			)
	       )
	     )
	     (setq loop nil)
	   )
	  )
	)

      )

    )
  )
  (setvar "OSMODE" Olmode)
  (princ)
)

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

<<

Filename: 332609_clt.lsp
Tác giả: pphung183
Bài viết gốc: 332596
Tên lệnh: td
Xin Lisp xuat toa độ

- hihi nhoc nhiều chiện xíu, anh Phung chơi theo kiểu kéo tới đâu dài tới đó, kéo hướng nào đặt hướng đó, tuy hơi lâu xíu ^^

Thế thì phải thêm 1 điểm pick Nhoc ah :) , test nhé :

;GHI TOA DO CAC DIEM VA THONG KE THANH BANG
----------------------------------------------
(defun textM...
>>

- hihi nhoc nhiều chiện xíu, anh Phung chơi theo kiểu kéo tới đâu dài tới đó, kéo hướng nào đặt hướng đó, tuy hơi lâu xíu ^^

Thế thì phải thêm 1 điểm pick Nhoc ah :) , test nhé :

;GHI TOA DO CAC DIEM VA THONG KE THANH BANG
----------------------------------------------
(defun textM (pt height string / lst) 
(setq lst (list '(0 . "TEXT") (cons 10 pt) (cons 40 height) (cons 1 string) (cons 50 0) (cons 72 4) (cons 11 pt) (cons 7 (getvar "Textstyle"))))
(entmakeX Lst)  )
(defun C:td (/ diem PT1 PT2 tapx tapy obj ss
		   x y xx yy h n di kc ten
		   C PT PTX PTY PTD PTC N
		   p1 p2 p3 p4 p11 p22 p33 L1 L2 L11 L22)
(setvar "cmdecho" 0 )
(command "Undo" "Begin")  
  (setq om (getvar "osmode"))
  (setq tapx '()
	tapy '()
	stt '()
	k 0
	h (getreal "\nNhap chieu cao chu:")
	ten (getstring "\nNhap ten diem:"))
(while
  (setq diem (getpoint "\nChon cac vi tri co toa do can ghi:"))
	(setq   PT1 (getpoint diem "Nhap diem thu 2") 
		 x (rtos(car diem) 2 4)
			 y (rtos (cadr diem) 2 4)
	   tapx (append tapx (list x))
	   tapy (append tapy (list y))
		 k (+ 1 k)
		 N (strcat ten (rtos k 2 0))
		stt (append stt (list N))	  );setq
(if (> (distance diem PT1) (* 1.8 h)) (setq PT2 (polar diem (angle diem PT1) (- (distance diem PT1) (* 1.8 h)))) (setq PT2 NIL))
  (setvar "osmode" 0)
(setq obj (textM pt1 h x)) (setq ss (entlast)) 
;(command "text" "j" "BL" PT1 h 0 x)
(setq TB (textbox (entget ss)) 
LC (car TB) RC (cadr TB) di (distance LC RC) C PT1);setq
(command "erase" ss "" "pline" diem pt2 ""
		 "circle" C (* 1.8 h))
		 (textM C h N) 
	(setvar "osmode" om)	);dong while
;tao bang thong ke
(setq	kc (* 2 di)
	PT (getpoint"\nvi tri dat bang :")
	PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
	p1 (list (car PT) (+ (cadr PT)(* 2 h)))
	p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))
	p3 (list (car p1) (+ (cadr p1)(* 2 h)))
	p4 (list (car p2) (+ (cadr p2)(* 2 h)))
	PTD (list (+ (/ di 2) (car PT))  (+ h (cadr PT)))
	PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
	PTY (list (+ kc (car PTX)) (cadr PTX))
	  p11 (list (+ (/ di 2) (car p1))  (+ h (cadr p1)))
	  p22 (list (+ di (/ di 2) (car p11)) (cadr p11))
	  p33 (list (+ kc (car p22)) (cadr p22))
	  L1 (list (+ di (car p3))(cadr p3))
	  L2 (list (+ kc (car L1))(cadr L1))
	 n (length tapx)
	 k 0);setq
(setvar "osmode" 0)
  (command "line" p1 p2 "" "line" p3 p4 "")
	   (textM p11 h "STT") ;"text" "j" "m" p11 h 0 "STT" 
	   (textM p22 h "T\U+1ECDa \U+0111\U+1ED9 X") ;"text" "j" "m" p22 h 0 "Täa ®é X"
	   (textM p33 h "T\U+1ECDa \U+0111\U+1ED9 Y") ;"text" "j" "m" p33 h 0 "Täa ®é Y"
  (while (< k n) 
	(setq xx (nth k tapx)
	  yy (nth k tapy)
	 tstt(nth k stt))
		 (textM PTD h tstt) ;"text" "j" "m" PTD h 0 tstt 
		 (textM PTX h xx) ;"text" "j" "m" PTX h 0 xx 
		 (textM PTY h yy) ;"text" "j" "m" PTY h 0 yy 
		(command "line" PT PTC "")	
	(setq PT (list (car PT) (- (cadr PT)(* 2 h)))
		 PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
	 PTD (list (+ (/ di 2) (car PT))  (+ h (cadr PT)))
	 PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
	 PTY (list (+ kc (car PTX)) (cadr PTX))
	  k (+ 1 k))	);while
  (if (= k n)
	(setq PT (list (car PT) (+ (cadr PT)(* 2 h)))
	  PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
	  L11 (list (+ di (car PT))(cadr PT))
	  L22 (list (+ kc (car L11))(cadr L11)))	);if
(command "line" p3 PT ""
	  "line" p4 PTC ""
	  "line" L1 L11 ""
	  "line" L2 L22 "")
(setvar "osmode" om ) (setvar "cmdecho" 1)
  (command "Undo" "End")  (princ))

<<

Filename: 332596_td.lsp
Tác giả: nhoclangbat
Bài viết gốc: 332734
Tên lệnh: td
https://twitter.com/Healty_Pills

- sữa lại tí phụ anh P, bạn thử xem

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/12225-xin-lisp-xuat-toa-do/page-3
;GHI TOA DO CAC DIEM VA THONG KE THANH BANG
----------------------------------------------
(defun textM (pt height string / lst) 
(setq lst (list '(0 . "TEXT") (cons 10 pt) (cons 40 height) (cons 1 string) (cons 50 0) (cons 72 4) (cons 11 pt) (cons 7 (getvar...
>>

- sữa lại tí phụ anh P, bạn thử xem

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/12225-xin-lisp-xuat-toa-do/page-3
;GHI TOA DO CAC DIEM VA THONG KE THANH BANG
----------------------------------------------
(defun textM (pt height string / lst) 
(setq lst (list '(0 . "TEXT") (cons 10 pt) (cons 40 height) (cons 1 string) (cons 50 0) (cons 72 4) (cons 11 pt) (cons 7 (getvar "Textstyle"))))
(entmakeX Lst)  )
(defun C:td (/ diem PT1 PT2 tapx tapy obj ss
		   x y xx yy h n di kc ten k
		   C PT PTX PTY PTD PTC N
		   p1 p2 p3 p4 p11 p22 p33 L1 L2 L11 L22)
(setvar "cmdecho" 0 )
(command "Undo" "Begin")  
  (setq om (getvar "osmode"))
  (setq tapx '()
	tapy '()
	stt '()
		h (getreal "\nNhap chieu cao chu:")
	ten (getstring "\nNhap ten diem:"))
	(initget 1)
	(setq k  (getint "\nNhap so thu tu diem:"))
(while
  (setq diem (getpoint "\nChon cac vi tri co toa do can ghi:"))
	(setq   PT1 (getpoint diem "Nhap diem thu 2") 
		 x (rtos(car diem) 2 4)
			 y (rtos (cadr diem) 2 4)
	   tapx (append tapx (list x))
	   tapy (append tapy (list y))
		 		 N (strcat ten (itoa k))
		stt (append stt (list N))	  );setq
(if (> (distance diem PT1) (* 1.8 h)) (setq PT2 (polar diem (angle diem PT1) (- (distance diem PT1) (* 1.8 h)))) (setq PT2 NIL))
  (setvar "osmode" 0)
(setq obj (textM pt1 h x)) (setq ss (entlast)) 
;(command "text" "j" "BL" PT1 h 0 x)
(setq TB (textbox (entget ss)) 
LC (car TB) RC (cadr TB) di (distance LC RC) C PT1);setq
(command "erase" ss "" "pline" diem pt2 ""
		 "circle" C (* 1.8 h))
		 (textM C h N) 
	(setvar "osmode" om)	
(setq k (1+ k))	
	);dong while
;tao bang thong ke
(setq	kc (* 2 di)
	PT (getpoint"\nvi tri dat bang :")
	PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
	p1 (list (car PT) (+ (cadr PT)(* 2 h)))
	p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))
	p3 (list (car p1) (+ (cadr p1)(* 2 h)))
	p4 (list (car p2) (+ (cadr p2)(* 2 h)))
	PTD (list (+ (/ di 2) (car PT))  (+ h (cadr PT)))
	PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
	PTY (list (+ kc (car PTX)) (cadr PTX))
	  p11 (list (+ (/ di 2) (car p1))  (+ h (cadr p1)))
	  p22 (list (+ di (/ di 2) (car p11)) (cadr p11))
	  p33 (list (+ kc (car p22)) (cadr p22))
	  L1 (list (+ di (car p3))(cadr p3))
	  L2 (list (+ kc (car L1))(cadr L1))
	 n (length tapx)
	 k 0);setq
(setvar "osmode" 0)
  (command "line" p1 p2 "" "line" p3 p4 "")
	   (textM p11 h "STT") ;"text" "j" "m" p11 h 0 "STT" 
	   (textM p22 h "T\U+1ECDa \U+0111\U+1ED9 X") ;"text" "j" "m" p22 h 0 "Täa ®é X"
	   (textM p33 h "T\U+1ECDa \U+0111\U+1ED9 Y") ;"text" "j" "m" p33 h 0 "Täa ®é Y"
  (while (< k n) 
	(setq xx (nth k tapx)
	  yy (nth k tapy)
	 tstt(nth k stt))
		 (textM PTD h tstt) ;"text" "j" "m" PTD h 0 tstt 
		 (textM PTX h xx) ;"text" "j" "m" PTX h 0 xx 
		 (textM PTY h yy) ;"text" "j" "m" PTY h 0 yy 
		(command "line" PT PTC "")	
	(setq PT (list (car PT) (- (cadr PT)(* 2 h)))
		 PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
	 PTD (list (+ (/ di 2) (car PT))  (+ h (cadr PT)))
	 PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
	 PTY (list (+ kc (car PTX)) (cadr PTX))
	  k (+ 1 k))	);while
  (if (= k n)
	(setq PT (list (car PT) (+ (cadr PT)(* 2 h)))
	  PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
	  L11 (list (+ di (car PT))(cadr PT))
	  L22 (list (+ kc (car L11))(cadr L11)))	);if
(command "line" p3 PT ""
	  "line" p4 PTC ""
	  "line" L1 L11 ""
	  "line" L2 L22 "")
(setvar "osmode" om ) (setvar "cmdecho" 1)
  (command "Undo" "End")  (princ))


<<

Filename: 332734_td.lsp
Tác giả: nhoclangbat
Bài viết gốc: 332811
Tên lệnh: tinhcd
Hỏi về Lisp (thuật toán, ý tưởng, coding,...)

- hi nhoc cũng mới thử code nhanh theo ý tưởng của bạn, bạn tham khảo ^^

(defun C:tinhcd(/ c ename info cong chia ds_cong ds_ent num)
(setq c -1 )
(if (setq ss (ssget '((0 . "TEXT"))))
 (progn
    (while (setq ename (ssname ss (setq c (1+ c))))
      (if (setq num (distof (cdr (assoc 1 (entget ename)))))
	      
          (setq ds_ent (append ds_ent (list ename)))
      );if
	  ds_ent
	);while, vong while dùng de kiem tra cac text dang so,...
>>

- hi nhoc cũng mới thử code nhanh theo ý tưởng của bạn, bạn tham khảo ^^

(defun C:tinhcd(/ c ename info cong chia ds_cong ds_ent num)
(setq c -1 )
(if (setq ss (ssget '((0 . "TEXT"))))
 (progn
    (while (setq ename (ssname ss (setq c (1+ c))))
      (if (setq num (distof (cdr (assoc 1 (entget ename)))))
	      
          (setq ds_ent (append ds_ent (list ename)))
      );if
	  ds_ent
	);while, vong while dùng de kiem tra cac text dang so, neu la dang so thi gom cac ename do vao 1 danh sach
;//////////////////////////////////////////////////////////////////	
(if ds_ent
(progn
(foreach k ds_ent
(if (= (cdr (assoc 8 (entget k))) "TEXT2")
   (setq info (entget k))
   ) ; if nay de loc lay elist cua text mau xanh can entmod
;///////////////////////////////////////////
(if (= (cdr (assoc 8 (entget k))) "TEXT1")
   (setq chia (distof (cdr (assoc 1 (entget k)))))
   ) ; if nay dung de loc texst mau vang dat sau do lay gia tri cua no ra
;////////////////////////////////////////////
(if (= (cdr (assoc 8 (entget k))) "TEXT3")
 (progn
   (setq cong (distof (cdr (assoc 1 (entget k)))))
   (setq ds_cong (append ds_cong (list cong)))
   )
   )
 ) ; if nay de loc cac text mau do gom cac gia tri cua no vao 1 danh sach
(entmod (subst (cons 1 (rtos (/ (apply '+ ds_cong) chia) 2 2))   (assoc 1 info) info))
)  
)
  );progn
  (alert "\nChua co doi tuong dc chon hoac ban chi chon toan text chu ^^")
);if    
(princ)
)


<<

Filename: 332811_tinhcd.lsp
Tác giả: trinhhoanghieu090
Bài viết gốc: 332852
Tên lệnh: clt
Nội suy cao độ thiết kế tim đường

Cái này chuẩn hơn nè

(defun c:CLT (/	     CAODO1 CAODO2 CAODO3 CHIEUCAO	D      D1
	      D2     DH	    DHZ	   ITEM1  ITEM2	 PT1	PT2    PT3
	      STT    TDO1   TDO2   TEMP1  TEMP2	 X1	X2     X3
	      Y1     Y2	    Y3	   Z1	  Z2	 Z3
		  goc1 goc2 hieugoc
	     ) 
  (defun *error* (msg)
    (if	Olmode
      (setvar 'osmode Olmode)
    )
    (if	(not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nError: " msg))
    )
   ...
>>

Cái này chuẩn hơn nè

(defun c:CLT (/	     CAODO1 CAODO2 CAODO3 CHIEUCAO	D      D1
	      D2     DH	    DHZ	   ITEM1  ITEM2	 PT1	PT2    PT3
	      STT    TDO1   TDO2   TEMP1  TEMP2	 X1	X2     X3
	      Y1     Y2	    Y3	   Z1	  Z2	 Z3
		  goc1 goc2 hieugoc
	     ) 
  (defun *error* (msg)
    (if	Olmode
      (setvar 'osmode Olmode)
    )
    (if	(not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )
  (prompt "Made_By_Thanhduan2407, Edit_By_Trinhhoanghieu090")

  (if (not sle)
    (setq sle 2)
  )
  (setq	sle0
	 (getint
	   (strcat
	     "\nChon So Le Thap Phan <"
	     (itoa sle)
	     ">: "
	   )
	 )
  )
  (if sle0
    (progn
      (if (< sle0 0)
	(setq sle0 0)
      )
      (if (> sle0 10)
	(setq sle0 10)
      )
      (setq sle sle0)
    )
  )
  (if (and 
		(setq tdo1 (getpoint "\nChon Diem Thap:"))
		(setq item1 (entsel "\nChon Text Diem Thap:"))
		(setq tdo2 (getpoint "\nChon Diem Cao:"))
	    (setq item2 (entsel "\nChon Text Diem Cao:"))
      )
    (progn
      (progn

	(setq temp1 (entget (car item1)))


	(setq Caodo1 (cdr (assoc 1 temp1))
	      x1     (car Tdo1)
	      y1     (cadr Tdo1)
	)
	(setq pt1 (list x1 y1))
	(setq z1 (atof Caodo1))

	(setq temp2 (entget (car item2)))

	(setq Caodo2 (cdr (assoc 1 temp2))
	      x2     (car Tdo2)
	      y2     (cadr Tdo2)
	)
	(setq pt2 (list x2 y2))
	(setq z2 (atof Caodo2))
      )

	(while
		(setq  pt3 (getpoint "\nChon Vi Tri Can Noi Suy Cao Do:"))
		
		(setq	goc1	(* 180.0 (angle pt1 pt2) (/ 1.0 pi))
				goc2	(* 180.0 (angle pt1 pt3) (/ 1.0 pi))
				hieugoc (rem  (+ goc1 (- goc2) 360.0) 360.0)
		)
	   (if
			(or (equal hieugoc 0.0 0.0001) 
				(equal hieugoc 180.0 0.0001)
				(equal hieugoc 360.0 0.0001)
			)

	     (progn
	       (setq x3 (car pt3))
	       (setq y3 (cadr pt3))
	       (setq d1 (distance pt1 pt2))
	       (setq d2 (distance pt1 pt3))
	       (setq dh (- z2 z1)) 
	       (setq dhz (* dh (/ d2 d1)))
		   (if	(equal hieugoc 180.0 0.0001)
				(setq dhz (- dhz))
			)
	       (setq z3 (+ z1 dhz))


	       (setq Caodo3 (rtos z3 2 sle))
;		   (setq pt3 (getpoint pt3 "\nChon Diem Dat Cao Do:"))
	       (setq pt3 (list (car pt3) (cadr pt3) z3))

	       (entmake
				  (list	
                  (cons 0 "TEXT")
			      (cons 10 pt3)
			      (cons 1 Caodo3)
				  (assoc 8 temp1)
				  (assoc 7 temp1)
			      (assoc 40 temp1)
				  (assoc 50 temp1)
					)
					
	       )
	     ); end progn
		 (alert "\Ban Da Pick Diem Khong Thang Hang")
	   ); end if
    ) ; end while

    )
  )
  (princ)
)

<<

Filename: 332852_clt.lsp
Tác giả: trinhhoanghieu090
Bài viết gốc: 333000
Tên lệnh: cg
nhờ cao thủ sửa lisp

Hi hi, lại chậm hơn nhóc rồi, thôi đã làm thì cứ post

(defun c:cg( / os p1 p2 a d p3 st ent loai tmc )
  (prompt "\nEdit_By_Trinhhoanghieu090_Source_Code_Of_CadvietLisp")
  (setvar "cmdecho" 0)
  (setq OS (getvar "OSMODE"))
  (setvar "OSMODE" 32)

  (setq P1 (getpoint "\nPick a corner of the rectangle: "))
  (setq P2 (getcorner P1 "\nPick opposite corner of the rectangle: "))
  (setq A (angle P1 P2))
  (setq D (distance P1 P2))
  (setq P3...
>>

Hi hi, lại chậm hơn nhóc rồi, thôi đã làm thì cứ post

(defun c:cg( / os p1 p2 a d p3 st ent loai tmc )
  (prompt "\nEdit_By_Trinhhoanghieu090_Source_Code_Of_CadvietLisp")
  (setvar "cmdecho" 0)
  (setq OS (getvar "OSMODE"))
  (setvar "OSMODE" 32)

  (setq P1 (getpoint "\nPick a corner of the rectangle: "))
  (setq P2 (getcorner P1 "\nPick opposite corner of the rectangle: "))
  (setq A (angle P1 P2))
  (setq D (distance P1 P2))
  (setq P3 (polar P1 A (/ D 2.0)))

(setq ST (entsel "\nSelect *text to center inside rectangle: "))

  (while
    (= ST nil)
     (progn
       (prompt "\nText was not selected...")
       (setq ST (entsel "\nSelect *text to center inside rectangle: "))
     )
  )
  (Setq ent (entget (car ST))
		loai (cdr(assoc 0 ent))
  )
  (cond	
		((= loai "TEXT")
		 (command "justifytext" ST "" "MC")
		 (setq TMC (cdr (assoc 11 ent)))
		)
		((= loai "MTEXT")
		 (setq	ST (cdr(car(entmod (subst '(71 . 5) (assoc 71 ent) ent))))
				TMC (cdr (assoc 10 ent))
		  )
		)
	)
  (command "move" ST "" TMC P3)

  (setvar "OSMODE" OS)
  (princ)
)

<<

Filename: 333000_cg.lsp
Tác giả: nhoclangbat
Bài viết gốc: 332999
Tên lệnh: cg
nhờ cao thủ sửa lisp

- hi đôi lúc dùng mtext có cái hay của nó ^^, sửa tí theo mong mún của bạn

(defun c:cg(/ info os p1 p2 p3 tmc d st)

  (setvar "cmdecho" 0)
  (setq OS (getvar "OSMODE"))
  (setvar "OSMODE" 32)

  (setq P1 (getpoint "\nPick a corner of the rectangle: "))
  (setq P2 (getcorner P1 "\nPick opposite corner of the rectangle: "))
  (setq A (angle P1 P2))
  (setq D (distance P1 P2))
  (setq P3 (polar P1 A (/ D 2.0)))

(setq ST (entsel "\nSelect *text...
>>

- hi đôi lúc dùng mtext có cái hay của nó ^^, sửa tí theo mong mún của bạn

(defun c:cg(/ info os p1 p2 p3 tmc d st)

  (setvar "cmdecho" 0)
  (setq OS (getvar "OSMODE"))
  (setvar "OSMODE" 32)

  (setq P1 (getpoint "\nPick a corner of the rectangle: "))
  (setq P2 (getcorner P1 "\nPick opposite corner of the rectangle: "))
  (setq A (angle P1 P2))
  (setq D (distance P1 P2))
  (setq P3 (polar P1 A (/ D 2.0)))

(setq ST (entsel "\nSelect *text to center inside rectangle: "))

  (while
    (= ST nil)
     (progn
       (prompt "\nText was not selected...")
       (setq ST (entsel "\nSelect *text to center inside rectangle: "))
     )
  )
  (setq info (entget (car ST)))
  (command "justifytext" ST "" "MC")
  (if (= (cdr (assoc 0 info)) "TEXT")
  (setq TMC (cdr (assoc 11 info)))
   )
  (if (= (cdr (assoc 0 info)) "MTEXT")
  (setq TMC (cdr (assoc 10 info)))
  )
  (command "move" ST "" TMC P3)

  (setvar "OSMODE" OS)
(setvar "cmdecho" 1)
  (princ)

)

-p/s: mặc dù nhoc chưa dùng mtext bao giờ :P


<<

Filename: 332999_cg.lsp
Tác giả: nhoclangbat
Bài viết gốc: 333033
Tên lệnh: cg
nhờ cao thủ sửa lisp
 

- ý anh Tue nói nhoc thấy cũng hay ^^, chưa pit nhoc hiểu đúng ko nhoc cũng mạo mụi sửa lại thử, giờ mình sẽ ko quan tam điểm canh lề của text hay mtext có giữa hay ko mà sẽ kím tọa độ điểm giữa của 2 loại đó, giữ nguyên justify của đối tượng, mượn tí của...

>>
 

- ý anh Tue nói nhoc thấy cũng hay ^^, chưa pit nhoc hiểu đúng ko nhoc cũng mạo mụi sửa lại thử, giờ mình sẽ ko quan tam điểm canh lề của text hay mtext có giữa hay ko mà sẽ kím tọa độ điểm giữa của 2 loại đó, giữ nguyên justify của đối tượng, mượn tí của lee-mac ^^


(defun c:cg(/ os p1 p2 p3 tmc d st lstp pdau pcuoi pgiua obj)
(vl-load-com)
  (setvar "cmdecho" 0)
  (setq OS (getvar "OSMODE"))
  (setvar "OSMODE" 32)

  (setq P1 (getpoint "\nPick a corner of the rectangle: "))
  (setq P2 (getcorner P1 "\nPick opposite corner of the rectangle: "))
  (setq A (angle P1 P2))
  (setq D (distance P1 P2))
  (setq P3 (polar P1 A (/ D 2.0)))

(setq ST (entsel "\nSelect *text to center inside rectangle: "))

  (while
    (= ST nil)
     (progn
       (prompt "\nText was not selected...")
       (setq ST (entsel "\nSelect *text to center inside rectangle: "))
     )
  )
     (if ST
  (progn
  (setq obj (vlax-ename->vla-object (car st)))
    (setq lstp (vla-getBoundingBox obj 'minp 'maxp))
  (setq pdau (vlax-safearray->list minp))
    (setq pcuoi (vlax-safearray->list maxp))
	(setq pgiua (polar pdau (angle pdau pcuoi) (* (distance pdau pcuoi) 0.5)))
	 (LM:TranslateByMatrix obj (trans pgiua 1 0) (trans P3 1 0))
  )
  )
  

  (setvar "OSMODE" OS)
(setvar "cmdecho" 1)
  (princ)

)
;//////////////////
(defun LM:TranslateByMatrix ( target p1 p2 )

  (LM:ApplyMatrixTransformation target
    (list
      (list 1. 0. 0.)
      (list 0. 1. 0.)
      (list 0. 0. 1.)
    )
    (mapcar '- p2 p1)
  )
)
;/////////////////////////////
(defun LM:ApplyMatrixTransformation ( target matrix vector ) (vl-load-com)
  (cond
    ( (eq 'VLA-OBJECT (type target))
     
      (vla-TransformBy target
        (vlax-tMatrix
          (append (mapcar '(lambda ( x v ) (append x (list v))) matrix vector)
           '((0. 0. 0. 1.))
          )
        )
      )
    )
    ( (listp target)

      (mapcar
        (function
          (lambda ( point ) (mapcar '+ (mxv matrix point) vector))
        )
        target
      )
    )        
  )
)
;////////////
(defun mxv ( m v )
  (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

<<

Filename: 333033_cg.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 332487
Tên lệnh: pt
Lisp ghi toạ độ điểm ra màn hình !!!

Thêm STT đây!

(defun c:pt (/ p lst fn pw n)
 (while (setq p (getpoint "\nPick Point: "))
  (setq lst (cons p lst)))
 (setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
 (setq pw (open fn "w"))
 (setq n 1)
 (write-line "STT,Y,X" pw)
 (foreach p (reverse lst)
  (write-line (strcat (itoa n) "," (rtos (cadr p) 2 2) "," (rtos (car p) 2 2)) pw)
  (setq n (1+ n)))
 (close pw)
 (princ))

Filename: 332487_pt.lsp
Tác giả: trinhhoanghieu090
Bài viết gốc: 333137
Tên lệnh: cpt
Gán nội dung từ text này sang text

Đã thêm phần xoá text nguồn cho bạn, cái này dùng được cả với text và Mtext nhé

(defun c:cpt ( / doithuoctinh cptext1 a b)

(defun doithuoctinh( ename dxfcode listvalue )
(entmod (subst (cons dxfcode listvalue) (assoc dxfcode (entget ename)) (entget ename)))
)
(defun cptext1 ( e_nguon e_dich / text_nguon)
	(setq	text_nguon (cdr(assoc 1 (entget e_nguon)))
	)
	(doithuoctinh e_dich 1 text_nguon)
)
	(prompt "Chon Text Nguon:")
	(while	(not...
>>

Đã thêm phần xoá text nguồn cho bạn, cái này dùng được cả với text và Mtext nhé

(defun c:cpt ( / doithuoctinh cptext1 a b)

(defun doithuoctinh( ename dxfcode listvalue )
(entmod (subst (cons dxfcode listvalue) (assoc dxfcode (entget ename)) (entget ename)))
)
(defun cptext1 ( e_nguon e_dich / text_nguon)
	(setq	text_nguon (cdr(assoc 1 (entget e_nguon)))
	)
	(doithuoctinh e_dich 1 text_nguon)
)
	(prompt "Chon Text Nguon:")
	(while	(not 
				(setq	a (ssget "_+.:E:S" '((0 . "TEXT,MTEXT"))) )
				)
		)
	(while
		(progn
			(setvar	'errno 0)
			(setq	b  (entsel "\nChon Text Dich:") )
		
			(cond
				( (= (getvar 'errno) 7) (princ "\nBan Pick Truot, Hay Pick Lai ") )
				( (and	 b 
						 (/= (cdr(assoc 0 (entget (car b)))) "TEXT")
						 (/= (cdr(assoc 0 (entget (car b)))) "MTEXT")
						
					)
						 (princ "\nBan Pick Nham, Hay Pick Lai ")
				)
				( (and b 
					   (OR 
						(= (cdr(assoc 0 (entget (car b)))) "TEXT")
						(= (cdr(assoc 0 (entget (car b)))) "MTEXT")
						)
						(cptext1 (SSNAME a 0) (car b)) 
					)
				)
				( (not b) nil)
			)
		)
	)
	(command ".erase" a "")
)

<<

Filename: 333137_cpt.lsp
Tác giả: huunhantvxdts
Bài viết gốc: 333310
Tên lệnh: stc
tính diện tích dựa vào điểm đặt text xung quanh

Đây là lisp tôi sửa lại theo như file bạn gửi (file có pline kín), nhưng chạy hơi rùa bò 1 tí (khoảng 2700 đối tượng mất hết 3 phút) bạn dùng thử có chi sẽ bổ sung thêm

Chú ý: file bạn phải đưa hệ tọa độ (world) mới chạy được

;;;;;;;;;;;;;;;;;;;;;;;;;; 
(Defun C:stc ( / ss dem1 s)
(command "undo" "BE")
(setq luubatdiem...
>>

Đây là lisp tôi sửa lại theo như file bạn gửi (file có pline kín), nhưng chạy hơi rùa bò 1 tí (khoảng 2700 đối tượng mất hết 3 phút) bạn dùng thử có chi sẽ bổ sung thêm

Chú ý: file bạn phải đưa hệ tọa độ (world) mới chạy được

;;;;;;;;;;;;;;;;;;;;;;;;;; 
(Defun C:stc ( / ss dem1 s)
(command "undo" "BE")
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setvar "CMDECHO" 0)   
 (prompt "\nChon Text ki hieu mau.")
  (setq DT (car (entsel)))
  (setq DT (entget DT))
  (setq NDT (cdr (assoc 1 DT)))
  (setq LDT (cdr (assoc 8 DT)))
   (Princ "\nHay chon vung :")
(setq SS (ssget  (list (cons 0 "text")
                          (cons 8 LDT)
                    )
         ) 
)
(command "-layer" "new" (strcat "Lop dia chat " NDT) "color" "8" (strcat "Lop dia chat " NDT) "")
(command "-layer" "set" (strcat "Lop dia chat " NDT) "")
(setq dem1 1)
(setq sodt (sslength ss)
ta 
            (chr 8)
stxoa (strcat ta ta ta ta ta ta ta ta ta ta ta ta ta ta 
            ta ta ta ta ta ta)
stxuly "Xu ly duoc: "
ptcu nil
)
(setq i 0)
 (setq N (sslength ss))
(while (< i N)
  (setq DT (ssname ss i))	
  (setq DTT (entget DT))
  (setq point (cdr (assoc 10 DTT)))
  (vla-ZoomCenter (vlax-get-acad-object) (vlax-3D-point point) 50)
  (command "Bhatch" point "")
  (Command "area" "o" (entlast))
  (setq s (getvar "area"))
  ;(setq th (getvar "textsize"))
  ;(command "TEXT" point th 0 (rtos s 2 2))
  ;(setq point2 (polar point 0 2.5))
  ;(command "TEXT" point2 th 0 "m2")
  (setq i (1+ i))
(setq giatricu (assoc 1 DTT))
(setq giatrimoi (cons 1 (rtos s 2 2)))
(setq DTT (subst giatrimoi giatricu DTT))
(entmod DTT)
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; xu ly phan tram chay o duoi
(setq pt (* (/ (* dem1 1.0) sodt) 100.0)
dem1 (+ dem1 1)
)
(if (/= pt ptcu)
(progn
(princ (strcat stxoa stxuly (rtos pt 2 0) "%"))
(setq ptcu pt)
)
)
(setvar "MODEMACRO" "DANG XU LY CHO TRONG GIAY LAT")
 )
(setvar "osmode" luubatdiem)
(setvar "CMDECHO" 1)
(command "undo" "End")
(princ)
)	
;;;;;;;;;;;;;

<<

Filename: 333310_stc.lsp
Tác giả: leo9693
Bài viết gốc: 333365
Tên lệnh: mt
Lisp đánh số

Chào các bác,

Em xin được lisp đánh số thứ tự.

-Lisp này nhập số ban đầu, sau đó nó tự động nhảy số theo thứ tự tăng dần, mỗi số được đặt trong 1 vòng tròn và 1 mũi tên chỉ đến điểm mà nó biểu thị.

- Các bác có thể sửa lại giúp em: 

 +  Hiện tại số đánh hiển thị theo dạng "x" (vd: 1,2,3....,100,...). Em muốn hiển thị theo dạng "xxx" (vd:...

>>

Chào các bác,

Em xin được lisp đánh số thứ tự.

-Lisp này nhập số ban đầu, sau đó nó tự động nhảy số theo thứ tự tăng dần, mỗi số được đặt trong 1 vòng tròn và 1 mũi tên chỉ đến điểm mà nó biểu thị.

- Các bác có thể sửa lại giúp em: 

 +  Hiện tại số đánh hiển thị theo dạng "x" (vd: 1,2,3....,100,...). Em muốn hiển thị theo dạng "xxx" (vd: 001,002,003,...,100,...)

 + Thay hình tròn bằng 1 hình chữ nhật 

Mong các bác giúp đỡ. Thank các bác nhiều.

(defun C:mt( / cc,in,ls)

    (setvar "CECOLOR" "Cyan")
   (setvar "dimASZ" 2)
   (setvar "dimASO" 0)
  
(setq in(getint "\n Choose the first of joint weld : "))
  (While
     
  (setq cc (getpoint "\n Specify center point for circle ")
ls (getpoint "\ Choose point on joint ")
)
  
        (command ".CIRCLE" cc "d" 5.5);
(command ".text" "M" cc 2.2 0 in)
   (setq q2 (polar  ls  (angle ls cc);
(- (distance ls cc) 2.75)
 ))
  
(command     "qleader" ls q2 nil)

  ^C ^C;
 (setq in (+ 1 in))

  )
  (setvar "CECOLOR" "bylayer");
);

<<

Filename: 333365_mt.lsp
Tác giả: trinhhoanghieu090
Bài viết gốc: 333377
Tên lệnh: mt
Lisp đánh số

chuẩn:

(defun C:mt( / cc in ls chuoi in_so num_zero dai p1 p2 q2 cao_chu)
   (setvar "CECOLOR" "Cyan")
   (setvar "dimASZ" 2)
   (setvar "dimASO" 0)
	(setq in (getstring "\nChoose the first number : ")
	)
(initget (+ 2 4))
(or #cao_chu (setq #cao_chu 2.2))
(setq cao_chu (getreal (strcat "\nEnter Text Height <" (rtos #cao_chu 2 2) " >:"))
)
(if (not cao_chu) (setq cao_chu #cao_chu) (setq #cao_chu cao_chu))

  (While     
  (setq cc (getpoint...
>>

chuẩn:

(defun C:mt( / cc in ls chuoi in_so num_zero dai p1 p2 q2 cao_chu)
   (setvar "CECOLOR" "Cyan")
   (setvar "dimASZ" 2)
   (setvar "dimASO" 0)
	(setq in (getstring "\nChoose the first number : ")
	)
(initget (+ 2 4))
(or #cao_chu (setq #cao_chu 2.2))
(setq cao_chu (getreal (strcat "\nEnter Text Height <" (rtos #cao_chu 2 2) " >:"))
)
(if (not cao_chu) (setq cao_chu #cao_chu) (setq #cao_chu cao_chu))

  (While     
  (setq cc (getpoint "\nSpecify center point for rectang: ")
		ls (getpoint cc "\nChoose point on joint ")
		dai (+ (strlen in) 2)
		p1 (list (- (car cc) (* 0.4 dai cao_chu)) (+ (cadr cc)  (* 0.75 cao_chu)))
		p2 (list (+ (car cc) (* 0.4 dai cao_chu)) (- (cadr cc) (* 0.75 cao_chu)) )
	)
  
;  (command ".CIRCLE" cc "d" 5.5)
  (command ".rectang" "non" p1 "non" p2)
  (command ".text" "M" cc cao_chu 0 in)
  (setq q2 (polar  ls  (angle ls cc) (- (distance ls cc) cao_chu)))
; (set q2 (list (car cc) (- (cadr cc) (* 0.75 cao_chu) ) ))
  
(command     "qleader" ls q2 nil)

  ^C ^C;
  
 (setq 	in_so (read in)
		in_so (+ 1 in_so)
		num_zero (- (strlen in) (strlen (itoa in_so)))
		chuoi ""
  )

  (if 	(> num_zero 0)
		 (repeat num_zero
		 (setq chuoi (strcat chuoi "0"))
		 )
				
   )
   (setq in (strcat chuoi (itoa in_so)))
    ); end while
  (setvar "CECOLOR" "bylayer");
);

<<

Filename: 333377_mt.lsp
Tác giả: trinhhoanghieu090
Bài viết gốc: 333374
Tên lệnh: mt
Lisp đánh số

tặng bạn, mình thêm phần nhập text hight:

(defun C:mt( / cc in ls chuoi in_so num_zero dai p1 p2 q2 cao_chu)
   (setvar "CECOLOR" "Cyan")
   (setvar "dimASZ" 2)
   (setvar "dimASO" 0)
	(setq in (getstring "\nChoose the first number : ")
	)
(initget (+ 2 4))
(or #cao_chu (setq #cao_chu 2.2))
(setq cao_chu (getreal (strcat "\nEnter Text Height <" (rtos #cao_chu 2 2) " >:"))
)
(if (not cao_chu) (setq cao_chu #cao_chu) (setq #cao_chu cao_chu))

 ...
>>

tặng bạn, mình thêm phần nhập text hight:

(defun C:mt( / cc in ls chuoi in_so num_zero dai p1 p2 q2 cao_chu)
   (setvar "CECOLOR" "Cyan")
   (setvar "dimASZ" 2)
   (setvar "dimASO" 0)
	(setq in (getstring "\nChoose the first number : ")
	)
(initget (+ 2 4))
(or #cao_chu (setq #cao_chu 2.2))
(setq cao_chu (getreal (strcat "\nEnter Text Height <" (rtos #cao_chu 2 2) " >:"))
)
(if (not cao_chu) (setq cao_chu #cao_chu) (setq #cao_chu cao_chu))

  (While     
  (setq cc (getpoint "\nSpecify center point for rectang: ")
		ls (getpoint cc "\nChoose point on joint ")
		dai (+ (strlen in) 2)
		p1 (list (- (car cc) (* 0.75 dai)) (+ (cadr cc)  (* 0.75 cao_chu)))
		p2 (list (+ (car cc) (* 0.75 dai)) (- (cadr cc) (* 0.75 cao_chu)) )
	)
  
;  (command ".CIRCLE" cc "d" 5.5)
  (command ".rectang" "non" p1 "non" p2)
  (command ".text" "M" cc cao_chu 0 in)
  (setq q2 (polar  ls  (angle ls cc) (- (distance ls cc) cao_chu)))
; (set q2 (list (car cc) (- (cadr cc) (* 0.75 cao_chu) ) ))
  
(command     "qleader" ls q2 nil)

  ^C ^C;
  
 (setq 	in_so (read in)
		in_so (+ 1 in_so)
		num_zero (- (strlen in) (strlen (itoa in_so)))
		chuoi ""
  )

  (if 	(> num_zero 0)
		 (repeat num_zero
		 (setq chuoi (strcat chuoi "0"))
		 )
				
   )
   (setq in (strcat chuoi (itoa in_so)))
    ); end while
  (setvar "CECOLOR" "bylayer");
);


<<

Filename: 333374_mt.lsp
Tác giả: trinhhoanghieu090
Bài viết gốc: 333440
Tên lệnh: mt
Lisp đánh số

Hehehe, rảnh rổi ngồi Test thì thấy Lisp có Vài chỗ không ổn :

1/ Dùng hàm getstring mà bảo nhập số là không nên, lở gỏ kí hiệu bất kì nào thì sao? (Cho dù mục đích bạn sử dụng chuỗi là số nhập để xử lí về sau)

2/ Khi bảo nhập số thì chắc là user chỉ cắm đầu nhâp số chứ...

>>

Hehehe, rảnh rổi ngồi Test thì thấy Lisp có Vài chỗ không ổn :

1/ Dùng hàm getstring mà bảo nhập số là không nên, lở gỏ kí hiệu bất kì nào thì sao? (Cho dù mục đích bạn sử dụng chuỗi là số nhập để xử lí về sau)

2/ Khi bảo nhập số thì chắc là user chỉ cắm đầu nhâp số chứ chẳng lẻ ai cũng hĩu là phải nhập 01 or 001, ... và ý chủ thớt chắc cũng là Nhập thẳng 1 số là ra thẳng 00x, 0xx, xxx :D

3/ Nên thiết lập điều kiện vong lặp While để khi Enter kết thúc không bị báo lỗi.

4/ Không nên set biến hệ thống lung tung rồi không trả về trạng thái cũ cho nó :)

Hè hè, 2 cái số 1/ và 2/ là do em cố tình viết để về một ngày sau này chủ thớt không viết thêm vào cái topic này yêu cầu  "bác ơi sửa lại cho em cái lisp nhập theo kiểu 001,002,...100 thành xxxxx1 ...1000xxx". Tác dụng cua no to lớn mà tac dung phu cua no khong dang lo ngai. Neu Bác có kế sách nào vẹn toàn hon thì chia sẻ để em học hỏi.

Cái số 3 và số 4 đúng là do còn tồn tại từ lisp gốc, tiện thể em update lên đây cái lisp vừa sửa cho nó trực quan hơn, nếu bác có hứng thì làm cho em nó trở nên hoàn hảo. :D

(defun C:mt( / cc in ls in_so num_zero dai p1 p2 q2 cao_chu)
   (setvar "CECOLOR" "Cyan")
   (setvar "dimASZ" 2)
   (setvar "dimASO" 0)
	(setq in (getstring "\nChoose the first number : ")
	)
(initget (+ 2 4))
(or #cao_chu (setq #cao_chu 2.2))
(setq cao_chu (getreal (strcat "\nEnter Text Height <" (rtos #cao_chu 2 2) " >:"))
)
(if (not cao_chu) (setq cao_chu #cao_chu) (setq #cao_chu cao_chu))

  (While     
  (setq cc (getpoint "\nSpecify center point for rectang: ")
		dai (+ (strlen in) 1)
		p1 (list (- (car cc) (* 0.38 dai cao_chu)) (+ (cadr cc)  (* 0.75 cao_chu)))
		p2 (list (+ (car cc) (* 0.38 dai cao_chu)) (- (cadr cc) (* 0.75 cao_chu)) )
	)
  
	(command ".rectang" "non" p1 "non" p2)
	(command ".text" "M" "NON" cc cao_chu 0 in)
  
	(setq
		q2 (list (car cc) (- (cadr cc) (* 0.75 cao_chu) ) )
		ls (getpoint q2 "\nChoose point on joint ")
	)
	(command     "qleader" ls q2 nil)

  ^C ^C;
  
 (setq 	in_so (read in)
		in_so (itoa (+ 1 in_so))
		num_zero (- (strlen in) (strlen in_so))
  )

  (if 	(> num_zero 0)
		 (repeat num_zero
		 (setq in_so (strcat "0" in_so))
		 )
		 				
   )
   (setq in in_so)
    ); end while
  (setvar "CECOLOR" "bylayer");
);

<<

Filename: 333440_mt.lsp
Tác giả: nhoclangbat
Bài viết gốc: 333461
Tên lệnh: mt
Lisp đánh số

- nhoc xin góp vui tý thêm 1 phương án cho chủ pic ^^


(defun C:mt( / cc in ls dai p1 p2 q2 cao_chu lstp)
(vl-load-com)
;================================================================
 ;==================================================================
(setq clr (getvar 'cecolor)  echo (getvar 'cmdecho))
   (setvar "CECOLOR" "Cyan")
     (setvar 'cmdecho 0)
	(setq in (getvalue in 1  "Choose the first number ")
	)
(setq cao_chu (getvalue cao_chu 2.2...
>>

- nhoc xin góp vui tý thêm 1 phương án cho chủ pic ^^


(defun C:mt( / cc in ls dai p1 p2 q2 cao_chu lstp)
(vl-load-com)
;================================================================
 ;==================================================================
(setq clr (getvar 'cecolor)  echo (getvar 'cmdecho))
   (setvar "CECOLOR" "Cyan")
     (setvar 'cmdecho 0)
	(setq in (getvalue in 1  "Choose the first number ")
	)
(setq cao_chu (getvalue cao_chu 2.2 "Nhap chieu cao text "))


  (While  (/= (setq cc (getpoint "\nSpecify center point for rectang: "))  nil) 
	
	(command ".text" "M" "NON" cc cao_chu 0 (them0 (itoa in)))
	(setq lstp (vla-getBoundingBox (vlax-ename->vla-object (cdr (assoc -1 (entget (entlast))))) 'minp 'maxp))
	(setq p1 (mapcar '+ (vlax-safearray->list minp) '(-0.35 -0.35 0.0)))
    (setq p2 (mapcar '+ (vlax-safearray->list maxp)  '(0.35 0.35 0.0)))
    (command ".rectang" "non" p1 "non" p2)
	(setq
		q2 (list (car cc) (- (cadr cc) (* 0.75 cao_chu)))
		ls (getpoint q2 "\nChoose point on joint ")        
	)
	(command     "qleader" ls q2 nil)

  ^C ^C;
 (setq in  (1+ in)) 
 
    ); end while
 (setvar "CECOLOR" clr)
    (setvar 'cmdecho echo)
  (princ)
);
; ham luu gia tri
(defun getvalue ( a giatri dongnhac / astr) 
(or a (setq a giatri))
(cond
	((= (type a) 'INT) (setq a (cond ((getint (strcat "\n" dongnhac "(" (itoa a) ") :")))(a))))
	((= (type a) 'REAL) (setq a (cond ((getreal (strcat "\n" dongnhac "(" (rtos a 2 2) ") :")))(a))))
	((= (type a) 'STR) (setq a (cond ((= "" (setq astr (getstring 1 (strcat "\n" dongnhac " (" a "): ")))) a) (astr))))
))
;;;;
(defun them0(chuoi)
  (setq len (strlen chuoi))
  (if (= len 1)
    (strcat "00" chuoi)
    (if (= len 2)
      (strcat "0" chuoi)
      chuoi
    )  
  )
 )

<<

Filename: 333461_mt.lsp
Tác giả: pphung183
Bài viết gốc: 333464
Tên lệnh: mt
Lisp đánh số

Đơn giản dễ hiểu và dân dã thôi :)

(defun C:mt( / oldCe in cc dai p1 p2 nd q2 ls cao_chu)
(setq oldCe (getvar "CECOLOR")) (setvar "CECOLOR" "Cyan")
(initget 1)	(setq in (getint "\nChoose the first number : "))
(initget (+ 2 4))
(or #cao_chu (setq #cao_chu 2.2))
(setq cao_chu (getreal (strcat "\nEnter Text Height <" (rtos #cao_chu 2 2) " >:"))
)
(if (not cao_chu) (setq cao_chu #cao_chu) (setq #cao_chu cao_chu))

  (While  (if (not (setq cc...
>>

Đơn giản dễ hiểu và dân dã thôi :)

(defun C:mt( / oldCe in cc dai p1 p2 nd q2 ls cao_chu)
(setq oldCe (getvar "CECOLOR")) (setvar "CECOLOR" "Cyan")
(initget 1)	(setq in (getint "\nChoose the first number : "))
(initget (+ 2 4))
(or #cao_chu (setq #cao_chu 2.2))
(setq cao_chu (getreal (strcat "\nEnter Text Height <" (rtos #cao_chu 2 2) " >:"))
)
(if (not cao_chu) (setq cao_chu #cao_chu) (setq #cao_chu cao_chu))

  (While  (if (not (setq cc (getpoint "\nSpecify center point for rectang: "))) (alert "\nXong!")
(progn	(setq 	dai (+ (strlen (itoa in)) 2)
		p1 (list (- (car cc) (* 0.38 dai cao_chu)) (+ (cadr cc)  (* 0.75 cao_chu)))
		p2 (list (+ (car cc) (* 0.38 dai cao_chu)) (- (cadr cc) (* 0.75 cao_chu)) )
	)
  (cond 
((<= in -100) (setq nd (strcat (itoa in)))) 
((and (> in -100) (<= in -10)) (setq nd (strcat "-0" (itoa (abs in))))) 
((and (> in -10) (< in 0)) (setq nd (strcat "-00" (itoa (abs in))))) 
((and (>= in 0) (< in 10)) (setq nd (strcat "00" (itoa in)))) 
((and (>= in 10) (< in 100)) (setq nd (strcat "0" (itoa in)))) 
((>= in 100) (setq nd (strcat (itoa in)))) )
	(command ".rectang" "non" p1 "non" p2)
	(command ".text" "M" "NON" cc cao_chu 0 nd)
  
	(setq
		q2 (list (car cc) (- (cadr cc) (* 0.75 cao_chu) ) )
		ls (getpoint q2 "\nChoose point on joint ")
	)
	(command     "qleader" ls q2 nil)
(setq in (+ 1 in))
    ))); end while
  (setvar "CECOLOR" oldCe)
(princ))

Ps : Lisp Nhoc nhập -10 thử xem :D


<<

Filename: 333464_mt.lsp
Tác giả: thangbkpro
Bài viết gốc: 115125
Tên lệnh: vt2
Viết lisp theo yêu cầu [phần 2]
Chào các bạn
Giúp mình nối 2 lip đếm text dưới đây thành một được không
1. Lip đếm text của bác gia_bach. sau khi đếm in ra table trong cad 1 cột loại text 1 cột là số lượng và 1 cột là số thứ tự

Giờ mình muốn nối thành một lip với thực hiện lệnh như sau:

select text và in ra file exel với 1 cột số thứ tự 1 cột loại text và 1 cột số lượng loại đó.
>>
Chào các bạn
Giúp mình nối 2 lip đếm text dưới đây thành một được không
1. Lip đếm text của bác gia_bach. sau khi đếm in ra table trong cad 1 cột loại text 1 cột là số lượng và 1 cột là số thứ tự

Giờ mình muốn nối thành một lip với thực hiện lệnh như sau:

select text và in ra file exel với 1 cột số thứ tự 1 cột loại text và 1 cột số lượng loại đó.

Ngoài ra mình còn muốn thống kê text vào file excel có sẵn trên ổ đĩa. Vì với một bản vẽ điện thì có rất nhiều tủ. Mình làm thống kê theo từng tủ nên tạo ra rất nhiều file exel. Nếu vẫn thống kê theo cách trên mà chỉ điền vào một file cell duy nhất tức là file exel đó đang làm đến row 17 sẽ điền tiếp vào row 18 thì tuyệt!
Many thanks!
<<

Filename: 115125_vt2.lsp

Trang 189/330

189