Jump to content
InfoFile
Tác giả: NguyenNgocSon
Bài viết gốc: 233857
Tên lệnh: cop
Lệnh offset đặc biệt

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))

<<

Filename: 233857_cop.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 53521
Tên lệnh: nn
Viết Lisp theo yêu cầu


Bạn xài thử cái lisp này của bác ssg xem nhé.

Hy vọng bạn hài lòng.
Cách xài:
1/- load lisp váo cad
2/- gõ lệnh nn
3/- Chọn đối tượng theo cửa sổ
4/- Nhân Enter.
5/- kiểm tra kết quả.

Filename: 53521_nn.lsp
Tác giả: NguyenNgocSon
Bài viết gốc: 233805
Tên lệnh: dof
Lệnh offset đặc biệt

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 ","))))

<<

Filename: 233805_dof.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 234018
Tên lệnh: gddct
I am constantly invstigating online for tips that can benefit me. Thanks!

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é.

 

(defun c:gddct ( / pl cd dd h p len cdc)
(vl-load-com)
(command "undo" "be")
(setq pl (car (entsel "\n Chon pline tuyen can ghi cao do"))
          cd (getreal "\n Nhap gia tri cao do dau tuyen: ")
          dd (getreal "\n Nhap do doc toan tuyen theo don vi % : ")
          h (getreal "\n Nhap chieu cao text ket qua: ")
          p (getpoint "\n Chon diem dat text ket qua")
)
(if (= cd 0.0)
    (setq cd (atof (cdr (assoc 1 (enget (car (entsel "\n Chon text ghi cao do dau tuyen")))))))
)
(setq len (vlax-curve-getdistatpoint pl (vlax-curve-getendpoint pl))
          cdc (rtos (+ cd (/ (* len dd) 100)) 2 2)
)
(command "text" "j" "mc" p h 0 cdc)
(command "undo" "e")
)
 
Chúc bạn vui và nếu có gì chưa vui thì hãy post lên nhé.

<<

Filename: 234018_gddct.lsp
Tác giả: KangKung
Bài viết gốc: 234047
Tên lệnh: cdt1 cdt2
I really appreciate this post. Iˇve been looking everywhere for this! Thank goodness I found it on Bing. You"ve made my day! Thanks again
Bạn dùng Lisp này xem đúng ý chưa. Lệnh CDT1 dùng để chia đường thẳng thành nhiều đoạn bằng nhau. Có thể quét chọn để chia hàng loạt đường thẳng cùng lúc. Lệnh CDT2 dùng để chia đường thẳng thành những đoạn có độ dài bằng khoảng cách nhập từ bàn phím. Khi kết thúc thì bấm Space hoặc Enter.
;LISP CHIA DUONG THANG THANH NHIEU DOAN BANG NHAU VA VE THANH POLYLINE
(defun...
>>
Bạn dùng Lisp này xem đúng ý chưa. Lệnh CDT1 dùng để chia đường thẳng thành nhiều đoạn bằng nhau. Có thể quét chọn để chia hàng loạt đường thẳng cùng lúc. Lệnh CDT2 dùng để chia đường thẳng thành những đoạn có độ dài bằng khoảng cách nhập từ bàn phím. Khi kết thúc thì bấm Space hoặc Enter.
;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)
  )

<<

Filename: 234047_cdt1_cdt2.lsp
Tác giả: khaosatheco
Bài viết gốc: 234113
Tên lệnh: kk
Xuất điểm theo Block thuộc tính qui định bởi tên

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")


<<

Filename: 234113_kk.lsp
Tác giả: KangKung
Bài viết gốc: 234132
Tên lệnh: cdt1 cdt2
[yêu cầu] Lisp chia đoạn thẳng!

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)
  )

<<

Filename: 234132_cdt1_cdt2.lsp
Tác giả: KangKung
Bài viết gốc: 234147
Tên lệnh: kk
Xuất điểm theo Block thuộc tính qui định bởi tên

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")

<<

Filename: 234147_kk.lsp
Tác giả: KangKung
Bài viết gốc: 234160
Tên lệnh: cdt1 cdt2
Lisp chia đoạn thẳng!

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)
  )

<<

Filename: 234160_cdt1_cdt2.lsp
Tác giả: duy782006
Bài viết gốc: 234219
Tên lệnh: qt
Bác nào giúp E cái lisp xoay nhiều text có Rotation từ 90 đến 270

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.

 

