Mình mới thêm nhưng chưa rõ cú pháp như sau có chuẩn không?

(defun C:cop()
 (vl-load-com)
 (setq str (getstring  "\nNh\U+1EADp bi\U+1EC3u th\U+1EE9c gi\U+00E1 tr\U+1ECB Offet <10,2@30,50,...>: "))
   (setq ent   (car (entsel "n\chon block"))
	 p1    (cdr (assoc 10 (entget dt)))
	 p2    (getpoint p1 "\nVao diem den: ")
   );Setq
 (setq lst (apply 'append (mapcar '(lambda(x) (HA:str->lst x "@")) (LM:str->lst str ","))))
 ;(while...
>>

Mình mới thêm nhưng chưa rõ cú pháp như sau có chuẩn không?

(defun C:cop()
 (vl-load-com)
 (setq str (getstring  "\nNh\U+1EADp bi\U+1EC3u th\U+1EE9c gi\U+00E1 tr\U+1ECB Offet <10,2@30,50,...>: "))
   (setq ent   (car (entsel "n\chon block"))
	 p1    (cdr (assoc 10 (entget dt)))
	 p2    (getpoint p1 "\nVao diem den: ")
   );Setq
 (setq lst (apply 'append (mapcar '(lambda(x) (HA:str->lst x "@")) (LM:str->lst str ","))))
 ;(while (setq ent (car (entsel "\nCh\U+1ECDn \U+0111\U+1ED1i t\U+01B0\U+1EE3ng Offset: ")))
  (foreach dis lst
   (setq newobj (vla-copy (vlax-ename->vla-object ent)))
   (vla-move newobj p1 p2)
   (setq ent (entlast)));)
 (princ))

Cám ơn bác nhiều

Sau khi mò mẫm về cơ bản mình sử lý được 70%, còn cái vụ tách @ hàm hay thật

