Jump to content
InfoFile
Tác giả: tigertiger
Bài viết gốc: 67019
Tên lệnh: cso
LISP cộng têxt toàn bộ bản vẽ thêm 1 hằng sô

Đây bạn :

(defun c:cso()
(setq olddim (getvar "dimzin"))
(setvar "DimZin" 0)

(setq en (ssget '((0 . "TEXT"))))
(setq tp (getint "\n So chu so thap phan :"))

(setq n (sslength en)...
>>
Đây bạn :

(defun c:cso()
(setq olddim (getvar "dimzin"))
(setvar "DimZin" 0)

(setq en (ssget '((0 . "TEXT"))))
(setq tp (getint "\n So chu so thap phan :"))

(setq n (sslength en) i 0)

(if (null newo) (setq newo 1))

(setq new1 (getreal (strcat "\nNhap so can cong <" (rtos newo) ">: ")))

(if (null new1) (setq new1 newo) (setq newo new1))

(while (< i n)

(setq ename (entget (ssname en i)))

(setq li (cdr (assoc 1 ename)))
(setq lis (+ (atof li) new1))

(setq ename (subst (cons 1 (rtos lis 2 tp)) (assoc 1 ename) ename))

(entmod ename)
(setq i (+ i 1))
)
(setvar "dimzin" olddim)
(princ)
)
;;;;

 

rất hay


<<

Filename: 67019_cso.lsp
Tác giả: Tue_NV
Bài viết gốc: 422099
Tên lệnh: pci
Điều chỉnh làm tròn của text field trong block att

Conghoa thử đoạn code này nhé!


(defun c:pci()
  (setvar "cmdecho" 0)
  (if (setq ss (ssget '((0 . "INSERT") (66 . 1))))
    (progn
        (setq i -1 pre (getint "So chu so thap phan :")) 
    (while (setq ename (ssname ss (setq i (1+ i))))
      (setq obj (vlax-ename->vla-object ename))
      (foreach x (vlax-invoke obj 'getattributes)
        (if (= (vla-get-HasExtensionDictionary x) :vlax-true) (progn
      (if...
>>

Conghoa thử đoạn code này nhé!


(defun c:pci()
  (setvar "cmdecho" 0)
  (if (setq ss (ssget '((0 . "INSERT") (66 . 1))))
    (progn
        (setq i -1 pre (getint "So chu so thap phan :")) 
    (while (setq ename (ssname ss (setq i (1+ i))))
      (setq obj (vlax-ename->vla-object ename))
      (foreach x (vlax-invoke obj 'getattributes)
        (if (= (vla-get-HasExtensionDictionary x) :vlax-true) (progn
      (if (setq pos (vl-string-search "%pr" (setq str (vl-string-subst ">%" " 0>%" (gc:FieldCode (vlax-vla-object->ename x))))))
          (vla-put-TextString x (setq tthe (strcat (substr str 1 (+ 3 pos)) (itoa pre) (VL-STRING-LEFT-TRIM "0123456789" (substr str (+ 4 pos))))))
      )
      (command "._updatefield" ename "")
     )
    )
      )
    )
    )
  )
)
(defun gc:FieldCode (ent / foo elst xdict dict field str)
  (defun foo (field str / pos fldID objID)
    (setq pos 0)
    (if (setq pos (vl-string-search "\\_FldIdx " str pos))
      (while (setq pos (vl-string-search "\\_FldIdx " str pos))
        (setq fldId (entget (cdr (assoc 360 field)))
              field (vl-remove (assoc 360 field) field)
              str   (strcat
                      (substr str 1 pos)
                      (if (setq objID (cdr (assoc 331 fldId)))
                        (vl-string-subst
                          (strcat "ObjId " (itoa (gc:EnameToObjectId objID)))
                          "ObjIdx"
                          (cdr (assoc 2 fldId))
                        )
                        (foo fldId (cdr (assoc 2 fldId)))
                      )
                      (substr str (1+ (vl-string-search ">%" str pos)))
                    )
        )
      )
      str
    )
  )
  ;;--------------------------------------------------------;;
  
  (setq elst (entget ent))
  (if (and
    (member (cdr (assoc 0 elst)) '("ATTRIB" "MTEXT" "TEXT"))
    (setq xdict (cdr (assoc 360 elst)))
    (setq dict (dictsearch xdict "ACAD_FIELD"))
    (setq field (dictsearch (cdr (assoc -1 dict)) "TEXT"))
      )
    (setq str (foo field (cdr (assoc 2 field))))
  )
)

;;============================================================;;

;; gc:EnameToObjectId (gile)
;; Returns the object ID from an ename
;;
;; Argument : a ename (as returned by enlast, entsel ...)

(defun gc:EnameToObjectId (ename)
  ((lambda (str)
     (hex2dec
       (substr (vl-string-right-trim ">" str) (+ 3 (vl-string-search ":" str)))
     )
   )
    (vl-princ-to-string ename)
  )
)

;;============================================================;;

;; hex2dec (gile)
;; Converts an hexadecimal to a decimal
;;
;; Argument : an hexadecimal (string)
;; Return : an integer

(defun hex2dec (s / r l n)
  (setq    r 0 l (vl-string->list (strcase s)))
  (while (setq n (car l))
    (setq l (cdr l)
          r (+ (* r 16) (- n (if (<= n 57) 48 55)))
    )
  )
)

 


<<

Filename: 422099_pci.lsp
Tác giả: huunhantvxdts
Bài viết gốc: 421210
Tên lệnh: thaytext
Tính tổng chiều dài theo layer !!!!
8 phút ago, Thuận Trần - QS cho biết:

Hi bác, khi chọ...

>>
8 phút ago, Thuận Trần - QS cho biết:

Hi bác, khi chọ object thì nó lại báo là lỗi, mình gửi file mẫu bác xem giúp.

1 số bản vẽ thì nó sẽ ghị là D8@150, cũng sẽ có 1 số bản vẽ ghi là D8-150 hoặc Ø8@150, Ø8-150. Vậy có cách nào áp dung hết không hay chỉ xài cho 1 dạng được thôi

 

HSG-AUR-ST-Sheet - 80013 - BASEMENT 03 - BOTTOM REINFORCEMENT PLAN.dwg

Rãnh rỗi luyện tý

(defun C:thaytext(/ ndtexttt cuoi dau vttim ndtex khcach chieudai)
(command "cmdecho" 0)
(setq dtthep (car (entsel "\nChon doi tuong lay chieu dai.")))
(setq chieudai (vlax-curve-getDistAtParam dtthep (vlax-curve-getEndParam dtthep)))
(setq point1 (getpoint "\nChon diem thu 1"))
(setq point2 (getpoint point1 "\nChon diem thu 2"))
(setq khcach (distance point1 point2))
(setq dttext (entsel "\nChon doi tuong text thay the"))
(setq ndtext (cdr (assoc 1 (entget (car dttext)))))
(if (setq vttim (vl-string-search "@" ndtext))
(setq vttim (vl-string-search "@" ndtext))
(setq vttim (vl-string-search "-" ndtext)))
(setq dau (substr ndtext 1 vttim))
(setq cuoi (substr ndtext (+ vttim 1)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq thongtin (entget (car dttext)))
(setq giatricu (assoc 1 thongtin))
(setq giatrimoi (cons 1 (strcat dau "," (rtos chieudai 2 0) "," cuoi "," (rtos khcach 2 0))))
(setq thongtin (subst giatrimoi giatricu thongtin))
(entmod thongtin)
(command "_change" dttext "" "p" "c" "1" "")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(princ)
)

 


<<

Filename: 421210_thaytext.lsp
Tác giả: ToTo08
Bài viết gốc: 102321
Tên lệnh: at2t
Lisp Ghép Text Cần Giúp Đỡ
Cật nhật theo yêu cầu : Nối text theo thứ tự các text được chọn.

(defun c:at2t (/ center color data edata ent i sel ss str);All Text to Text
...
>>
Cật nhật theo yêu cầu : Nối text theo thứ tự các text được chọn.

(defun c:at2t (/ center color data edata ent i sel ss str);All Text to Text
 (defun centerSS (ss / lst_max lst_min maxpt minpt ll ur)
   (vl-load-com)
   (foreach ent (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
     (vla-GetBoundingBox ent 'minpt 'maxpt)
     (setq lst_min (cons (vlax-safearray->list minpt) lst_min)
    lst_max (cons (vlax-safearray->list maxpt) lst_max)  )   )
   (setq ll (list (car (vl-sort (mapcar 'car lst_min) '<))
	   (car (vl-sort (mapcar 'cadr lst_min) '<))  )
  ur (list (last (vl-sort (mapcar 'car lst_max) '<))
	   (last (vl-sort (mapcar 'cadr lst_max) '<)) ) )
   (mapcar '/ (mapcar '+ ll ur) '(2.0 2.0 2.0))    )  

 (defun Change_Str (data pt str color)
   (entmake (list (cons 0 "TEXT") (assoc 8 data) (cons 10 pt)
	   (cons 11 pt) (assoc 7 data) (assoc 40 data)
	   (cons 71 0) (cons 72 1) (cons 73 2)
	   (cons 1 str) (cons 62 color)
	   (if (assoc 6 data)  (assoc 6 data)  '(6 . "BYLAYER") )
	   (if (assoc 39 data) (assoc 39 data) '(39 . 0) )
	   (if (assoc 370 data) (assoc 370 data) '(370 . -1) ) ))  )

 (defun dxf (tag obj) (cdr (assoc tag obj)))
;main
 (or *color* (setq *color* 6 ))
 (setq color (getint (strcat "\nNhap so mau cua Text sau khi hoan thanh <" (itoa *color*) "> :")) )
 (if color (setq *color* color) (setq color *color*))
 (setq ss (ssadd))
 (while (setq sel (entsel "\nChon cac Text can noi voi nhau: "))
   (setq ent (car sel))
   (if (= (cdr (assoc 0 (entget ent))) "TEXT")
     (ssadd ent ss)) )  
 (if (> (sslength ss) 0)
   (progn
     (setq i -1
    str ""
    center (centerSS ss)	    
    data (entget (ssname ss 0))	    )
     (while (setq ent (ssname ss (setq i (1+ i))))
(setq edata (entget ent)
      str (strcat str " " (dxf 1 edata))  )
(entdel ent)	)
     (Change_Str data center (substr str 2) color)     )
   (princ "\nKhong chon duoc Text !"))
 (princ))

 

Lisp chạy rất ổn, cám ơn bạn.


<<

Filename: 102321_at2t.lsp
Tác giả: nguyenphuocgtvt
Bài viết gốc: 334080
Tên lệnh: goc
LISP xuất lần lược các góc của tuyến

 

Theo tôi bạn nên vẽ tuyến đó bằng PLINE (hoặc dùng Lisp nối các Line rời rạc đó thành PLINE) rồi dùng Lisp dưới...

>>

 

Theo tôi bạn nên vẽ tuyến đó bằng PLINE (hoặc dùng Lisp nối các Line rời rạc đó thành PLINE) rồi dùng Lisp dưới đây.

http://www.cadviet.com/upfiles/3/71162_lisp_thong_ke_goc_cua_pline.lsp

;==========LISP THONG KE GOC CUA PLINE==========
;=============KANGKUNG 18/04/2013===============
(defun C:Goc ( / i plsel pldata verts bend)
  (vl-load-com)
  (setq bendlist(list))
  (while (not (setq plsel (ssget '((0 . "LWPOLYLINE,POLYLINE"))))))
  (setq pldata (entget (ssname plsel 0)) verts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) pldata)))
  (setq i 1)
  (while (> (length verts) 2)
    (setq ang1 (angle (car verts) (cadr verts)) ang2 (angle (cadr verts) (caddr verts))
	  bend (if (> (abs (- ang2 ang1)) pi)
		 (+ (min ang1 ang2) (- (* pi 2) (max ang1 ang2)))
		 (abs (- ang2 ang1)))
	  bendlist (append bendlist (list (strcat "\nGoc " (itoa i) ": " (rtos (- pi bend)))))
	  verts (cdr verts)
	  i(1+ i))
    )
  (foreach x bendlist (princ (strcat x " ")))
  (princ)
)
(princ "\n              KangKung - 18/04/2013\n")
(princ "\n           Nhap GOC de chay chuong trinh\n")

Mình có dùng thử lisp này, rất hay, nhưng bạn có thể cho mình kết quả chính xác hơn không? Lisp này chỉ xuất được 2 số phần thập phân, nên khi chuyển sang độ phút giây nó sai khá nhiều. Bạn có thể điều chỉnh thành 6 số sau phần thập phân được không? Mà nếu có lip xuất độ phút giây luôn thì càng tốt. Cảm ơn


<<

Filename: 334080_goc.lsp
Tác giả: haanh
Bài viết gốc: 56453
Tên lệnh: stext
Líp giãn dòng text.

Em xin cám ơn anh rất rất nhiều vì anh đã cung cấp cho em cái lisp của bác Hoành:

 

lisp dưới đây tên lệnh vẫn là STEXT, cải tiến để người sử...
>>

Em xin cám ơn anh rất rất nhiều vì anh đã cung cấp cho em cái lisp của bác Hoành:

 

lisp dưới đây tên lệnh vẫn là STEXT, cải tiến để người sử dụng nhập thêm tỷ lệ khoảng cách dòng. Mặc định là 1.5 tức là khoảng trống cách giữa 2 dòng bằng 1.5 lần chiều cao text. Giá trị này sẽ được lưu trữ cho đến khi close file, nhấn Enter lúc nhập liệu nếu không muốn thay đổi giá trị này.

 

(defun c:stext ( / sst lstent egoc pgoc xgoc yht zgoc linespc ee tt)
 (if (not tyledong)
   (setq tyledong 1.5)
 )
 (princ "\nSap xep text © CADViet.com")
 (setq	sst	(ssget '((0 . "TEXT")))
lstent	(ss2ent sst)
tmp     (getreal (strcat "\nVao ty le dong khoang cach dong <" (rtos tyledong 2 2) ">: "))
tyledong (cond
	   (tmp tmp)
	   (t tyledong)
	 )
lstent	(vl-sort lstent
		 '(lambda (e1 e2)
		    (> (cadr (cdr (assoc 10 (entget e1))))
		       (cadr (cdr (assoc 10 (entget e2))))
		    )
		  )
	)
egoc	(car lstent)
lstent	(cdr lstent)
pgoc	(cdr (assoc 10 (entget egoc)))
xgoc	(car pgoc)
yht	(cadr pgoc)
zgoc	(caddr pgoc)
hgoc	(cdr (assoc 40 (entget egoc)))
linespc	(* hgoc (+ 1.0 tyledong))

 )
 (foreach ee lstent
   (setq tt (entget ee)
  tt (subst (list 10
		  xgoc
		  (setq yht (- yht linespc))
		  zgoc
	    )
	    (assoc 10 tt)
	    tt
     )
   )
   (entmod tt)
   (entupd ee)
 )
)
(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)
 (princ)
)
(princ
 "\nSTEXT - Sap xep text - free lisp from www.cadviet.com"
)
(vl-load-com)


<<

Filename: 56453_stext.lsp
Tác giả: longbyoongho
Bài viết gốc: 206011
Tên lệnh: tdn
Lisp thống kê tọa độ TDN.lisp
Bạn dùng thử xem sao
 ;; free lisp from cadviet.com ;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=12702...
>>
Bạn dùng thử xem sao
 ;; free lisp from cadviet.com ;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=12702 (prompt"\n - THONG KE TOA DO by Thaistreetz - huuthais@yahoo.com\n") ---------------------------------------------- (defun C:tdn () (setvar "cmdecho" 0 ) (command "Undo" "Begin") (setq om (getvar "osmode")) (if (not h) (setq h 1)) (setq caot1 (getreal (strcat "\nCao text < " (rtos h 2 2) " >:"))) (if caot1 (setq h caot1)) (setq tapx '() tapy '() stt '()) (setq bit1 (cond (bit1) ("Yes"))) (initget "Yes No") (setq Tmp1 (strcat "\nTu dong ghi ten nut?  <" bit1 ">: ") bit1 (cond ((getkword Tmp1)) (bit1))) (if (eq bit1 "Yes") (progn (setq ten (getstring "\nTen Nut:")) (if (not i) (setq i 1)) (setq i1 (getreal (strcat"\nSTT cua nut bat dau < " (rtos i 2 0) " >: "))) (if i1 (setq i i1)) (setvar "osmode" 125) (setq lacol (getvar "CEColor") k (- i 1)) (While (setq D1 (getpoint (strcat"\nPick diem thu "(rtos (+ k 1) 2 0)""))) (Progn (setvar "osmode" 0) (setq DX (getpoint (strcat"\nDiem dat text thu "(rtos (+ k 1) 2 0)"") D1) DY (getpoint (strcat"\nHuong goc nghieng cua text "(rtos (+ k 1) 2 0)"") Dx) angr (angle Dx Dy) angd (/ (* 180 angr) pi) x (rtos (car D1) 2 4) y (rtos (cadr D1) 2 4) TX (strcat "X:"(rtos (Car D1) 2 4)) TY (strcat "Y:"(rtos (Cadr D1) 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 (setq dt (* 0.5 (- (strlen N) 2) h));;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (if (>= (car DY) (car DX)) (progn (setq D2 (polar Dx angr (* 0.7 h))) (command "text" "BL" D2 h angd tX) (setq TB (textbox (entget(entlast))) LC (car TB) RC (cadr TB) di (distance LC RC) PT3 (polar D2 angr (+ di (* 0.4 h))) pt4 (polar D2 (- angr (* pi 0.5)) (* 1.35 h)) pt5 (polar pt4 angr di) C (polar PT3 0 (* 1.5 h)) );setq (command "text" "F" PT4 PT5 h ty "pline" D1 DX PT3 "" "circle" (polar PT3 angr (+ (* 1.5 h ) dt)) (+ (* 1.5 h) dt) "text" "m" (polar PT3 angr (+ (* 1.5 h) dt )) h angd N "CECOLOR" 8 "circle" (polar PT3 angr (+ (* 1.5 h) dt)) (+ (* 1.35 h) dt) );command (setvar "CECOLOR" lacol) );progn );if (if (< (car DY) (car DX)) (progn (setq D2 (polar Dx angr (* 0.7 h))) (command "text" "BR" D2 h (+ angd 180) tx) (setq TB (textbox (entget(entlast))) LC (car TB) RC (cadr TB) di (distance LC RC) PT3 (polar D2 angr (+ di (* 0.4 h))) pt4 (polar D2 (+ angr (* pi 0.5)) (* 1.35 h)) pt5 (polar pt4 angr di) C (polar PT3 0 (* 1.5 h)) );setq (command "text" "F" PT5 PT4 h TY "pline" D1 DX PT3 "" "circle" (polar PT3 angr (+ (* 1.5 h) dt)) (+ (* 1.5 h) dt) "text" "m" (polar PT3 angr (+ (* 1.5 h) dt)) h (+ angd 180) N "CECOLOR" 8 "circle" (polar PT3 angr (+ (* 1.5 h) dt)) (+ (* 1.35 h) dt) );command (setvar "CECOLOR" lacol) );progn );if );progn (setvar "osmode" 125) );while (setq i (+ k 1)) );progn );if (if (eq bit1 "No") (progn (setvar "osmode" 125) (setq lacol (getvar "CEColor") i 1 k (- i 1)) (While (setq D1 (getpoint (strcat"\nPick diem thu "(rtos (+ k 1) 2 0)""))) (Progn (setvar "osmode" 0) (progn (setq LOOP T) (while (= LOOP T) (while (null (setq ten (nentsel "\nChon mot text lam ten nut: "))) (princ "\nChua tim thay doi tuong la text, chon lai !"));while (setq Source_text (entget (car ten))) (if (or (= (cdr (assoc '0 Source_text)) "TEXT") (= (cdr (assoc '0 Source_text)) "MTEXT") (= (cdr (assoc '0 Source_text)) "ATTRIB"));or (progn (setq N (cdr (assoc 1 Source_text))) (setq LOOP nil));progn (progn (princ "Phai chon mot text lam ten nut !") (setq LOOP T));progn )if );while );progn (setq DX (getpoint (strcat"\nDiem dat text cua nut "N"") D1) DY (getpoint (strcat"\nHuong goc nghieng cua text") Dx) angr (angle Dx Dy)) (setq angd (/ (* 180 angr) pi) x (rtos (car D1) 2 4) y (rtos (cadr D1) 2 4) TX (strcat "X:"(rtos (Car D1) 2 4)) TY (strcat "Y:"(rtos (Cadr D1) 2 4)) tapx (append tapx (list x)) tapy (append tapy (list y)) k (+ 1 k) stt (append stt (list N)) );setq (setq dt (* 0.5 (- (strlen N) 2) h));;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (if (>= (car DY) (car DX)) (progn (setq D2 (polar Dx angr (* 0.7 h))) (command "text" "BL" D2 h angd tX) (setq TB (textbox (entget(entlast))) LC (car TB) RC (cadr TB) di (distance LC RC) PT3 (polar D2 angr (+ di (* 0.4 h))) pt4 (polar D2 (- angr (* pi 0.5)) (* 1.35 h)) pt5 (polar pt4 angr di) C (polar PT3 0 (* 1.5 h)) );setq (command "text" "F" PT4 PT5 h ty "pline" D1 DX PT3 "" "circle" (polar PT3 angr (+ (* 1.5 h) dt)) (+ (* 1.5 h) dt) "text" "m" (polar PT3 angr (+ (* 1.5 h) dt)) h angd N "CECOLOR" 8 "circle" (polar PT3 angr (+(* 1.5 h) dt)) (+ (* 1.35 h) dt) );command (setvar "CECOLOR" lacol) );progn );if (if (< (car DY) (car DX)) (progn (setq D2 (polar Dx angr (* 0.7 h))) (command "text" "BR" D2 h (+ angd 180) tx) (setq TB (textbox (entget(entlast))) LC (car TB) RC (cadr TB) di (distance LC RC) PT3 (polar D2 angr (+ di (* 0.4 h))) pt4 (polar D2 (+ angr (* pi 0.5)) (* 1.35 h)) pt5 (polar pt4 angr di) C (polar PT3 0 (* 1.5 h)) );setq (command "text" "F" PT5 PT4 h TY "pline" D1 DX PT3 "" "circle" (polar PT3 angr (+ (* 1.5 h) dt)) (+ (* 1.5 h) dt) "text" "m" (polar PT3 angr (+ (* 1.5 h) dt)) h (+ angd 180) N "CECOLOR" 8 "circle" (polar PT3 angr (+ (* 1.5 h) dt)) (+ (* 1.35 h) dt) );command (setvar "CECOLOR" lacol) );progn );if );progn (setvar "osmode" 125) );while (setq i (+ k 1)) );progn );if (setq bit (cond (bit) ("Yes"))) (initget "Yes No") (setq Tmp (strcat "\nXuat bang toa do?  <" bit ">: ") bit (cond ((getkword Tmp)) (bit))) (if (eq bit "Yes") (progn (setq di (- di (* 0.4 h)) kc (* 2 di) PT (getpoint"\nVi tri dat bang") PTC (list (+ (* 2 kc) (- di h h h h) (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) (- 0 h) (car PTD)) (cadr PTD)) PTY (list (+ kc (- h h h h) (car PTX)) (cadr PTX)) p11 (list (+ (/ di 2) (car p1)) (+ (* 1.1 h) (cadr p1))) p22 (list (+ di (/ di 2) (- 0 h) (car p11)) (- (cadr p11) (* 0.1 h))) p33 (list (+ kc (- h h h h) (car p22)) (cadr p22)) L1 (list (+ di (car p3))(cadr p3)) L2 (list (+ kc (- 0 h h)(car L1))(cadr L1)) PTB (list (+ (- (* 2 h)) (* 0.5 (+ (* 2 kc) di)) (car PT)) (+ (cadr P3) (* 1.8 h))) n (length tapx) k 0 );setq (setvar "osmode" 0) (command "CECOLOR" 3 "line" p1 p2 "" "line" p3 p4 "" "CECOLOR" 2 "text" "m" p11 h 0 "Ten diem" "text" "m" p22 h 0 "Toa do X" "text" "m" p33 h 0 "Toa do Y" "text" "m" pTB (* 1.3 h) 0 "%ºng thong ke toa do diem") (while (< k n) (setq xx (nth k tapx) yy (nth k tapy) tstt(nth k stt)) (command "CECOLOR" 2 "text" "m" PTD h 0 tstt "text" "m" PTX h 0 xx "text" "m" PTY h 0 yy "CECOLOR" 3 "line" PT PTC "") (setq PT (list (car PT) (- (cadr PT)(* 2 h))) PTC (list (+ (* 2 kc) (- di h h h h) (car PT)) (cadr PT)) PTD (list (+ (/ di 2) (car PT)) (+ h (cadr PT))) PTX (list (+ di (/ di 2) (- 0 h) (car PTD)) (cadr PTD)) PTY (list (+ kc (- h h h h) (car PTX)) (cadr PTX)) k (+ 1 k));setq );while (if (= k n) (setq PT (list (car PT) (+ (cadr PT)(* 2 h))) PTC (list (+ (* 2 kc) (- di h h h h) (car PT)) (cadr PT)) L11 (list (+ di (car PT))(cadr PT)) L22 (list (+ kc (- 0 h h) (car L11))(cadr L11)) );setq );if (command "CECOLOR" 3 "line" p3 PT "" "line" p4 PTC "" "line" L1 L11 "" "line" L2 L22 "") );progn );if (setvar "CECOLOR" lacol) (setvar "osmode" om) (prompt"\n by Thaistreetz - huuthais@yahoo.com\n") (command "Undo" "End") (setvar "cmdecho" 1) (princ) );DONG toa do 

Trong đó có dòng (setq dt (* 0.5 (- (strlen N) 2) h)) để điểu chỉnh độ to của vòng tròn theo chiều dài tên Nút Nếu muốn bạn có thể sửa lại. Bạn dùng thử và phản hồi lại nhé!!

 

Bạn có thể thêm dòng chọn "chọn số chữ số thập phân" được không vì đôi khi có những bản vẽ chỉ cần chính xác đến 3 chữ số đằng sau dấu "," thôi. Thanks :D


<<

Filename: 206011_tdn.lsp
Tác giả: xaydung
Bài viết gốc: 10042
Tên lệnh: gdi
lisp lấy ra giá trị dim overall và dim linear!
Lệnh là GDI (get dim information).

 

(defun c:gdi (/ str ent)
 (setq	ent (car (entsel "\nHay chon dim: "))
str (strcat "DIMEXE: "
	    (rtos (getdimcode ent 40) 2...
>>
Lệnh là GDI (get dim information).

 

(defun c:gdi (/ str ent)
 (setq	ent (car (entsel "\nHay chon dim: "))
str (strcat "DIMEXE: "
	    (rtos (getdimcode ent 40) 2 2)
	    " | DIMSCALE: "
	    (rtos (getdimcode ent 44) 2 2)
    )
 )
 (wtxt str (getpoint "\nVao diem chen ket qua: "))
 (princ)
)

(defun getdimcode (ent code / tt data ovs ext kq)
 (setq
   tt (entget ent '("ACAD"))
   kq (member (cons 1070 code) (cadr (assoc -3 tt)))
 )
 (if kq
   (cdr (car (cdr kq)))
   (cdr (assoc code (tblsearch "DIMSTYLE" (cdr (assoc 3 tt)))))
 )
)

(defun wtxt (txt p / sty d h)
 (setq
   sty	(getvar "textstyle")
   d	(tblsearch "style" sty)
   h	(cdr (assoc 40 d))
 )
 (entmake (list (cons 0 "TEXT")
	 (cons 7 sty)
	 (cons 1 txt)
	 (cons 10 p)
	 (if (> h 0)
	   (cons 40 h)
	   (assoc 40 d)
	 )
	 (assoc 41 d)
   )
 )
)

thanks anh Hoanh, dimexe thì đúng rồi, nhưng cái dimscale hiện trên màn hình chưa đúng anh à, anh sủa cho em chút nữa được không ạ, nó chính là cái : khi anh vô Ctrl+1 hiện bảng ở phần primary units --> dim scale linear đó (mặc định là 1)

kết quả màn hình là :dimexe :1.00 dimscale : 1.00 !


<<

Filename: 10042_gdi.lsp
Tác giả: NguyenNgocSon
Bài viết gốc: 164623
Tên lệnh: kdg
Nhờ các bác viết lisp vẽ đường dóng trắc ngang

Của bạn đây. CHo phép bạn chọn 1 đường chuẩn L2 và nhiều đường cần kẻ gióng L1 :

(defun c:kdg(/ dxf...
>>

Của bạn đây. CHo phép bạn chọn 1 đường chuẩn L2 và nhiều đường cần kẻ gióng L1 :

(defun c:kdg(/ dxf ST:Ss->ListEnt ST:Entmake-Line ssLine curve-obj)
(vl-load-com)
(grtext -1 "Free Lisp from CADVIET @Ketxu")
;;;;===== Local Functions =======
(defun dxf (code ent)(cdr (assoc code (entget ent))))
(defun ST:Ss->ListEnt (ss / n e l)
 (setq n (sslength ss))
 (while (setq e (ssname ss (setq n (1- n))))(setq l (cons e l))))
(defun ST:Entmake-Line (pt1 pt2)(entmake (list (cons 0 "LINE")(cons 10 pt1)(cons 11 pt2)(cons 62 1)))) 

;;;;======= Start Here =========
(setq curve-obj (vlax-ename->vla-object (car (entsel "\nCh\U+1ECDn \U+0111\U+01B0\U+1EDDng chu\U+1EA9n (L2) :"))))
(prompt "\nCh\U+1ECDn c\U+00E1c \U+0111\U+01B0\U+1EDDng c\U+1EA7n v\U+1EBD \U+0111\U+01B0\U+1EDDng gi\U+00F3ng (L1) : ")
(setq ssLine (ST:Ss->ListEnt(ssget (list (cons 0 "LINE")))))
(foreach Line ssLine
	(ST:Entmake-Line (dxf 10 Line) (vlax-curve-getClosestPointTo curve-obj (dxf 10 Line)))
	(ST:Entmake-Line (dxf 11 Line) (vlax-curve-getClosestPointTo curve-obj (dxf 11 Line)))
))

Ketxu có thể code lại lisp trên theo ý của mình như file sau được không: My link

Tương tự lisp trên nhưng đường L1 là Polyline, lisp sẽ vẽ đường gióng tại các điểm của polyline tới đường L2!

Thân !


<<

Filename: 164623_kdg.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 420962
Tên lệnh: mr
LISP đối xứng đối tượng

Nè vua làm biếng!

	(defun C:MR()
 (command "mirror" (ssget) "" (setq p (getpoint "\nPick point: ")) (list (+ (car p) 1.0) (cadr p)) "y") (princ))
	


Filename: 420962_mr.lsp
Tác giả: quocloc213
Bài viết gốc: 218040
Tên lệnh: ha
Lisp tính tổng độ dài đoạn thẳng.

Viết nhanh cho bạn đây.


;Doan Van Ha - CADViet.com - Ngay 13/10/2012
;Muc dich: Tinh tong chieu dai cac doi tuong, ghi...
>>

Viết nhanh cho bạn đây.


;Doan Van Ha - CADViet.com - Ngay 13/10/2012
;Muc dich: Tinh tong chieu dai cac doi tuong, ghi len text, ghi ra file.
(defun C:HA ( / tl lst ss entlst cdai a z)
(vl-load-com)
(setq tl (getreal "\nHe so ti le: "))
(while
 (and
  (princ "\nChon cac doi tuong can tinh chieu dai...")
  (setq ss (ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE")))))
 (setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
 (setq cdai 0)
 (foreach ent entlst
  (setq cdai (+ cdai (/ (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)) tl))))
 (setq a (assoc 1 (entget (setq ent (car (entsel "Chon Text de nhap chieu dai..."))))))
 (entmod (subst (cons 1 (rtos cdai 2 2)) a (entget ent)))
 (setq lst (cons cdai lst)))
(if (not ss)
 (progn
  (initget "Y N")
  (setq ghi (getkword "\nBan muon luu file khong? <Y>: "))
  (if (or (= ghi "Y") (= ghi nil))
   (progn
(setq fn (getfiled "Chon file de xuat ket qua" "" "txt" 1))
(setq pw (open fn "w"))
(setq z 0 lst (reverse lst))
(repeat (length lst)
     (princ (strcat "Tong " (itoa (1+ z)) " = " (rtos (nth z lst) 2 2) "\n") pw)
     (setq z (1+ z)))
(close pw)))))
(princ))

P/S: bổ sung 17h-13/10/2012

Thanks vì Lisp hay.

Nhưng mình ko thể sử dụng trên cad (Mac OSX). Bạn có thể giúp mình được không. Thanks.

https://www.sugarsync.com/pf/D9227121_60624047_665865


<<

Filename: 218040_ha.lsp
Tác giả: hoquangvinh
Bài viết gốc: 386877
Tên lệnh: ha
Lisp tính tổng độ dài đoạn thẳng.

Viết nhanh cho bạn đây.

 
;Doan Van Ha - CADViet.com - Ngay 13/10/2012
;Muc dich: Tinh tong chieu dai...
>>

Viết nhanh cho bạn đây.

 
;Doan Van Ha - CADViet.com - Ngay 13/10/2012
;Muc dich: Tinh tong chieu dai cac doi tuong, ghi len text, ghi ra file.
(defun C:HA ( / tl lst ss entlst cdai a z)
(vl-load-com)
(setq tl (getreal "\nHe so ti le: "))
(while
  (and
   (princ "\nChon cac doi tuong can tinh chieu dai...")
   (setq ss (ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE")))))
  (setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
  (setq cdai 0)
  (foreach ent entlst
   (setq cdai (+ cdai (/ (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)) tl))))
  (setq a (assoc 1 (entget (setq ent (car (entsel "Chon Text de nhap chieu dai..."))))))
  (entmod (subst (cons 1 (rtos cdai 2 2)) a (entget ent)))
  (setq lst (cons cdai lst)))
(if (not ss)
  (progn
   (initget "Y N")
   (setq ghi (getkword "\nBan muon luu file khong? <Y>: "))
   (if (or (= ghi "Y") (= ghi nil))
    (progn
 	(setq fn (getfiled "Chon file de xuat ket qua" "" "txt" 1))
 	(setq pw (open fn "w"))
 	(setq z 0 lst (reverse lst))
 	(repeat (length lst)
      (princ (strcat "Tong " (itoa (1+ z)) " = " (rtos (nth z lst) 2 2) "\n") pw)
      (setq z (1+ z)))
 	(close pw)))))
(princ))
P/S: bổ sung 17h-13/10/2012

 

e muốn thêm một tí bổ sung vào lisp nay của bác Ha

sau khi chọn text và điền giá trị vào e muốn đổi màu của text đó

VD màu 6: (command "_change" en "" "p" "c" "6" "") nhưng e ko biết để nó vào đâu

mong mọi người hỗ trợ


<<

Filename: 386877_ha.lsp
Tác giả: nhantony
Bài viết gốc: 324333
Tên lệnh: ckc
LISP tự động cộng liên tiếp khoảng cách giữa các điểm bất kỳ

 

- oh vậy là hơi giống bên nhoc ^^, 2 điểm = 100 bạn đó nói chắc đc phóng lên theo tile 1/500 rùi tương đương 2lần , giờ...

>>

 

- oh vậy là hơi giống bên nhoc ^^, 2 điểm = 100 bạn đó nói chắc đc phóng lên theo tile 1/500 rùi tương đương 2lần , giờ bạn ấy mún đo lấy kích thước thật = 50 tương đương tile 1/1000, nhoc nghĩ vậy ko biết đúg ko ^^

- bạn thử xem

(defun c:ckc(/ po1 po2 oldim tp S te ent x)
(setq oldim (getvar "DIMZIN"))
(setvar "DIMZIN" 0)
(setq ttl (getvalueK ttl 500.0 "Nhap ti le ban ve 1 / "))
(setq x (/ 1000.0 ttl))
(if (not tpo) (setq tpo 0))
(setq tp (getint (strcat "\n So chu so thap phan <" (rtos tpo 2 0) ">:")))
(if (not tp) (setq tp tpo) (setq tpo tp))
(setq po1 (getpoint "\n Pick diem dau :"))

(while
(setq po2
(getpoint po1 "\n Pick diem tiep theo de tinh khoang cach/ Enter de ket thuc :"))
(setq S (/ (distance po1 po2) x) po1 po2)
(while (null (setq ent (entsel "\n Pick vao TEXT :")))
(setq ent (entsel "\n Pick lai vao TEXT :"))
)
(setq te (entget (car ent)))
(setq te (entmod(subst(cons 1 (rtos S 2 tp)) (assoc 1 te) te)))
)
(setvar "DIMZIN" oldim)
(princ)
)
;===
;; ham luu gia tri
(defun getvalueK ( 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 1) ") :")))(a))))
	((= (type a) 'STR) (setq a (cond ((= "" (setq astr (getstring T (strcat "\n" dongnhac " (" a "): ")))) a) (astr))))
))
;;;;

Cảm ơn nhóc đúng như cái mình cần thank you very much :)


<<

Filename: 324333_ckc.lsp
Tác giả: babaria333
Bài viết gốc: 418804
Tên lệnh: tt
Lisp Hỗ Trợ Tính Toán Khối Lượng Trên Bản Vẽ

Lsp ở đây:

(defun c:tt (/ Text mid_point FixTextAngle ||| ang dis hei mid poi pt ptt sty tal)

(defun Text...

>>

Lsp ở đây:

(defun c:tt (/ Text mid_point FixTextAngle ||| ang dis hei mid poi pt ptt sty tal)

(defun Text (pt hgt str ang sty)

(entmakex (mapcar '(lambda (x y) (cons x y))

'(0 7 10 40 50 1 72 11 73)

(list "TEXT" sty pt hgt ang str 1 pt 2))))

(defun mid_point (p1 p2) (mapcar '(lambda (x y) (* (+ x y) 0.5)) p1 p2))

(defun FixTextAngle (ang)

(if (and (> ang (* 0.5 pi)) (<= ang (* 1.5 pi)))

(+ ang pi)

ang))

(setq hei 250 ;Thay doi chieu cao chu o day

tal 0

sty (getvar 'TEXTSTYLE))

(if (setq poi (getpoint "\nChon diem: "))

(progn (while (setq ptt (getpoint "\nChon diem tiep theo: " poi))

(setq dis (distance poi ptt)

ang (FixTextAngle (angle poi ptt))

mid (mid_point poi ptt))

(Text (polar mid (+ ang (* 0.5 pi)) hei) hei (rtos dis 2 0) ang sty); 0 -> so chu so thap phan

(setq tal (+ tal dis))

(setq poi ptt))

(and (> tal 0)

(setq pt (getpoint "\nChon diem chen text: "))

(Text pt hei (rtos tal 2 0) 0 sty))));(rtos tal 2 0) 0-> so chu so thap phan

(princ))

bác giải thích hộ em với được không ạ, làm sao để chèn thêm chữ vào text nữa, VD: bình thường ra kết quả là 500 thì thành L1=500


<<

Filename: 418804_tt.lsp
Tác giả: phamngoctukts
Bài viết gốc: 136461
Tên lệnh: trudim
Lisp cộng Dimension

Trước em thấy có lisp Congdim mà giờ không tìm thấy, em chỉ tìm thấy cái này

(defun c:Trudim(/ ss n i S duyet ent...
>>

Trước em thấy có lisp Congdim mà giờ không tìm thấy, em chỉ tìm thấy cái này

(defun c:Trudim(/ ss n i S duyet ent sst nt j St duyett entt Skq) (prompt "\n Chon cac Dim lam so bi tru :") (setq ss (ssget '((0 . "DIMENSION")))) (prompt "\n Chon cac Dim lam so tru :") (setq sst (ssget '((0 . "DIMENSION")))) (setq n (sslength ss) i 0 S 0 duyet 0) (setq nt (sslength sst) j 0 St 0 duyett 0) (while (< i n) (setq ent (entget(ssname ss i))) (if (= (cdr(assoc 1 ent)) "") (setq duyet (cdr(assoc 42 ent))) (setq duyet (atof(cdr(assoc 1 ent)))) ) (setq S (+ S duyet)) (setq i (1+ i)) ) (while (< j nt) (setq entt (entget(ssname sst j))) (if (= (cdr(assoc 1 entt)) "") (setq duyett (cdr(assoc 42 entt))) (setq duyett (atof(cdr(assoc 1 entt)))) ) (setq St (+ St duyett)) (setq j (1+ j)) ) (setq Skq (- S St)) (alert (rtos Skq 2 0)) (princ) ) 

Ai có lisp congdim cho em xin với.

Cảm ơn!

Bạn thay dòng này:

(setq Skq (- S St)) thành (setq Skq (+ S St))


<<

Filename: 136461_trudim.lsp
Tác giả: Minh Kiên
Bài viết gốc: 312756
Tên lệnh: tdn
Lisp ghi tọa độ rất hay mà bị lỗi!

 

Code của bạn đây. hi vọng nó đúng ý bạn.

(prompt"\n - THONG KE TOA...
>>

 

Code của bạn đây. hi vọng nó đúng ý bạn.

(prompt"\n - THONG KE TOA DO\n")----------------------------------------------(defun C:tdn () (prompt"\nTHONG KE TOA DO\n")(setvar "cmdecho" 0 )(command "Undo" "Begin")  (setq om (getvar "osmode"))(setq tapx '() tapy '() stt '()      ten (getstring "\nTên Nút:"))(if (not h) (setq h 1))(if (not i) (setq i 1))(setq i1  (getreal (strcat"\nSTT Nút Ðâu Tiên < " (rtos i 2 0) " >: "))    caot1 (getreal (strcat "\nCao text < " (rtos h 2 0) " >:")))(if i1 (setq i i1))(if caot1 (setq h caot1))(setvar "osmode" 125)(setq lacol (getvar "CEColor") k (- i 1));================================================(While(setq D1 (getpoint (strcat"\nPick diem thu "(rtos (+ k 1) 2 0)"")))(Progn  (setvar "osmode" 0)  (setq DX (getpoint (strcat"\nDiem dat text thu "(rtos (+ k 1) 2 0)"") D1)        x   (rtos (car D1) 2 4)        y   (rtos (cadr D1) 2 4)	TX (strcat "X:"(rtos (Car D1) 2 4))	TY (strcat "Y:"(rtos (Cadr D1) 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 (>= (car DX) (car D1)) 	(progn	(setq D2 (list (+ (car DX) (* 0.5 h)) (cadr DX)))	       	(command "text" "BL" D2 h 0 tX)  	(setq   TB  (textbox (entget(entlast)))    		LC  (car TB)   		RC  (cadr TB)    		di  (distance LC RC)		PT3 (polar D2 0 (+ di (* 0.6 h)))		pt4 (list (car D2) (- (cadr D2) (* 1.35 h)))		pt5 (list (+ (car D2) di) (- (cadr D2) (* 1.35 h)))				C   (polar PT3 0 (* 1.5 h))  	);setq  	(command "text" "F" PT4 PT5 h ty           	 "pline" D1 DX PT3 ""           	 "circle" (polar PT3 0 (* 1.5 h)) (* 1.5 h)           	 "circle" (polar PT3 0 (* 1.5 h)) (* 1.35 h)           	 "text" "m" (polar PT3 0 (* 1.5 h)) h 0 N            	 "CECOLOR" 8		 "circle" (polar PT3 0 (* 1.5 h)) (* 1.35 h)  	  );command	  (setvar "CECOLOR" lacol)	);progn   );if  (if (< (car DX) (car D1)) 	(progn	  (setq D2 (list (- (car DX) (* 0.5 h)) (cadr DX)))	     	  (command "text" "BR" D2 h 0 tx)  	  (setq   TB  (textbox (entget(entlast)))    		  LC  (car TB)   		  RC  (cadr TB)    		  di  (distance LC RC)		  PT3 (polar D2 0 (- (+ di (* 0.6 h))))		  pt4 (list (- (car D2) di) (- (cadr D2) (* 1.35 h)))		  pt5 (list (car D2) (- (cadr D2) (* 1.35 h)))		  PT6 (list (- (car PT3) (* 3 h)) (cadr PT3))		  C   (polar PT3 0 (* 1.5 h))  	  );setq  	  (command "text" "F" PT4 PT5 h TY           	   "pline" D1 DX PT3 ""           	   "circle" (polar PT6 0 (* 1.5 h)) (* 1.5 h)           	   "text" "m" (polar PT6 0 (* 1.5 h)) h 0 N            	   "CECOLOR" 8		   "circle" (polar PT6 0 (* 1.5 h)) (* 1.35 h)  	  );command	  (setvar "CECOLOR" lacol)	);progn   );if);progn(setvar "osmode" 125));while(setq i (+ k 1));=============================================(setq bit (cond (bit) ("Yes")))(initget "Yes No")(setq	Tmp (strcat "\nXuât Bang Toa Ðô?  <" bit ">: ")	bit (cond ((getkword Tmp)) (bit)))(if (eq bit "Yes")(progn(setq	di (- di (* 1.7 h))	kc (* 2 di)        PT (getpoint"\nVi tri dat bang")    	PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))	PTCc (list (+ (* 1.5 kc) (car PTC)) (cadr PT))      	p1 (list (car PT) (+ (cadr PT)(* 2 h)))      	p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))	p2c (list (+ (* 1.5 kc) (car P2)) (cadr p2))      	p3 (list (car p1) (+ (cadr p1)(* 2 h)))      	p4 (list (car p2) (+ (cadr p2)(* 2 h)))	p4c (list (+ (* 1.5 kc) (car P4)) (cadr p4))     	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))	p44 (list (+ (* kc 0.75) (car p4)) (cadr p22))      	L1 (list (+ di (car p3))(cadr p3))      	L2 (list (+ kc (car L1))(cadr L1))	L3 (list (+ (* 1.5 kc) (car p4)) (cadr p4))	PTB (list (+ (* 0.5 (+ (* 2 kc) (* 1.5 kc) di)) (car PT)) (+ (cadr P3) (* 1.8 h)))     	n (length tapx)     	k 0);setq(setvar "osmode" 0)(command "CECOLOR" 3 "line" p1 p2c "" "line" p3 p4c "" "CECOLOR" 2       	"text" "m" p11 h 0 "STT"        	"text" "m" p22 h 0 "Täa ®é X"        	"text" "m" p33 h 0 "Täa ®é Y"	"text" "m" p44 h 0 "Ghi chó"       	"text" "m" pTB (* 1.3 h) 0 "%¶ng thèng kª täa ®é nót")    (while (< k n) (setq xx (nth k tapx) yy (nth k tapy) tstt(nth k stt))(command "CECOLOR" 2	 "text" "m" PTD h 0 tstt          "text" "m" PTX h 0 xx          "text" "m" PTY h 0 yy	 "CECOLOR" 3          "line" PT PTCc "")    (setq 	PT (list (car PT) (- (cadr PT)(* 2 h)))	PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))	PTCc (list (+ (* 1.5 kc) (car ptc)) (cadr ptc))	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));setq);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))	L33 (list (+ (* 1.5 kc) (car PTC)) (cadr PTC)) );setq);if(command "CECOLOR" 3 	"line" p3 PT ""	"line" p4 PTC ""	"line" L1 L11 ""	"line" L2 L22 ""	"line" L3 L33 ""));progn);if(setvar "CECOLOR" lacol)(setvar "osmode" om)(prompt"\n by Thaistreetz - huuthais@yahoo.com\n")(command "Undo" "End")(setvar "cmdecho" 1)(princ));DONG toado

Chào bạn,mình đã tìm kiếm trên diễn đàn mấy ngày nay và thấy cái lisp về toạ độ này gần với mong muốn của mình nhất nhưng vẫn còn một vài điểm vẫn chưa đúng lắm bạn có thể chỉnh giúp mình được không:

+Sau khi gõ lệnh: nó sẽ hỏi thêm chọn gốc toạ độ  /chiều cao text/tên nút tự động/số tt/

+Chọn điểm lấy toạ độ (nếu có thể chọn theo cung tròn hay đường tròn để lấy tâm và đường kính sau này xuất ra bảng thì tốt quá) /chọn điểm đặt mà không cần chọn góc nghiêng / tương tự các điểm khác.

+Xuất và đặt bảng toạ độ ra màn hình.OK

+Tại đầu của đường thẳng chỉ vào toạ độ đang lấy có mũi tên hoặc dấu chấm (bằng chiều cao chữ đã chọn) ; phần thập phân của x,y lấy tròn đến chữ số phần trăm (0.01)và x,y này có thể liên kết với điểm tâm (đối tượng chọn để lấy điểm) tránh trường hợp khi update điểm hoặc di chuyển vị trí mà toạ độ không đổi.

Mình rất mong sự phản hồi của bạn,cảm ơn bạn đã tạo ra lisp này.


<<

Filename: 312756_tdn.lsp
Tác giả: gia_bach
Bài viết gốc: 422591
Tên lệnh: byangle
Hỏi cách tách Mtext va đường thẳng về một nhóm
(defun c:ByAngle (/ )
  (vl-load-com)  
  (if (setq ss (ssget '((-4 . "<OR")
			(0 . "LINE")
			(-4 . "<AND") (0 . "LWPOLYLINE") (70 . 0)(-4 . "AND>")
			(0 . "*TEXT")
			(-4 . "OR>"))))    
    (progn
      (setq i 0)
      (setq ss00...
>>
(defun c:ByAngle (/ )
  (vl-load-com)  
  (if (setq ss (ssget '((-4 . "<OR")
			(0 . "LINE")
			(-4 . "<AND") (0 . "LWPOLYLINE") (70 . 0)(-4 . "AND>")
			(0 . "*TEXT")
			(-4 . "OR>"))))    
    (progn
      (setq i 0)
      (setq ss00 (ssadd) ss45 (ssadd) ss90 (ssadd) other (ssadd))
      (repeat (sslength ss)	
	(setq ent (ssname ss i)
	      obj (vlax-ename->vla-object ent)
	      name (vla-get-ObjectName obj) )
	(cond
	  ((wcmatch name "*Text")
	   (setq ang (vla-get-rotation obj)) )
	  ((wcmatch name "AcDbLine")
	   (setq ang (vla-get-angle obj)) )
	  ((wcmatch name "AcDbPolyline")
	   (setq sp (vlax-curve-getstartPoint ent)
		 ep(vlax-curve-getEndPoint ent)
		 ang (angle sp ep)) )
	 )
	(cond
	  ((or (equal ang 0 0.01) (equal ang pi 0.01) )
	   (ssadd ent ss00) )
	  ((or (equal ang (/ pi 2)  0.01) (equal ang (* 3(/ pi 2)) 0.01) )
	   (ssadd ent ss90) )
	  ((or (equal ang (/ pi 4)  0.01) (equal ang (* 3(/ pi 4)) 0.01) )
	   (ssadd ent ss45) )
	  ( t (ssadd ent other))
	  )
      (setq i (1+ i))  )
      (alert (strcat   "So doi tuong co goc bang  0 hay 180 do : " (itoa(sslength ss00))
		     "\nSo doi tuong co goc bang 45 hay 225 do : "(itoa(sslength ss45))
		     "\nSo doi tuong co goc bang 90 hay 270 do : "(itoa(sslength ss90))
		     "\n\nSo doi tuong co goc khac : "(itoa(sslength other))))
      )
    (princ "\n<< No obj selected >>"))
  (princ))

Tham khảo : 

 


<<

Filename: 422591_byangle.lsp
Tác giả: dovananh.xd
Bài viết gốc: 196041
Tên lệnh: ccl
Lisp chuyển Layer về thành Bylayer

Mình đoán mò ý bạn chắc là đổi màu của layer chứa đối tượng được chọn chứ gì. Nếu đúng dùng lisp này.

>>

Mình đoán mò ý bạn chắc là đổi màu của layer chứa đối tượng được chọn chứ gì. Nếu đúng dùng lisp này.

http://duy782006.blo...tuong-chon.html

Lưu ý lisp chỉ chuyển màu của layer thôi nếu đối tượng không phải là bylayer mình không chịu trách nhiệm nhé.

 

 

Tức là đối tượng A đang nằm ở layer "A", ấn 1 -> Chọn đối tượng A -> Layer "A" sẽ mang màu 1 ?

Nếu vậy thì khái niệm Bylayer trong bài toán bạn đưa ra hơi thừa

Ví dụ minh họa ý bạn như sau, bạn xem có phải không :

1 - Không dùng Reactor :

(defun c:ccl (/ m dt la enLa)
(princ "\nChon mau muon doi :")
(setq
 m (acad_colordlg 3)  
 enLa (entget (tblobjname "LAYER" (cdr (assoc 8 (entget (car (entsel "\nChon doi tuong chua layer can doi mau: ")))))))
)
(entmod (subst (cons 62 m) (assoc 62 enLa) enLa))
(princ)
)

Hai lisp này là hoàn toàn giống nhau. Thanks các anh!

 

 

THì Vẫn là "Nếu đổi màu thành ByLayer thì chọn đối tượng rồi chọn màu là Bylayer trên thanh công cụ là được."

 

Lạm dụng vào Lisp nhiều quá thì không có hay.

Anh vẫn chưa hiểu ý của em rồi.

Hì hì, phải nói thế nào để các anh hiểu ý của em nhỉ, hì hì!

Hì hì, ngại quá! ý tưởng này của em là từ lời "thầy bói" của anh Hà mà!

Khi em đọc xong lời thầy bói, tiện thể em đang dùng cái lisp DM, thế là em nghĩ ngay tới cái ý tưởng này

Tuy nhiên dùng một trong hai lisp của anh Ket hoặc của anh Duy là được rồi.


<<

Filename: 196041_ccl.lsp
Tác giả: khaosat2009
Bài viết gốc: 97186
Tên lệnh: rft
lisp Phun tọa độ các điểm từ file txt vào CAD
To : khaosat2009

Rất tiếc, Tui e rằng không đủ thời gian để thực hiện các yêu cầu này.

Nhân đây nhờ các bạn khác giúp khaosat2009...

>>
To : khaosat2009

Rất tiếc, Tui e rằng không đủ thời gian để thực hiện các yêu cầu này.

Nhân đây nhờ các bạn khác giúp khaosat2009 giùm.

 

Bạn chạy thử :

(defun c:RFT(/ data f h line pt spc ten val);Read File Txt
(vl-load-com)
 (defun Split (Str Char / Lst pos)
   (while (setq pos (vl-string-search Char Str))
     (if (null Lst)
(setq Lst (list (substr Str 1 pos)))
(setq Lst (append Lst (list (read (substr Str 1 pos))))))
     (setq Str (substr Str (+ pos 2)) ))
   (setq Lst (append Lst (list (read Str)))))

 (if (setq ten (getfiled "Chon File txt" (getvar "dwgprefix") "txt" 8))
   (progn
     (setq spc (vla-get-ModelSpace (vla-get-ActiveDocument(vlax-get-Acad-Object))))
     (setq h (* (getvar "dimtxt")(getvar "dimscale")))
     (setq f (open (findfile ten) "r"))
     (while (setq Line (read-line f))
(if (vl-string-search "\t" Line)
  (progn
    (setq data (split Line "\t" )
	  val (car data)
	  pt  (cdr data) )
    (if (not(vl-catch-all-error-p (vl-catch-all-apply 'vlax-3d-point pt)))
      (progn
	(vla-addtext spc val (vlax-3d-point pt) h)
	(vla-addpoint spc (vlax-3d-point pt))) ))))  ))
 (princ))

Cám ơn Anh Gia_bach,

Rất mong được sự giúp đỡ chung của các anh chị.

Mong tin


<<

Filename: 97186_rft.lsp
Tác giả: ntson
Bài viết gốc: 40246
Tên lệnh: e2c
Kết hợp Excel-AutoLisp-AutoCAD
Các file *.txt, *.csv có cách tổ chức data khác nhau nhưng bản chất của chúng đều là TextFile (bao gồm các ký tự ASCII, có thể đọc hiểu được một cách tường minh). Với *.xls...
>>
Các file *.txt, *.csv có cách tổ chức data khác nhau nhưng bản chất của chúng đều là TextFile (bao gồm các ký tự ASCII, có thể đọc hiểu được một cách tường minh). Với *.xls thì không phải như vậy. Ví dụ, bạn thử dùng NotePad để open *.xls xem, chỉ thấy một đám ký tự lằng nhằng chẳng hiểu gì cả. Hàm read-line cũng chào thua!

 

AutoLisp "cổ điển" không thể truy xuất *.xls được. Từ khi Autodesk phát triển Visual Lisp (bắt đầu từ version nào ssg không nhớ chính xác, nhưng chắc chắn phải từ 2000 trở đi), kỹ thuật ActiveX được đưa vào, mở ra một khả năng ứng dụng rộng rãi, có thể giao tiếp được với nhiều phần mềm khác nhau, không riêng gì với Excel. Kỹ thuật ActiveX là một mảng rất rộng, có lẽ còn tốn nhiều... giấy mực cho đề tài này. Hãy đợi đấy!

 

Trong Visual Lisp, các function sử dụng kỹ thuật ActiveX được bắt đầu bằng tiếp đầu ngữ VLA. Bạn dùng function GET_xl (lưu ý: luôn luôn phải kèm theo nó function phụ rec-rem-dupl) trong bài ssg trả lời bạn caothang sẽ truy xuất được dữ liệu từ bất kỳ cell nào bạn muốn trong file *.xls. Lưu ý thêm, trước khi gọi các function VLA, bạn phải gọi (vl-load-com) và chỉ cần 1 lần duy nhất trong 1 tài liệu *.dwg đang mở.

Ví dụ:

(defun C:E2C ()
(vl-load-com)
(setq
   fn (getfiled "Select Data File" "" "xls" 0)
   d  (get_xl fn)
)
)

 

Bạn chạy E2C cho file *.xls hôm nọ, kết quả d bạn nhận được là:

Command: E2C

Return:

(("Sheet1$" ("STT" "Ho" "TenDem" "Ten") (1.0 "Kha" "Tran" "Ac") (2.0 "Au" "Duong" "Phong") (3.0 "Hoang" "Duoc" "Su") (4.0 "Hoang" nil "Dung") (5.0 "Quach" nil "Tinh") (6.0 "Hong" "That" "Cong")) ("Sheet2$") ("Sheet3$"))

 

Đây là một list 3 cấp:

- Cấp 1: chứa các sheet

- Cấp 2: chứa các record trong sheet

- Cấp 3: thành phần field trong record

 

Lấy toàn bộ nội dung của sheet1:

Command: (setq s1 (cdr (car d)))

Return:

(("STT" "Ho" "TenDem" "Ten") (1.0 "Kha" "Tran" "Ac") (2.0 "Au" "Duong" "Phong")

(3.0 "Hoang" "Duoc" "Su") (4.0 "Hoang" nil "Dung") (5.0 "Quach" nil "Tinh")

(6.0 "Hong" "That" "Cong"))

 

Cell B4 chẳng hạn (họ của đảo chủ đảo Đào hoa) được lấy như sau:

Command: (nth 1 (nth 3 s1))

Return:

"Hoang"

 

Tương tự như vậy, bạn có thể truy xuất bất kỳ cell nào trong cả file *.xls mà bạn muốn.

Cảm ơn SSG


<<

Filename: 40246_e2c.lsp

Trang 233/330

233