>>

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.

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Chuyen gia tri goc tu do sang radian
;;;Cu phap su dung (duy:s_do>radian giatri)
;;;giatri la goc tinh theo do, kq la goc tinh theo radian
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:s_do>radian (gt / gt kq)
(setq kq (* (/ pi 180) gt))
kq)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Tao list tu tap hop chon
;;;Cu phap su dung (duy:taolist<tapchon tapchon) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:taolist<tapchon (tapchon / tapchon listtc stt sdt chondt)
(setq stt 0)
(setq sdt (sslength tapchon))
(while (< stt sdt)
(setq chondt (ssname tapchon stt))
(setq listtc (cons chondt listtc))
(setq stt (+ stt 1))
)
listtc)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Tao tap hop chon tu list  
;;;Cu phap su dung (duy:taotapchon<list listtc) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:taotapchon<list (listtc / tapchon dtc)
(setq tapchon (ssadd))
(foreach dtc listtc
(ssadd dtc tapchon)
)
tapchon)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Tao tap hop chon tu tap chon theo ma DXF can duoi va can tren
;;;Cu phap su dung (duy:taotapchon_dxf_duoi_tren<tapchon tapchongoc madxf canduoi cantren) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:taotapchon_dxf_duoi_tren<tapchon (tapchongoc madxf canduoi cantren / tapchongoc madxf canduoi cantren litgoc dtc tapchon)
(setq litgoc (duy:taolist<tapchon tapchongoc))
(setq tapchon (ssadd))
(foreach dtc litgoc

(cond
((and
(>= (cdr (assoc madxf (entget dtc))) canduoi)
(<= (cdr (assoc madxf (entget dtc))) cantren)
)

(ssadd dtc tapchon))
)

)
tapchon)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Doc toa do tu text duoc chon
;;;Cu phap su dung (duy:d_text>td)
;;;ket qua tra ve la chuoi thong tin lan luot: noidung, style, dolon, diemchen, gocquay
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun duy:d_text>td (dchon / dchon dtt hdt ddau xd yd dsau xs ys diemchen gocquay diemm diemh diemb diemg listkq)
(setq dtt (entget dchon))
(setq hdt (textbox dtt))
(setq ddau (car hdt))
(setq xd (car ddau))
(setq yd (cadr ddau))
(setq dsau (cadr hdt))
(setq xs (car dsau))
(setq ys (cadr dsau))
(setq diemchen (cdr (assoc 10 dtt)))
(setq gocquay (cdr (assoc 50 dtt)))
(setq diemm (polar diemchen gocquay xs))
(setq diemh (polar diemm (+ gocquay (/ pi 2)) ys))
(setq diemb (polar diemchen (+ gocquay (/ pi 2)) ys))
(setq diemg (polar diemchen (angle diemchen diemh) (/ (distance diemchen diemh) 2)))
(setq listkq (list diemchen diemm diemh diemb diemg))
listkq)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:qt (/ b i n)
(command "undo" "be")
(setq b (duy:taotapchon_dxf_duoi_tren<tapchon (ssget (list (cons 0 "TEXT"))) 50 (duy:s_do>radian 90) (duy:s_do>radian 270)))
(setq i 0)
(setq N (sslength b))
(while (< i N)
(command ".rotate" (ssname b i) "" "_non" (nth 4 (duy:d_text>td (ssname b i))) 180)
(setq i (1+ i))
)
(command "undo" "end")
(princ))

<<

Filename: 234219_qt.lsp
Tác giả: Song Nhi
Bài viết gốc: 234437
Tên lệnh: hda
Lỗi lisp cad

Ủ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:

 

 