(defun C:dof(/ lstDis obj cc)
;(setq lstDIS '(9 10 -15))
;(setq lstDIS (str->lst "9 10 15 " " ")) 
(setq cc (getstring (strcat"\nNhap cac khoang cach:")))
(setq lstDIS (str->lst  cc ",")) 
;(while (setq obj (car (entsel "\nSelect object:")))
(setq obj (car (entsel "\nSelect object:")))
(setq kc 0)
(foreach dis...
>>

Cám ơn bác nhiều

Sau khi mò mẫm về cơ bản mình sử lý được 70%, còn cái vụ tách @ hàm hay thật

(defun C:dof(/ lstDis obj cc)
;(setq lstDIS '(9 10 -15))
;(setq lstDIS (str->lst "9 10 15 " " ")) 
(setq cc (getstring (strcat"\nNhap cac khoang cach:")))
(setq lstDIS (str->lst  cc ",")) 
;(while (setq obj (car (entsel "\nSelect object:")))
(setq obj (car (entsel "\nSelect object:")))
(setq kc 0)
(foreach dis lstDIS
'(vla-offset (vlax-ename->vla-object obj) dis)
(setq kc (+ kc (atof dis)))
(vla-offset (vlax-ename->vla-object obj) kc)
)
;)
(princ)
)

(defun Str->lst ( str del / pos )
(vl-remove ","
	(if (setq pos (vl-string-search del str))
    	(cons (substr str 1 pos) (Str->lst (substr str (+ pos 1 (strlen del))) del))
    	(list str)
	)
)
)
@ ĐVH có thể giải thích giúp đoạn code sau ?

(setq lst (apply 'append (mapcar '(lambda(x) (HA:str->lst x "@")) (LM:str->lst str ","))))

mình định áp dụng để nội suy cao độ đáy hố ga và cao độ thiết kế của 1 tuyến đường có độ dốc không đổi, vấn đề thay đổi theo từng đoạn thì mình chưa nghĩ tới, và có lẽ hướng giải quyết là mình chia đoạn ra và lam từng đoạn. Bạn làm giúp mình nhé, mình cảm ơn bạn.

Hề hề...

mình định áp dụng để nội suy cao độ đáy hố ga và cao độ thiết kế của 1 tuyến đường có độ dốc không đổi, vấn đề thay đổi theo từng đoạn thì mình chưa nghĩ tới, và có lẽ hướng giải quyết là mình chia đoạn ra và lam từng đoạn. Bạn làm giúp mình nhé, mình cảm ơn bạn.

Hề hề hề,

Bạn dùng thủ cái này coi có cần sửa chữa gì không nhé.

;LISP CHIA DUONG THANG THANH NHIEU DOAN BANG NHAU VA VE THANH POLYLINE
(defun...
>>

;LISP CHIA DUONG THANG THANH NHIEU DOAN BANG NHAU VA VE THANH POLYLINE
(defun C:CDT1(/ taphop n i obj vlaobj d dt os)
  (command "UNDO" "BE")
  (setq os(getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setq taphop(ssget '((0 . "POLYLINE,LWPOLYLINE"))))
  (setq n(atoi(lisped "Nhap so doan can chia vao day")))
  (setq i 0)
  (while (< i (sslength taphop))
    (setq obj(ssname taphop i))
    (setq vlaobj(vlax-ename->vla-object obj))
    (setq d 0)
    (command "PLINE")
    (while (<= d (vla-get-length vlaobj))
      (command (vlax-curve-getPointAtDist obj d))
      (setq d(+ d (/ (vla-get-length vlaobj) n))))
    (command "")
    (setq dt(vlax-ename->vla-object (entlast)))
    (vla-put-linetype dt (vla-get-linetype vlaobj))
    (vla-put-LinetypeScale dt (vla-get-LinetypeScale vlaobj))
    (vla-put-lineweight dt (vla-get-lineweight vlaobj))
    (vla-put-color dt (vla-get-color vlaobj))
    (vla-put-layer dt (vla-get-layer vlaobj))
    (vla-delete vlaobj)
    (setq i (1+ i))
    )
  (setvar "OSMODE" os)
  (command "UNDO" "END")
  (princ)
  )
;LISP CHIA DUONG THANG THANH NHIEU DOAN BANG KHOANG CACH NHAP TU BAN PHIM
(defun C:CDT2(/ obj vlaobj dt i S d os)
  (command "UNDO" "BE")
  (setq os(getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (while (setq obj(car (entsel "\n Chon doan thang can chia: ")))
    (setq i 1 S 0 vlaobj(vlax-ename->vla-object obj))
    (command "PLINE" (vlax-curve-getPointAtDist obj 0))
    (while (setq d(getreal (strcat "\n Nhap chieu dai doan thu " (itoa i) ": ")))
      (if (<= (+ S d) (vla-get-length (vlax-ename->vla-object obj)))
	(progn
	  (setq S(+ S d))
	  (command (vlax-curve-getPointAtDist obj S))
	  (setq i(1+ i))
	  )
	(alert "Tong chieu dai vuot qua chieu dai ban dau")
	)
      )
    (if (= d nil) (command (vlax-curve-getPointAtDist obj (vla-get-length (vlax-ename->vla-object obj)))))
    (command "")
    (setq dt(vlax-ename->vla-object (entlast)))
    (vla-put-linetype dt (vla-get-linetype vlaobj))
    (vla-put-LinetypeScale dt (vla-get-LinetypeScale vlaobj))
    (vla-put-lineweight dt (vla-get-lineweight vlaobj))
    (vla-put-color dt (vla-get-color vlaobj))
    (vla-put-layer dt (vla-get-layer vlaobj))
    (vla-delete vlaobj)
    )
  (setvar "OSMODE" os)
  (command "UNDO" "END")
  (princ)
  )

Các anh cho em hỏi tý. Nếu muốn phá khối vừa chèn thì phải sửa code này như nào?

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/69905-yeu-cau-xuat-diem-theo-block-thuoc-tinh-qui-dinh-boi-ten/
;========LISP DUA DIEM KHONG CHE + DIEM CHI TIET LEN BAN VE=========
;=======================KANGKUNG 03/04/2013=========================
(defun C:KK()
  (command "UNDO" "BE")
  (setq...
>>

Các anh cho em hỏi tý. Nếu muốn phá khối vừa chèn thì phải sửa code này như nào?

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/69905-yeu-cau-xuat-diem-theo-block-thuoc-tinh-qui-dinh-boi-ten/
;========LISP DUA DIEM KHONG CHE + DIEM CHI TIET LEN BAN VE=========
;=======================KANGKUNG 03/04/2013=========================
(defun C:KK()
  (command "UNDO" "BE")
  (setq os(getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (if (not Path) (setq Path(getvar "dwgprefix")))
  (setq file(getfiled "Select File:" Path "txt" 2) Path file file_in(open file "R"))
  (while(setq txt(read-line file_in))
    (if (/= txt nil)
      (progn
	(setq lst (read (strcat "(" txt ")"  )))
	(if (= (read txt) (atof (vl-princ-to-string(read txt))))
	  (command "INSERT" "Point" (list (nth 2 lst) (nth 1 lst) (nth 3 lst)) "1" "1" "0" (rtos (nth 0 lst) 2 0) (rtos (nth 3 lst) 2 2) (vl-princ-to-string(nth 4 lst)))
	  (progn
	    (setq Code(substr txt 1 (- (vl-string-search (rtos (fix (nth (- (length lst) 3) lst)) 2 0) txt) 1)))
	    (cond ((= (strcase(substr Code 1 2)) "TM") (in "TM"))
		  ((= (strcase(substr Code 1 3)) "GPS") (in "GPS"))
		  ((= (strcase(substr Code 1 3)) "DCI") (in "DCI"))
		  ((= (strcase(substr Code 1 4)) "DCII") (in "DCII"))
		  )
	    )
	  )
	)
      )
    )
  (close file_in)
  (setvar "OSMODE" os)
  (command "ZOOM" "E")
  (command "UNDO" "END")
  (Alert "Well Done")
  )
(defun in(ten)
  (command "INSERT" ten (list (nth (- (length lst) 2) lst) (nth (- (length lst) 3) lst) (nth (- (length lst) 1) lst)) "1" "1" "0" Code (rtos (nth (- (length lst) 1) lst) 2 3))
(c:burst) (entlast)
)
(princ "\n                Written By KangKung - 03/04/2013\n")
(princ "\n                  Nhap KK de chay chuong trinh\n")

Lisp sửa lại theo ý bạn đây. Bạn chạy lại xem đã đúng ý chưa. Lệnh CDT1 đã khắc phục lỗi thiếu 1 đoạn sau khi chia. Lệnh CDT2 bổ sung việc chọn cùng lúc nhiều đường thẳng cần chia, sau đó nhập chiều dài từng đoạn từ bàn phím. Tuy nhiên do chiều dài các đường thẳng cần chia khác nhau nên kết quả có thể ra khác nhau giữa các đường thẳng. Ví dụ chọn 2 đường thẳng dài 10 và 20 sau...

Lisp sửa lại theo ý bạn đây. Bạn chạy lại xem đã đúng ý chưa. Lệnh CDT1 đã khắc phục lỗi thiếu 1 đoạn sau khi chia. Lệnh CDT2 bổ sung việc chọn cùng lúc nhiều đường thẳng cần chia, sau đó nhập chiều dài từng đoạn từ bàn phím. Tuy nhiên do chiều dài các đường thẳng cần chia khác nhau nên kết quả có thể ra khác nhau giữa các đường thẳng. Ví dụ chọn 2 đường thẳng dài 10 và 20 sau đó nhập vào các đoạn chia là 3, 6, 2, 5 thì kết quả đường thẳng thứ nhất sẽ có độ dài các đoạn lần lượt là 3, 6 và 1 (3 đoạn), còn đường thẳng thứ hai sẽ là 3, 6, 2, 5, và 4 (5 đoạn)

;LISP CHIA DUONG THANG THANH NHIEU DOAN BANG NHAU VA VE THANH POLYLINE
(defun C:CDT1(/ taphop i obj vlaobj d dt)
  (command "UNDO" "BE")
  (setq os(getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setq taphop(ssget '((0 . "POLYLINE,LWPOLYLINE"))))
  (if (= n nil) (setq n1 1) (setq n1 n))
  (setq n (getint (strcat "\n So doan can chia: <" (rtos n1 2 0) "> ")))
  (if (= n nil) (setq n n1))
  (setq i 0)
  (while (< i (sslength taphop))
    (setq obj(ssname taphop i))
    (setq vlaobj(vlax-ename->vla-object obj))
    (setq d 0)
    (command "PLINE")
    (while (< d (vla-get-length vlaobj))
      (command (vlax-curve-getPointAtDist obj d))
      (setq d(+ d (/ (vla-get-length vlaobj) n))))
    (command (vlax-curve-getPointAtDist obj (vla-get-length (vlax-ename->vla-object obj))) "")
    (setq dt(vlax-ename->vla-object (entlast)))
    (vla-put-linetype dt (vla-get-linetype vlaobj))
    (vla-put-LinetypeScale dt (vla-get-LinetypeScale vlaobj))
    (vla-put-lineweight dt (vla-get-lineweight vlaobj))
    (vla-put-color dt (vla-get-color vlaobj))
    (vla-put-layer dt (vla-get-layer vlaobj))
    (vla-delete vlaobj)
    (setq i (1+ i))
    )
  (setvar "OSMODE" os)
  (command "UNDO" "END")
  (princ)
  )
;LISP CHIA DUONG THANG THANH NHIEU DOAN BANG KHOANG CACH NHAP TU BAN PHIM
(defun C:CDT2(/ taphop i obj vlaobj d dt)
  (command "UNDO" "BE")
  (setq os(getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setq taphop(ssget '((0 . "POLYLINE,LWPOLYLINE"))))
  (setq lst(list))
  (setq i 1)
  (while (setq d(getreal (strcat "\n Nhap chieu dai doan thu " (itoa i) ": ")))
    (setq lst(append lst (list d)))
    (setq i(1+ i)))
  (setq i 0)
  (while (< i (sslength taphop))
    (setq obj(ssname taphop i))
    (setq vlaobj(vlax-ename->vla-object obj))
    (setq S 0)
    (command "PLINE" (vlax-curve-getPointAtDist obj 0))
    (foreach d lst
      (if (< (+ S d) (vla-get-length vlaobj))
	(progn
	  (setq S(+ S d))
	  (command (vlax-curve-getPointAtDist obj S)))))
    (command (vlax-curve-getPointAtDist obj (vla-get-length (vlax-ename->vla-object obj))) "")
    (setq dt(vlax-ename->vla-object (entlast)))
    (vla-put-linetype dt (vla-get-linetype vlaobj))
    (vla-put-LinetypeScale dt (vla-get-LinetypeScale vlaobj))
    (vla-put-lineweight dt (vla-get-lineweight vlaobj))
    (vla-put-color dt (vla-get-color vlaobj))
    (vla-put-layer dt (vla-get-layer vlaobj))
    (vla-delete vlaobj)
    (setq i (1+ i))
    )
  (setvar "OSMODE" os)
  (command "UNDO" "END")
  (princ)
  )

Thêm code để phá block attribute sau khi insert vào bản vẽ.

;========LISP DUA DIEM KHONG CHE + DIEM CHI TIET LEN BAN VE=========
;=======================KANGKUNG 03/04/2013=========================
;============07/05/2013 UPDATE: PHA BLOCK SAU KHI INSERT============
(defun C:KK(/ os txt lst Code)
  (command "UNDO" "BE")
  (setq os(getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (if (not Path) (setq Path(getvar "dwgprefix")))
  (setq file(getfiled...
>>

Thêm code để phá block attribute sau khi insert vào bản vẽ.

;========LISP DUA DIEM KHONG CHE + DIEM CHI TIET LEN BAN VE=========
;=======================KANGKUNG 03/04/2013=========================
;============07/05/2013 UPDATE: PHA BLOCK SAU KHI INSERT============
(defun C:KK(/ os txt lst Code)
  (command "UNDO" "BE")
  (setq os(getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (if (not Path) (setq Path(getvar "dwgprefix")))
  (setq file(getfiled "Select File:" Path "txt" 2) Path file file_in(open file "R"))
  (while(setq txt(read-line file_in))
    (if (/= txt nil)
      (progn
	(setq lst (read (strcat "(" txt ")"  )))
	(if (= (read txt) (atof (vl-princ-to-string(read txt))))
	  (command "INSERT" "Point" (list (nth 2 lst) (nth 1 lst) (nth 3 lst)) "1" "1" "0" (rtos (nth 0 lst) 2 0) (rtos (nth 3 lst) 2 2) (vl-princ-to-string(nth 4 lst)))
	  (progn
	    (setq Code(substr txt 1 (- (vl-string-search (rtos (fix (nth (- (length lst) 3) lst)) 2 0) txt) 1)))
	    (cond ((= (strcase(substr Code 1 2)) "TM") (in "TM"))
		  ((= (strcase(substr Code 1 3)) "GPS") (in "GPS"))
		  ((= (strcase(substr Code 1 3)) "DCI") (in "DCI"))
		  ((= (strcase(substr Code 1 4)) "DCII") (in "DCII"))
		  )
	    (sssetfirst nil (ssadd (entlast))) (c:Burst)
	    )
	  )
	)
      )
    )
  (close file_in)
  (setvar "OSMODE" os)
  (command "ZOOM" "E")
  (command "UNDO" "END")
  (Alert "Well Done")
  )
(defun in(ten)
  (command "INSERT" ten (list (nth (- (length lst) 2) lst) (nth (- (length lst) 3) lst) (nth (- (length lst) 1) lst)) "1" "1" "0" Code (rtos (nth (- (length lst) 1) lst) 2 3)))
(princ "\n                Written By KangKung - 03/04/2013\n")
(princ "\n                  Nhap KK de chay chuong trinh\n")

Rắc rối là ở đây (vlax-curve-getPointAtDist obj (vla-get-length vlaobj)) có lúc đúng lúc sai do độ chính xác. Lisp mới dưới đây sẽ khắc phục lỗi đó tuy nhiên yêu cầu cài ExpressTool trước khi sử dụng.

;LISP CHIA DUONG THANG THANH NHIEU DOAN BANG NHAU VA VE THANH POLYLINE
(defun C:CDT1(/ taphop i obj vlaobj d dt)
  (command "UNDO" "BE")
  (setq os(getvar "OSMODE"))
  (setvar "OSMODE"...
>>

Rắc rối là ở đây (vlax-curve-getPointAtDist obj (vla-get-length vlaobj)) có lúc đúng lúc sai do độ chính xác. Lisp mới dưới đây sẽ khắc phục lỗi đó tuy nhiên yêu cầu cài ExpressTool trước khi sử dụng.

;LISP CHIA DUONG THANG THANH NHIEU DOAN BANG NHAU VA VE THANH POLYLINE
(defun C:CDT1(/ taphop i obj vlaobj d dt)
  (command "UNDO" "BE")
  (setq os(getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setq taphop(ssget '((0 . "POLYLINE,LWPOLYLINE"))))
  (if (= n nil) (setq n1 1) (setq n1 n))
  (setq n (getint (strcat "\n So doan can chia: <" (rtos n1 2 0) "> ")))
  (if (= n nil) (setq n n1))
  (setq i 0)
  (while (< i (sslength taphop))
    (setq obj(ssname taphop i))
    (setq vlaobj(vlax-ename->vla-object obj))
    (setq d 0)
    (command "PLINE")
    (while (< d (vla-get-length vlaobj))
      (command (vlax-curve-getPointAtDist obj d))
      (setq d(+ d (/ (vla-get-length vlaobj) n))))
    (command (last (acet-geom-vertex-list obj)) "")
    (setq dt(vlax-ename->vla-object (entlast)))
    (vla-put-linetype dt (vla-get-linetype vlaobj))
    (vla-put-LinetypeScale dt (vla-get-LinetypeScale vlaobj))
    (vla-put-lineweight dt (vla-get-lineweight vlaobj))
    (vla-put-color dt (vla-get-color vlaobj))
    (vla-put-layer dt (vla-get-layer vlaobj))
    (vla-delete vlaobj)
    (setq i (1+ i))
    )
  (setvar "OSMODE" os)
  (command "UNDO" "END")
  (princ)
  )
;LISP CHIA DUONG THANG THANH NHIEU DOAN BANG KHOANG CACH NHAP TU BAN PHIM
(defun C:CDT2(/ taphop i obj vlaobj d dt)
  (command "UNDO" "BE")
  (setq os(getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setq taphop(ssget '((0 . "POLYLINE,LWPOLYLINE"))))
  (setq lst(list))
  (setq i 1)
  (while (setq d(getreal (strcat "\n Nhap chieu dai doan thu " (itoa i) ": ")))
    (setq lst(append lst (list d)))
    (setq i(1+ i)))
  (setq i 0)
  (while (< i (sslength taphop))
    (setq obj(ssname taphop i))
    (setq vlaobj(vlax-ename->vla-object obj))
    (setq S 0)
    (command "PLINE" (vlax-curve-getPointAtDist obj 0))
    (foreach d lst
      (if (< (+ S d) (vla-get-length vlaobj))
	(progn
	  (setq S(+ S d))
	  (command (vlax-curve-getPointAtDist obj S)))))
    (command (last (acet-geom-vertex-list obj)) "")
    (setq dt(vlax-ename->vla-object (entlast)))
    (vla-put-linetype dt (vla-get-linetype vlaobj))
    (vla-put-LinetypeScale dt (vla-get-LinetypeScale vlaobj))
    (vla-put-lineweight dt (vla-get-lineweight vlaobj))
    (vla-put-color dt (vla-get-color vlaobj))
    (vla-put-layer dt (vla-get-layer vlaobj))
    (vla-delete vlaobj)
    (setq i (1+ i))
    )
  (setvar "OSMODE" os)
  (command "UNDO" "END")
  (princ)
  )

Lập topic yêu cầu như sau:

-Tiêu đề topic. lisp...

-Nội dung: Mô tả bằng văn xuôi hoặc văn vần các thứ:

+Đầu vào có cái gì.

Đầu ra thành cái gì.

-Mô tả thêm bằng file cad trạng thái đầu và cuối. 

Đoán mò mà ra lisp sau. Lệnh qt.

>>

Ủa LISP của bạn xài tốt mà, không biết bạn áp dụng vào bản vẽ ntn, và áp dụng như thế nào mà không được nhỉ?!!!

Sau khi bạn pick một DIM, Height text sẽ thay đổi đối với các DIM: cùng DIMstyle và cùng chiều cao nữa.

Tuy nhiên, mình thấy rằng trong một bản vẽ thống nhất, mặc dù có nhiều DIMstyle khác nhau về Scale Factor, nhưng Height text của các DIMstyle phải bằng nhau...

Ủa LISP của bạn xài tốt mà, không biết bạn áp dụng vào bản vẽ ntn, và áp dụng như thế nào mà không được nhỉ?!!!

Sau khi bạn pick một DIM, Height text sẽ thay đổi đối với các DIM: cùng DIMstyle và cùng chiều cao nữa.

Tuy nhiên, mình thấy rằng trong một bản vẽ thống nhất, mặc dù có nhiều DIMstyle khác nhau về Scale Factor, nhưng Height text của các DIMstyle phải bằng nhau chứ? (thường bằng 2.5; 3 hay 3.5 gì đó, trong LISP sau, mình để sẵn giá trị tham chiếu là 3)

Vì vậy mình nghĩ, ý bạn là chuyển tất cả DIM trong bản vẽ (mặc dù khác DIMstyle và khác chiều cao) về cùng một Height text do bạn nhập vào, nếu vậy bạn xài thử LISP sau đây:

Mà các bác có thể gộp luôn dimstyle vs textstyle vào luôn k?
Như thế tiện hơn :P

 
Vấn đề của bạn đã được đề cập đến trong diễn đàn rồi bạn à, bạn làm theo cách này cũng được:
 

;;; Khoi tao Layer ;;;

(defun newlay(a b c d) 

(if (not (tblsearch "layer" a))...
>>

Mà các bác có thể gộp luôn dimstyle vs textstyle vào luôn k?
Như thế tiện hơn :P

 
Vấn đề của bạn đã được đề cập đến trong diễn đàn rồi bạn à, bạn làm theo cách này cũng được:
 

;;; Khoi tao Layer ;;;

(defun newlay(a b c d) 

(if (not (tblsearch "layer" a)) (command "-layer" "n" a "c" b a "l" c a "lw" d a "")

(command "-layer" "s" a "c" b a "l" c a "lw" d a "")))

;;; Sau do cu viet theo nhu cau: (newlay "name" color "laytype" lineweight), Vi du:

(defun C:laykt()

(newlay "KT-TRUC" 2 "CENTER2" 0.13)

(newlay "KT-BAO" 2 "CONTINUOUS" 0.30)

.....................................................

(prompt "\nBao cao da khoi tao he thong LAYER can thiet\n"))

 

;;; Khoi Textstyle ;;;

(command "style" "stylename" "fontname" "height" "width factor" "" "" "" "")

;;; Vi du:

(defun C:stext()

(command "style" "Standard" "simplex.shx,bigfont.shx" "0" "0.75" "" "" "" "")

.............................................................................

(prompt "\nBao cao da khoi tao to hop template TEXT STYLE can thiet\n"))

 

;;; Khoi Dimstyle ;;;

(defun C:sdim()

(C:stext)

(setvar "DIMBLK" "_Open")

(setvar "DIMLDRBLK" "_Open")

(setvar "DIMCLRD" 0)

(setvar "DIMCLRE" 0)

(setvar "DIMCLRT" 0)

(setvar "DIMCEN" 0)

(setvar "DIMDLI" 7)

(setvar "DIMEXO" 1)

(setvar "DIMEXE" 1)

(setvar "DIMSCALE" 50)

(setvar "DIMTXSTY" "Standard")

(setvar "DIMDSEP" ".")

(setvar "DIMALTD" 0)

(setvar "DIMTMOVE" 2)

(setvar "DIMAUNIT" 1)

(setvar "DIMTXT" 3.5)

(setvar "DIMADEC" 3)

(setvar "DIMTIX" 1)

(setvar "DIMASZ" 2)

(setvar "DIMDEC" 0)

(setvar "DIMGAP" 1)

(setvar "DIMLFAC" 0.4) (command "-dimstyle" "s" "KT-50-20")

(setvar "DIMLFAC" 2) (command "-dimstyle" "s" "KT-50-100")

(setvar "DIMLFAC" 0.2) (command "-dimstyle" "s" "KT-50-10")

(setvar "DIMLFAC" 0.6) (command "-dimstyle" "s" "KT-50-30")

(setvar "DIMLFAC" 1) (command "-dimstyle" "s" "KT-50")

(prompt "\nBao cao da khoi tao to hop template DIMMENSION STYLE can thiet\n"))

 

;;; Cac bien he thong ban tu nghien cuu nhe! ;;;

Tên topic không hợp lệ, nhưng hơn hai tuần rồi topic vẫn còn (không bị xóa) chắc là mod bỏ qua rồi.

gửi bạn Lisp bind xref cho file hiện hành.

Nếu OK thì việc dùng cho các file đang mở chỉ là chuyện nhỏ.

(defun c:XrefBind ()
  (vlax-map-Collection (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object)))
    '(lambda (b)
       (if (= (vla-get-IsXRef b) :vlax-true)
	...
>>

Tên topic không hợp lệ, nhưng hơn hai tuần rồi topic vẫn còn (không bị xóa) chắc là mod bỏ qua rồi.

gửi bạn Lisp bind xref cho file hiện hành.

Nếu OK thì việc dùng cho các file đang mở chỉ là chuyện nhỏ.

(defun c:XrefBind ()
  (vlax-map-Collection (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object)))
    '(lambda (b)
       (if (= (vla-get-IsXRef b) :vlax-true)
	 (vl-catch-all-error-p
	   (vl-catch-all-apply 'vla-bind (list b :vlax-true)  ) )  )  )  ))

khi vẽ ban CAD em gặp truờng hợp thế này,cần tạo ra 1 hình gồm 1 đường tròn và đường thẳng,em dung lệnh pedit mà không được.các sư phụ giúp em với, vì em cần copy ra rật nhiều hình nên không làm thủu công được.

khi vẽ ban CAD em gặp truờng hợp thế này,cần tạo ra 1 hình gồm 1 đường tròn và đường thẳng,em dung lệnh pedit mà không được.các sư phụ giúp em với, vì em cần copy ra rật nhiều hình nên không làm thủu công được.

(defun C:CPL (/ tdt ssdt sodt index)
(setq tdt (ssget)   sodt (sslength tdt)   index 0)
(repeat sodt
(setq ssdt (ssname tdt index)   index (1+ index))
(if (or (= (Objname ssdt) "LWPOLYLINE")  (= (Objname ssdt) "POLYLINE"))  (NoiPL ssdt))
(if (or (= (Objname ssdt) "LINE") (= (Objname ssdt) "ARC")) (NoiLC ssdt)))    (princ))
(defun ObjName (ssdt /) (cdr (assoc '0 (entget ssdt))))
(defun MoPL (ssdt /) (= (cdr (assoc '70 (entget ssdt))) 0))
(defun NoiPL (ssdt /) (if (MoPL ssdt) (command ".PEDIT" ssdt "J" "All" "" "X")))
(defun NoiLC (ssdt /) (command ".PEDIT" ssdt "Y" "J" "All" "" "X"))

Các bạn cho mình hỏi: ảnh động trong link này được tạo ra từ phần mềm gì nhỉ
http://lee-mac.com/assoctextbox.html

 
Không biết chính xác tác giả đã tạo ra ntn?!!
Em có cách này, không biết là có ngu ngốc quá...

Các bạn cho mình hỏi: ảnh động trong link này được tạo ra từ phần mềm gì nhỉ
http://lee-mac.com/assoctextbox.html

 
Không biết chính xác tác giả đã tạo ra ntn?!!
Em có cách này, không biết là có ngu ngốc quá không?!
Trước tiên vẫn dùng GIFCAM (như Chị đã hướng dẫn hôm trước) hoặc cũng có thể dùng các phần mềm khác, tuỳ hỷ (vd: Camtasia Recoder v.v...).
Sau đây là một ví dụ nhỏ cho vòng tròn chứa chữ Circle, chúng ta sẽ chạy "LISP" sau và quay lại một phần màn hình (*)

(defun C:SN() ;; Song Nhi
(setq osd (getvar "osmode"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(command "_zoom" "e" "")
(command "-layer" "M" "TRON" "C" "1" "" "")
(setvar "cecolor" "bylayer")
(command "_circle" "3.0,3.0" 1)
(command "-layer" "M" "TEXT" "C" "2" "" "")
(setvar "cecolor" "bylayer")
(command "style" "Standard" "simplex.shx,bigfont.shx" "0.4" "0.8" "" "" "" "")
(command "_text" "j" "mc" "3.0,3.0" "" "Circle")
(command "-layer" "M" "PICK" "C" "4" "" "")
(setvar "cecolor" "bylayer")
(command "_line" "1.0,1.0" "1.1,1.0" "1.1,1.1" "1.0,1.1" "c")
(command "-layer" "M" "LINE" "C" "4" "" "")
(setvar "cecolor" "bylayer")
(command "_line" "0.55,1.05" "1.55,1.05" "")
(command "_line" "1.05,0.55" "1.05,1.55" "")
(waste 5)
(setq ss1 (ssget "x" '((0 . "LINE"))))
(command "_move" ss1 "" "1.05,1.05" "2.70,2.90")
(command "-layer" "M" "POIN" "C" "3" "" "")
(setvar "cecolor" "bylayer")
(command "_solid" "2.95,2.95" "3.05,2.95" "2.95,3.05" "3.05,3.05" "" "")
(command "_solid" "2.30,2.75" "2.40,2.75" "2.30,2.85" "2.40,2.85" "" "")
(waste 5)
(setq ss2 (ssget "x" '((8 . "PICK"))))
(setq ss3 (ssget "x" '((8 . "POIN"))))
(command "_erase" ss2 "") (command "_erase" ss3 "")
(waste 1)
(setq ss4 (ssget "x" '((8 . "LINE"))))
(setq ss5 (ssget "x" '((8 . "TEXT"))))
(waste 1)
(command "-layer" "M" "GION" "C" "9" "" "")
(command "_move" ss4 "" "3.0,3.0" "5.0,1.5")
(command "_layer" "s" "GION" "") (setvar "cecolor" "bylayer")
(command "_line" "2.70,2.90" "4.70,1.40" "")
(command "_move" ss5 "" "3.0,3.0" "5.0,1.5")
(waste 1)
(setq ss6 (ssget "x" '((8 . "GION"))))
(command "_erase" ss6 "")
(command "_move" ss4 "" "5.0,1.5" "7.0,3.0")
(command "_layer" "s" "GION" "") (setvar "cecolor" "bylayer")
(command "_line" "5.0,1.5" "7.0,3.0" "")
(command "_move" ss5 "" "5.0,1.5" "7.0,3.0")
(setq ss7 (ssget "x" '((8 . "TRON"))))
(command "_erase" ss7 "")
(command "_layer" "s" "TRON" "") (setvar "cecolor" "bylayer")
(command "_circle" "5.0,1.5" 1)
(waste 1)
(setq ss8 (ssget "x" '((8 . "GION"))))
(command "_erase" ss8 "")
(command "-layer" "M" "PICK" "C" "4" "" "")
(setvar "cecolor" "bylayer")
(command "_line" "6.65,2.85" "6.75,2.85" "6.75,2.95" "6.65,2.95" "c")
(waste 1)
(setq ss9 (ssget "x" '((8 . "TRON"))))
(command "_erase" ss9 "")
(command "_layer" "s" "TRON" "") (setvar "cecolor" "bylayer")
(command "_circle" "7.0,3.0" 1)
(setvar "osmode" osd)
(setvar "cmdecho" 1))
;;; Ham con ;;;
(defun abc() (setvar "cmdecho" 0)
(COMMAND "LAYER" "M" "TIM" "C" "8" "" "L" "DASHDOT" "" "")
(COMMAND "LAYER" "M" "KHUAT" "C" "9" "" "L" "HIDDEN" "" "")
(COMMAND "LAYER" "M" "Text" "C" "11" "" "")
(COMMAND "LAYER" "M" "Ghichu" "C" "2" "" "")
(COMMAND "LAYER" "M" "1" "C" "2" "" "")
(COMMAND "LAYER" "M" "dim" "C" "2" "" "")
(COMMAND "LAYER" "M" "thep" "C" "6" "" "")
(COMMAND "LAYER" "M" "dai" "C" "1" "" "")
(COMMAND "LAYER" "M" "0" "C" "7" "" "")
(COMMAND "LAYER" "M" "hatch" "C" "251" "" "")
(COMMAND "LAYER" "M" "Bao chinh" "C" "4" "" "")
(setvar "cmdecho" 1))
(defun cba() (setvar "cmdecho" 0)
(command "_layer" "s" "0" "") (setvar "cecolor" "bylayer")
(command "_purge" "all" "*" "n"))
(defun waste(n / ) (setq i 0)
(While (<= i n) (abc) (cba) (setq i (+ i 1))))

P/S:
1. (*) Quay lại trong khung chữ nhật từ (-0.65;-1.15) đến (9.50;5.50), căn cứ theo LISP trên.
2. Em không biết làm sao kéo dài thời gian giữa một số bước để đảm bảo Video có thể "lưu ảnh" (24hình/s). Em mượn đại LISP tạo Layer của bạn cd2k44 để tạo một hàm nhằm mục đích làm hao phí thời gian, giả sử mỗi chu kỳ của vòng lặp là 1s (chỉ là giả sử thôi nhé!). Nếu cần dừng 2s ta viết (waste 2), ví dụ vậy ...
3. Đối với 2 hình còn lại cũng làm bằng cách tương tự được - nhưng khó quá, hi, không phải khó mà thấy làm theo cách này vô ích và sao sao đó ...
4. Đây xem như một chuyện cười - khôi hài, để anh chị em ta relax - các bác Mod nếu thấy em post "truyện" nhầm chổ thì del nhé! Cái mặt xấu hổ nằm đâu rùi ta?!  :P   
5. Bác nào biết cách kéo dài thời gian giữa 2 bước nào đó trong LISP một cách chính xác và kinh điển làm ơn chỉ cho em với? Cám ơn các Bác!

Kết quả hình đây, quay không rõ lắm, với lại không hiểu sao nó không nhận mầu xanh lá (green)?!!

Bạn thử xem. Tôi test không lỗi.

Bạn thử xem. Tôi test không lỗi.