(defun c:HDA (/ th);;; Height Dimensions All ;;;
(command "undo" "be")
(defun tab (s / d r)
(while   (setq d (tblnext s (null d)))
(setq r  (cons (cdr (assoc 2 d)) r))))
(setq th (getreal "\nNhap chieu cao moi <3.0>:\n")) (if (= th nil) (setq th 3.0))
(setvar "cmdecho" 0)
(mapcar '(lambda(x) (command "DIMSTYLE" "R" x) (setvar "DIMTXT" th) (command "DIMSTYLE" "S" x "Y")) (tab "DIMSTYLE"))
(command "undo" "en") (command "-dimstyle" "A" "all" "")
(prompt (strcat "\nDa thay chieu cao DimText thanh: \n")))
(defun c:HDA (/ th)   ;;; Height Dimensions All ;;;
(command "undo" "be")
(defun tab (s / d r)
(while   (setq d (tblnext s (null d)))
(setq r  (cons (cdr (assoc 2 d)) r))))
(setq th (getreal "\nNhap chieu cao moi <3.0>:\n")) (if (= th nil) (setq th 3.0))
(setvar "cmdecho" 0)
(mapcar '(lambda(x) (command "DIMSTYLE" "R" x) (setvar "DIMTXT" th) (command "DIMSTYLE" "S" x "Y")) (tab "DIMSTYLE"))
(command "undo" "en") (command "-dimstyle" "A" "all" "")
(prompt (strcat "\nDa thay chieu cao DimText thanh: \n")))
 
Chúc bạn vui!

<<

Filename: 234437_hda.lsp
Tác giả: Sony2007
Bài viết gốc: 101053
Tên lệnh: noisuy
Viết lisp theo yêu cầu [phần 2]

Sony hãy thử với đoạn code này.
Đây là Lisp nội suy cao độ Z của 1 điểm P khi biết P1(x1,y1,z1) và P2(x2,y2,z2) với z1 và z2 nhập từ bàn phím và điều kiện P phải nằm trên P1P2 (P có thể nằm trong hoặc nằm ngoài đoạn P1P2


Bác Tue_NV ơi, có thể bổ sung thêm việc ghi các kết quả ra text treen banr ve được không. Các kết quả ở lisp này bác toàn ghi ở command. Cám ơn bác...
>>

Sony hãy thử với đoạn code này.
Đây là Lisp nội suy cao độ Z của 1 điểm P khi biết P1(x1,y1,z1) và P2(x2,y2,z2) với z1 và z2 nhập từ bàn phím và điều kiện P phải nằm trên P1P2 (P có thể nằm trong hoặc nằm ngoài đoạn P1P2


Bác Tue_NV ơi, có thể bổ sung thêm việc ghi các kết quả ra text treen banr ve được không. Các kết quả ở lisp này bác toàn ghi ở command. Cám ơn bác nhiều
<<

Filename: 101053_noisuy.lsp
Tác giả: lyky
Bài viết gốc: 234401
Tên lệnh: laykt stext sdim
[ Yêu Cầu ] Lisp tạo các Layer cho trước trong một bản vẽ mới

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! ;;;


Goodluck!
<<

Filename: 234401_laykt_stext_sdim.lsp
Tác giả: gia_bach
Bài viết gốc: 234534
Tên lệnh: xrefbind
Lisp Bind Xref các bản vẽ đang mở

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)  ) )  )  )  ))

<<

Filename: 234534_xrefbind.lsp
Tác giả: lyky
Bài viết gốc: 234524
Tên lệnh: cpl
làm thế nào để hợp đường tròn và đường thẳng chạm nhau thành 1 vậy các anh!

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.

 
Trước tiên, không biết được là 2...
>>

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.

 
Trước tiên, không biết được là 2 đối tượng (đường tròn & đường thẳng) có giao nhau thành một đường liên tục hở hay không nữa, bạn có thể làm cách này thử nhé:
 
1. Tạo thành Block, nhiều cách - nếu không quan trọng lắm bạn có thể tạo nhanh Block "không tên" bằng cách: Tô chọn đối tượng, chuột phải, copy (hoặc copy with Base point), Chọn một insertpoint (hoặc không), Ctrl+Shift+V vào một vị trí bất kỳ. Hoặc nếu quan trọng thì bạn nên tạo Block bằng lệnh B (Block)... Khi đó, bạn có thể thao tác với nó thuận tiện hơn!
 
2. Dùng LISP sau đây (mình sưu tầm trên diễn đàn này hay ở đâu đó!?) để tạo thành một Pline (trong trường hợp: có giao nhau thành một đường liên tục hở)
 
(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"))
Goodluck!
<<

Filename: 234524_cpl.lsp
Tác giả: Song Nhi
Bài viết gốc: 234575
Tên lệnh: sn
Hỏi về Lisp (thuật toán, ý tưởng, coding,...)

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)?!!

118347_song_nhi.gif


<<

Filename: 234575_sn.lsp
Tác giả: hieux5
Bài viết gốc: 220192
Tên lệnh: mm+nil
Lỗi đặt lệnh tắt
Có đúng hok bạn nhỉ :D

(defun c:MM nil (initdia) (command "_.MLEDIT")) ;mo hop thoai MLedit

Filename: 220192_mm+nil.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 234691
Tên lệnh: bandiem
Viết lisp để góc nhập vào dạng (Độ.phútgiây)

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

 

(defun dtor (str / do ph gi gt kq)
 (or cal (arxload "geomcal"))
 (setq do (substr str 1 (- (strlen str) 5)))
 (setq ph (substr (substr str (- (strlen str) 3) 4) 1 2))
 (setq gi (substr (substr str (- (strlen str) 3) 4) 3 2))
 (setq gt (strcat do "d" ph "'" gi "\""))
 (setq kq (* (/ pi 180) (cal gt)))
 kq)
;(defun dtor (gt / gt kq)...
>>

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

 

(defun dtor (str / do ph gi gt kq)
 (or cal (arxload "geomcal"))
 (setq do (substr str 1 (- (strlen str) 5)))
 (setq ph (substr (substr str (- (strlen str) 3) 4) 1 2))
 (setq gi (substr (substr str (- (strlen str) 3) 4) 3 2))
 (setq gt (strcat do "d" ph "'" gi "\""))
 (setq kq (* (/ pi 180) (cal gt)))
 kq)
;(defun dtor (gt / gt kq) (setq kq (* (/ pi 180) gt)) kq)
(defun none()
  (command "osnap""none")
)
(defun node()
  (command "osnap""node")
)
;------------------------------------------------------------------------------
(defun c:bandiem()
       (none)(node)
       (setvar "BLIPMODE" 0)
       (setvar "elevation" 0)
       (command "style" "txt" "txt" "0" "1" "0" "" "" "" )
       (setq h(* (getvar "dimcen") 1.5) )
       (setq p0(getpoint (strcat "\nBam diem khoi ?:")))
       (setq p1(getpoint  p0 (strcat "\nBam diem dinh huong ?:")))
       (setq agoc(angle p0 p1))
       (setq g  0)
       (while(/= g nil)
            (setq g(getreal (strcat "\nGoc ?: ")))
            (if (/= g nil)
                (progn
                     (setq s(getreal (strcat "\nCanh ?: ")))
                     (setq shd (getstring (strcat "\nDiem so ?: ")))
;                     (setq a(- agoc (dtor g)))
                     (setq a(- agoc g))
                     (setq p(polar p0 a s ))
                     (command "layer" "s" "0" "")
                     (setvar "BLIPMODE" 1)
                     (command "point" p )
                     (command "layer" "s" "0" "")
                     (command "text" p h "0" shd )
                     (setvar "BLIPMODE" 0)
                     (print)(print)
                )
            )
       )
       (redraw)
      (princ)
)


<<

Filename: 234691_bandiem.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 234691
Tên lệnh: bandiem xoay bandiem bandiem
Viết lisp để góc nhập vào dạng (Độ.phútgiây)

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

 

(defun dtor (str / do ph gi gt kq)
 (or cal (arxload "geomcal"))
 (setq do (substr str 1 (- (strlen str) 5)))
 (setq ph (substr (substr str (- (strlen str) 3) 4) 1 2))
 (setq gi (substr (substr str (- (strlen str) 3) 4) 3 2))
 (setq gt (strcat do "d" ph "'" gi "\""))
 (setq kq (* (/ pi 180) (cal gt)))
 kq)
;(defun dtor (gt / gt kq)...
>>

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

 

(defun dtor (str / do ph gi gt kq)
 (or cal (arxload "geomcal"))
 (setq do (substr str 1 (- (strlen str) 5)))
 (setq ph (substr (substr str (- (strlen str) 3) 4) 1 2))
 (setq gi (substr (substr str (- (strlen str) 3) 4) 3 2))
 (setq gt (strcat do "d" ph "'" gi "\""))
 (setq kq (* (/ pi 180) (cal gt)))
 kq)
;(defun dtor (gt / gt kq) (setq kq (* (/ pi 180) gt)) kq)
(defun none()
  (command "osnap""none"))
(defun node()
  (command "osnap""node"))
;------------------------------------------------------------------------------
(defun c:bandiem()
       (none)(node)
       (setvar "BLIPMODE" 0)
       (setvar "elevation" 0)
       (command "style" "txt" "txt" "0" "1" "0" "" "" "" )
       (setq h(* (getvar "dimcen") 1.5) )
       (setq p0(getpoint (strcat "\nBam diem khoi ?:")))
       (setq p1(getpoint  p0 (strcat "\nBam diem dinh huong ?:")))
       (setq agoc(angle p0 p1))
       (setq g  0)
       (while(/= g nil)
            (setq g(getstring (strcat "\nGoc ?: ")))
            (if (/= g nil)
                (progn
                     (setq s(getreal (strcat "\nCanh ?: ")))
                     (setq shd (getstring (strcat "\nDiem so ?: ")))
                     (setq a(- agoc (dtor g)))
                     (setq p(polar p0 a s ))
                     (command "layer" "s" "0" "")
                     (setvar "BLIPMODE" 1)
                     (command "point" p )
                     (command "layer" "s" "0" "")
                     (command "text" p h "0" shd )
                     (setvar "BLIPMODE" 0)
                     (print)(print)
                )))
       (redraw)
      (princ))
(defun C:XOAY( / goc)
 (vl-load-com)
 (command "undo" "be")
 (ssget (list (cons 0 "TEXT,MTEXT")))
 (vlax-for obj (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))
  (if (< 90 (/ (* 180 (setq goc (vla-get-Rotation obj))) pi) 270)
   (vla-put-Rotation obj (+ pi goc))))
 (command "undo" "e"))
(defun dtor (str / do ph gi gt kq)
 (or cal (arxload "geomcal"))
 (setq do (substr str 1 (- (strlen str) 5)))
 (setq ph (substr (substr str (- (strlen str) 3) 4) 1 2))
 (setq gi (substr (substr str (- (strlen str) 3) 4) 3 2))
 (setq gt (strcat do "d" ph "'" gi "\""))
 (setq kq (* (/ pi 180) (cal gt)))
 kq)
;(defun dtor (gt / gt kq) (setq kq (* (/ pi 180) gt)) kq)
(defun none()
  (command "osnap""none"))
(defun node()
  (command "osnap""node"))
;------------------------------------------------------------------------------
(defun c:bandiem()
       (none)(node)
       (setvar "BLIPMODE" 0)
       (setvar "elevation" 0)
       (command "style" "txt" "txt" "0" "1" "0" "" "" "" )
       (setq h(* (getvar "dimcen") 1.5) )
       (setq p0(getpoint (strcat "\nBam diem khoi ?:")))
       (setq p1(getpoint  p0 (strcat "\nBam diem dinh huong ?:")))
       (setq agoc(angle p0 p1))
       (setq g  0)
       (while(/= g nil)
            (setq g(getstring (strcat "\nGoc ?: ")))
            (if (/= g nil)
                (progn
                     (setq s(getreal (strcat "\nCanh ?: ")))
                     (setq shd (getstring (strcat "\nDiem so ?: ")))
                     (setq a(- agoc (dtor g)))
                     (setq p(polar p0 a s ))
                     (command "layer" "s" "0" "")
                     (setvar "BLIPMODE" 1)
                     (command "point" p )
                     (command "layer" "s" "0" "")
                     (command "text" p h "0" shd )
                     (setvar "BLIPMODE" 0)
                     (print)(print)
                )))
       (redraw)
      (princ))
(defun dtor (str / do ph gi gt kq)
 (or cal (arxload "geomcal"))
 (setq do (substr str 1 (- (strlen str) 5)))
 (setq ph (substr (substr str (- (strlen str) 3) 4) 1 2))
 (setq gi (substr (substr str (- (strlen str) 3) 4) 3 2))
 (setq gt (strcat do "d" ph "'" gi "\""))
 (setq kq (* (/ pi 180) (cal gt)))
 kq)
;(defun dtor (gt / gt kq) (setq kq (* (/ pi 180) gt)) kq)
(defun none()
  (command "osnap""none")
)
(defun node()
  (command "osnap""node")
)
;------------------------------------------------------------------------------
(defun c:bandiem()
       (none)(node)
       (setvar "BLIPMODE" 0)
       (setvar "elevation" 0)
       (command "style" "txt" "txt" "0" "1" "0" "" "" "" )
       (setq h(* (getvar "dimcen") 1.5) )
       (setq p0(getpoint (strcat "\nBam diem khoi ?:")))
       (setq p1(getpoint  p0 (strcat "\nBam diem dinh huong ?:")))
       (setq agoc(angle p0 p1))
       (setq g  0)
       (while(/= g nil)
            (setq g(getreal (strcat "\nGoc ?: ")))
            (if (/= g nil)
                (progn
                     (setq s(getreal (strcat "\nCanh ?: ")))
                     (setq shd (getstring (strcat "\nDiem so ?: ")))
;                     (setq a(- agoc (dtor g)))
                     (setq a(- agoc g))
                     (setq p(polar p0 a s ))
                     (command "layer" "s" "0" "")
                     (setvar "BLIPMODE" 1)
                     (command "point" p )
                     (command "layer" "s" "0" "")
                     (command "text" p h "0" shd )
                     (setvar "BLIPMODE" 0)
                     (print)(print)
                )
            )
       )
       (redraw)
      (princ)
)


<<

Filename: 234691_bandiem_xoay_bandiem_bandiem.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 234714
Tên lệnh: bandiem

Trang 129/330

129