Jump to content
InfoFile
Tác giả: huunhantvxdts
Bài viết gốc: 437421
Tên lệnh: napothong
code lips của em bị lỗi mọi người ai giúp em với em mới làm quen cái này gà mờ quá ạ
30 phút trước, thangtran216 đã nói:

 

>>
30 phút trước, thangtran216 đã nói:

Không biết bạn vẽ cái chi nhưng đang rỗi sửa lại cho bạn cho nó chạy được còn kết quả như nào thì do bạn viết

(defun c:napothong (/ d D Dp a b S )
   ;;int (cac goc hay dung)
   (setq g0 0
         g90 (* pi 0.5)
	 g180 pi
	 g270 (* pi 1.5) 
   )
   ;; luu cac bien he thong
   (setq osmode (getvar "osmode"))
   (setvar "osmode" 0)     ;; tat OSMODE
   (setq color (getvar "cecolor"))
   (setq lstnapo                 '(
				  ( 20 52 33 6 4.3 9)
				  ( 25 62 38 6 4.3 9)
				  (30 72 43 6 4.3 9)
				  (35 80 48 9 6.5 12)
				  (40 90 59 9 6.5 12)
				  (45 100 64 9 6.5 12)
				  (50 110 69 9 6.5 12)
				  (55 120 74 9 6.5 12)
				  (60 130 79 9 6.5 12)
				  (65 140 84 9 6.5 12)
				  (70 150 89 9 6.5 12)
				  )
   )
   ; nhap thong so cho nap o thong
  (setq d (getdist " nhap duong kinh truc d :  "))
  (setq pt00 (getpoint "chon dinh goc trai duoi: "))
  (setq h 20 )
  (setq napo (assoc d lstnapo))
  (setq d (nth 0 napo))
  (setq D (nth 1 napo))
  (setq Dp (nth 2 napo))
  (setq a  (nth 3 napo))
  (setq b  (nth 3 napo))
  (setq S  (nth 3 napo))
  (setq dvit 6.0)
   ;bat dau ve
  (setq pt01 (polar pt00 g180 (/ (+ D 30) 2)))
  (setq pt02 (polar pt01 g90 6.6))
  (setq pt03 (polar pt02 g0 16))
  (setq pt04 (polar pt03 g90 1))
  (setq pt05 (polar pt04 g180 1))
  (setq pt06 (polar pt05 g90 20))
  (setq pt07 (polar pt06 g0  5))
  (setq pt08 (polar pt07 g270 (- 25.6 S)))
  (setq pt08 (polar pt08 g0 (* (- 25.6 S ) 0.12278)))
  (setq pt09 (polar pt08 g0 ( - (- D 5) (* (- 25.6 S) 0.12278))))
  (setq pt10 (polar pt09 g270  (/ (- S a))))
  (setq pt11 (polar pt10 g270 (/ (- a b) 2)))
  (setq pt11 (polar pt11 g180 (/ (- Dp d) 2)))
  (setq pt12 (polar pt11 g270 b ))
  (setq pt13 (polar pt12 g0 (/ (- Dp d) 2)))
  (setq pt13 (polar pt13 g270 (/ (- Dp d) 2)))
  (setq pt14 (polar pt13 g270 (/ (- S a) 2)))
  (setq pt15 (polar pt07 g270 25.6 ))
  (setq pt16 (polar pt15 g270 1))
  (setq pt17 (polar pt14 g270 1))
  (setq pt18 (polar pt00 g90 26.6))
  ;ve mang 1
  (setq ss (ssadd))
  (command ".pline" pt01 pt02 pt03 pt04 pt05 pt06 pt07 pt08 pt09 pt10 
                    pt11 pt12 pt13 pt14 pt15 pt16 pt01 "")
  (command ".-hatch" "p" "ANSI31" 15 0 "")
  (ssadd (entlast) ss)
   ;ve mang 2
  (command ".pline" pt15 pt16 pt17 pt16 "")
  (ssadd (entlast) ss)
  ;doi xung
  (setq ss1 (ss-mirror ss pt18 pt00 1))
   (ssadd (entlast) ss)
   (proc)
 )
(defun ss-mirror (ss p1 p2 flag / ent ss1 num ind)
  (if (null ss)
    (setq ss1 NIL)
    (progn
      (if (= flag 0)
	(progn
	  (command "._mirror" ss "" p1 p2 "n" )
	  (setq ss1 ss)
	  )
	(progn
	  (setq ss1 (ssadd))
	  (setq num (sslength ss))
	  (setq ind 0)
	  (while (< ind num)
	    (setq ent (ssname ss ind))
	    (command ".mirror" ent "" p1 p2 "n")
	    (ssadd (entlast) ss1)
	    (setq ind (1+ ind))
	    ) ;while
	  ) ;progn
	); if flag
      ); progn
    ); if ss not null
  ss1
 );defun 

 


<<

Filename: 437421_napothong.lsp
Tác giả: Tuynh
Bài viết gốc: 72231
Tên lệnh: 2d3d
Lisp thay đổi độ cao node của PL-DONE
Lisp này viết theo ý của bạn. Hy vọng bạn hài lòng :

(defun c:2d3d(/ curve pre i p lstdiem z lstpoint x xo)
(vl-load-com)
(setvar "orthomode" 0)
(setvar "cmdecho" 0)
(setq...
>>
Lisp này viết theo ý của bạn. Hy vọng bạn hài lòng :

(defun c:2d3d(/ curve pre i p lstdiem z lstpoint x xo)
(vl-load-com)
(setvar "orthomode" 0)
(setvar "cmdecho" 0)
(setq curve (car(entsel "\n Pick chon POlyline 2D hoac Polyline 3D :")))
(setq pre (vlax-curve-getEndParam curve) i 0 lstdiem '() lstpoint '())

(while (<= i pre)
(setq p (vlax-curve-getPointAtParam curve i))
(setq lstdiem (append lstdiem (list p)))
(setq i (1+ i))
)

(setq i 0)
(foreach x lstdiem
(setq xo (caddr x))
(setq z (getdist x (strcat "\n Nhap cao do cho diem nay <" (rtos xo 2 2) "> : ") ))
(setq lstpoint (append lstpoint (list(list (car x) (cadr x) z))))
(setq i (1+ i))
)

(command "3dpoly"
(foreach x lstpoint (command x)))
(entdel curve)
(princ)
)


<<

Filename: 72231_2d3d.lsp
Tác giả: tamnv4
Bài viết gốc: 321839
Tên lệnh: cl ck
sửa lisp đổi màu đối tượng

 

Lsp của nhoc phải nhấp ngay cái dimtext thì nó mới làm.

Sửa cái lsp của chủ thớt.

 

(defun...
>>

 

Lsp của nhoc phải nhấp ngay cái dimtext thì nó mới làm.

Sửa cái lsp của chủ thớt.

 

(defun changecolor (en col)
  (if (= (cdr (assoc 0 (entget en))) "DIMENSION")
    (vlax-for item (vla-item (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object)))
  (cdr (assoc 2 (entget en))))
      (if (= "AcDbMText" (vla-get-ObjectName item)) (vla-put-Color item col))
    )
    (command "change" en "" "P" "c" col "")
  )
)
 
(defun c:cl (/ m ss)
  (command "undo" "be") (setvar 'cmdecho 0)
  (princ "\nChon doi tuong muon doi mau:")
  (setq ss (ssget))
  (princ "\nChon mau muon doi :") (setq m (acad_colordlg 7))
  (mapcar '(lambda (x) (changecolor x m)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
  (vl-cmdf "regen")
  (command "undo" "end") (setvar 'cmdecho 1)
  (setvar "MODEMACRO" "**KTS_DUY**")
  (princ)
)
 
(defun c:ck (/ m ss)
  (command "undo" "be") (setvar 'cmdecho 0)
  (princ "\nChon doi tuong muon doi mau:")
  (setq ss (ssget))
  (setq m (getint "\nChon mau muon doi: "))
  (mapcar '(lambda (x) (changecolor x m)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
  (vl-cmdf "regen")  
  (command "undo" "end") (setvar 'cmdecho 1)
  (setvar "MODEMACRO" "**KTS_DUY**")
  (princ)
)
 
mình không hiểu biến hệ thống modemacro là gì


<<

Filename: 321839_cl_ck.lsp
Tác giả: dunguss3581
Bài viết gốc: 353220
Tên lệnh: cpl
Nhờ viết lisp copy text, kết quả đổi sang layer hiện hành

 

Đây!

(defun c:cpl (/ ss pt1 pt2)
 (if
  (and
   (setq ss (ssget "_:L"))
   (setq pt1 (getpoint...
>>

 

Đây!

(defun c:cpl (/ ss pt1 pt2)
 (if
  (and
   (setq ss (ssget "_:L"))
   (setq pt1 (getpoint "\nSpecify base point: "))
   (setq pt2 (acet-ss-drag-move ss pt1 "\nSpecify second point: ")))
  (cpl ss pt1 pt2))
 (princ)) 
(defun cpl (ss pt1 pt2 / i sn)  
 (repeat (setq i (sslength ss))
  (setq sn (vla-copy (vlax-ename->vla-object (ssname ss (setq i (1- i))))))
  (vla-move sn (vlax-3d-point pt1) (vlax-3d-point pt2))
  (vla-put-layer sn (getvar "cLayer"))))

bác giúp tôi cái: có cách nào ngắn gọn cho việc thay đổi lớp một đối tượng vừa tạo ra của bản vẽ không? code ntn?


<<

Filename: 353220_cpl.lsp
Tác giả: mr.thanh2610
Bài viết gốc: 437496
Tên lệnh: sb1
Về Lisp chọn nhanh đối tượng Block

Chào các anh chị em, tình hình mình sưu tầm được một Lisp chọn nhanh các đối tượng Block của bác Doan Van Ha nhưng chắc do topic mở lâu quá nên mình có nhờ chỉnh sửa mà chưa thấy hồi âm.

Nên hôm nay mạn phép nhờ anh em trong diễn đàn chỉnh sửa giúp mình:

Nội dung: lisp chọn được tất cả loại block nhưng chưa cho chọn Dynamic Block, có anh em nào rành về code chỉnh giúp...

>>

Chào các anh chị em, tình hình mình sưu tầm được một Lisp chọn nhanh các đối tượng Block của bác Doan Van Ha nhưng chắc do topic mở lâu quá nên mình có nhờ chỉnh sửa mà chưa thấy hồi âm.

Nên hôm nay mạn phép nhờ anh em trong diễn đàn chỉnh sửa giúp mình:

Nội dung: lisp chọn được tất cả loại block nhưng chưa cho chọn Dynamic Block, có anh em nào rành về code chỉnh giúp mình với nhé, xin cảm ơn

;; free lisp from cadviet.com
;;; this lisp was downloaded from https://www.cadviet.com/forum/topic/61169-y%C3%AAu-c%E1%BA%A7u-lisp-l%E1%BB%8Dc-c%C3%A1c-block-c%C3%B9ng-t%C3%AAn/
; Chon tap block theo ten cua tap block mau.
(defun C:SB1 ( / i str ent)
 (setq i 2 str (cdr (assoc 2 (entget (car (entsel (strcat "\nChon Block mau 1: ")))))))
 (while (setq ent (car (entsel (strcat "\nChon Block mau " (itoa i) ": "))))
  (setq str (strcat str "," (cdr (assoc 2 (entget ent)))))
  (setq i (1+ i)))
 (princ "\nChon cac Block can thong ke...")
 (sssetfirst nil (ssget (list (cons 0 "INSERT") (cons 2 str)))))

 


<<

Filename: 437496_sb1.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 437552
Tên lệnh: sb1
Về Lisp chọn nhanh đối tượng Block

Không có máy test. Thử xem:


;----- Chon tap hop blocks dynamic theo ten cua tap hop blocks dynamic mau.
(defun C:SB1 ( / i str ent)
 (setq i 2 str (cdr (assoc 2 (entget (car (entsel (strcat "\nChon Block mau 1: ")))))))
 (while (setq ent (car (entsel (strcat "\nChon Block mau " (itoa i) ": "))))
 (setq str (strcat str "," (cdr (assoc 2 (entget ent)))))
 (setq i (1+ i)))
 (princ "\nChon cac Block can thong ke...")
 (setq ss (ssget (list...
>>

Không có máy test. Thử xem:


;----- Chon tap hop blocks dynamic theo ten cua tap hop blocks dynamic mau.
(defun C:SB1 ( / i str ent)
 (setq i 2 str (cdr (assoc 2 (entget (car (entsel (strcat "\nChon Block mau 1: ")))))))
 (while (setq ent (car (entsel (strcat "\nChon Block mau " (itoa i) ": "))))
 (setq str (strcat str "," (cdr (assoc 2 (entget ent)))))
 (setq i (1+ i)))
 (princ "\nChon cac Block can thong ke...")
 (setq ss (ssget (list (cons 0 "INSERT") (cons 2 str))))
 (repeat (setq n (sslength ss))
  (setq n (1- n) ent (ssname ss n))
  (if (eq (vla-get-IsDynamicBlock (vlax-ename->vla-object ent)) :vlax-false)
   (ssdel ent ss)))
 (sssetfirst nil ss))


<<

Filename: 437552_sb1.lsp
Tác giả: ngokiet
Bài viết gốc: 437570
Tên lệnh: ss1
Về Lisp chọn nhanh đối tượng Block
1 giờ trước, mr.thanh2610 đã nói:

hjx, vẫn như cũ bác ạ...

>>
1 giờ trước, mr.thanh2610 đã nói:

hjx, vẫn như cũ bác ạ T_T

(defun c:ss1(/ s1)
  (princ "\nChon cac block mau:")
  (or (Setq s1 (mapcar '(lambda(x) (vla-get-effectivename(vlax-ename->vla-object x)))
		     (acet-ss-to-list (ssget '((0 . "INSERT"))))))
      (exit))
  (princ "\nChon vung blocks:")
  (sssetfirst nil
    (acet-list-to-ss
      (vl-remove-if-not
	'(lambda(x) (member (vla-get-effectivename(vlax-ename->vla-object x)) s1))
	(acet-ss-to-list (ssget '((0 . "INSERT"))))))))

Thử lisp này xem. Chọn ban đầu bao nhiêu block mẫu cùng 1 lúc cũng được.


<<

Filename: 437570_ss1.lsp
Tác giả: vbao
Bài viết gốc: 4456
Tên lệnh: noitext
Nối các điểm chèn text thành những đoạn thẳng theo yêu cầu
Tên lệnh là NOITEXT.

Lệnh sẽ yêu cầu người sử dụng chọn các text.

Sau đó sẽ so sánh giá trị của các text và nối line vào điểm chèn các text theo thứ...

>>
Tên lệnh là NOITEXT.

Lệnh sẽ yêu cầu người sử dụng chọn các text.

Sau đó sẽ so sánh giá trị của các text và nối line vào điểm chèn các text theo thứ tự tăng dần (hoặc giảm dần).

 

(defun c:noitext ()
 (defun ss2ent	(ss / sodt index lstent)
   (setq
     sodt  (cond
      (ss (sslength ss))
      (t 0)
    )
     index 0
   )
   (repeat sodt
     (setq ent	   (ssname ss index)
    index  (1+ index)
    lstent (cons ent lstent)
     )
   )
   (reverse lstent)
 )
 (defun luuos ()
   (setq
     HOANH_OSMODE   (getvar "OSMODE")
     HOANH_AUTOSNAP (getvar "AUTOSNAP")
   )
 )
 (defun traos ()
   (if	HOANH_OSMODE
     (setvar "OSMODE" HOANH_OSMODE)
   )
   (if	HOANH_AUTOSNAP
     (setvar "AUTOSNAP" HOANH_AUTOSNAP)
   )
 )
 (defun sosanhtext (ent1 ent2)
   (> (cdr (assoc 1 (entget ent1)))
      (cdr (assoc 1 (entget ent2)))
   )
 )
 (princ "\nNoitext © 2007 - CADViet.com")
 (setq
   ss	   (ssget '((0 . "TEXT")))
   lstent (ss2ent ss)
   lstent (vl-sort lstent 'sosanhtext)
 )
 (luuos)
 (setvar "osmode" 0)
 (command ".line")
 (foreach pp lstent
   (setq p (trans (cdr (assoc 10 (entget pp))) 0 1))
   (command p)
 )
 (command "")
 (traos)
 (princ)
)
(vl-load-com)
(princ "\nNoiText - chuong trinh noi cac diem chen cua text bang cac line")
(princ "\n© 2007 - CADViet.com")
(princ)

 

vô cùng khâm phục, anh Hoành viết code nhanh thật một lần nữa chân thành cảm ơn anh


<<

Filename: 4456_noitext.lsp
Tác giả: dnhqs
Bài viết gốc: 11245
Tên lệnh: vd
Nối các điểm chèn text thành những đoạn thẳng theo yêu cầu
Câu trả lời nằm ở các chương trình lisp đã post lên có liên quan. Ji nói như vậy dựa trên cơ sở bạn là lập trình viên lisp chứ không phải user thông thường!

Nếu chưa thông...

>>
Câu trả lời nằm ở các chương trình lisp đã post lên có liên quan. Ji nói như vậy dựa trên cơ sở bạn là lập trình viên lisp chứ không phải user thông thường!

Nếu chưa thông thì ssg gợi ý tiếp:

1) Chọn các text màu magenta trong bản vẽ của bạn: (ssget '((0 . "TEXT") (62 . 6)))

2) Chọn 2 "thằng" text gần điểm C nhất? Bạn xem lại hàm getntv ở topic "Lấy thuộc tính từ block" (của chính bạn lập), bổ sung một chút là có ngay.

3) Lấy giá trị và toạ độ của 1 thằng text bất kỳ? Bạn thử ví dụ sau:

(defun C:VD()
(setq
e (car (entsel "Select a text object:"));;;Text entity
d (entget e);;;Database of e
txt (cdr (assoc 1 d));;;Text value of e
p (cdr (assoc 10 d));;;Insert point of e
)
;;;Report
(alert (strcat
		  "\nREPORT"
		  "\nText value = " txt
		  "\n Insert point = " (rtos (car p)) ";" (rtos (cadr p)) ";" (rtos (caddr p))
	 )
)
)

Lưu ý: lấy toạ độ point thì cũng như trên thôi, dxf 10 luôn dành cho toạ độ, bất kể đối tượng là gì.

4) Tạo ra line, pline và text? Chuyện thường ngày của lập trình viên lisp!

Hy vọng rằng với những gợi ý trên, bạn sẽ tự giải quyết được.

ssg nhầm rồi, mình chẳng phải là "lập trình viên" gì sất. Trước đây mình tự học lisp từ mấy cuốn sách của Nguyễn Hữu Lộc, nhưng mà khi bí thì chả biết hỏi ai. mình ở vùng quê nên cũng ít được tiếp xúc với "văn minh" cho mấy. Thậm chí chỗ mình mấy thằng còn vẽ thiết kế bằng bút kim nữa kìa. Từ ngày vào diễn đàn này mình học được nhiều lắm. ssg biết không thực sự mình cũng không muốn hỏi những câu hỏi "buồn cười" ấy đâu nhưng thực sự bí.

à! trước mắt cảm ơn ssg về gợi ý trên nếu có gì chưa rõ mình sẽ tiếp tục "cầu cứu"

còn lấy thuộc tính của block mình loay hoay hoài mà chưa được


<<

Filename: 11245_vd.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 437623
Tên lệnh: sb2
Về Lisp chọn nhanh đối tượng Block

Mê bác Hạ mà không mê bác Kiệt. Ngộ!


;----- Chon tap hop blocks (ke ca block dynamic) theo ten cua tap hop blocks mau.
(defun C:SB2 ( / i str ent)
 (setq i 2 str (vla-get-effectivename(vlax-ename->vla-object (car (entsel (strcat "\nChon Block mau 1: "))))))
 (while (setq ent (car (entsel (strcat "\nChon Block mau " (itoa i) ": "))))
 (setq str (strcat str "," (vla-get-effectivename(vlax-ename->vla-object  ent))))
 (setq i (1+...
>>

Mê bác Hạ mà không mê bác Kiệt. Ngộ!


;----- Chon tap hop blocks (ke ca block dynamic) theo ten cua tap hop blocks mau.
(defun C:SB2 ( / i str ent)
 (setq i 2 str (vla-get-effectivename(vlax-ename->vla-object (car (entsel (strcat "\nChon Block mau 1: "))))))
 (while (setq ent (car (entsel (strcat "\nChon Block mau " (itoa i) ": "))))
 (setq str (strcat str "," (vla-get-effectivename(vlax-ename->vla-object  ent))))
 (setq i (1+ i)))
 (princ "\nChon cac Block can thong ke...")
 (setq ss (ssget (list (cons 0 "INSERT"))))
 (repeat (setq n (sslength ss))
  (setq n (1- n) ent (ssname ss n))
  (if (not (wcmatch (vla-get-effectivename(vlax-ename->vla-object ent)) str))
   (ssdel ent ss)))
 (sssetfirst nil ss))
(vl-load-com)


<<

Filename: 437623_sb2.lsp
Tác giả: Doan Nguyen Van
Bài viết gốc: 437501
Tên lệnh: test
Về Lisp chọn nhanh đối tượng Block
1 giờ trước, mr.thanh2610 đã nói:

Chào các anh chị em, tình...

>>
1 giờ trước, mr.thanh2610 đã nói:

Chào các anh chị em, tình hình mình sưu tầm được một Lisp chọn nhanh các đối tượng Block của bác Doan Van Ha nhưng chắc do topic mở lâu quá nên mình có nhờ chỉnh sửa mà chưa thấy hồi âm.

Nên hôm nay mạn phép nhờ anh em trong diễn đàn chỉnh sửa giúp mình:

Nội dung: lisp chọn được tất cả loại block nhưng chưa cho chọn Dynamic Block, có anh em nào rành về code chỉnh giúp mình với nhé, xin cảm ơn

  • sb1.lsp
    lisp help
  •  

;; free lisp from cadviet.com
;; this lisp was downloaded from https://www.cadviet.com/forum/topic/61169-y%C3%AAu-c%E1%BA%A7u-lisp-l%E1%BB%8Dc-c%C3%A1c-block-c%C3%B9ng-t%C3%AAn/
; Chon tap block theo ten cua tap block mau.
(defun C:SB1 ( / i str ent)
 (setq i 2 str (cdr (assoc 2 (entget (car (entsel (strcat "\nChon Block mau 1: ")))))))
 (while (setq ent (car (entsel (strcat "\nChon Block mau " (itoa i) ": "))))
  (setq str (strcat str "," (cdr (assoc 2 (entget ent)))))
  (setq i (1+ i)))
 (princ "\nChon cac Block can thong ke...")
 (sssetfirst nil (ssget (list (cons 0 "INSERT") (cons 2 str)))))

 

(defun c:test(/ rn ssblk blkName)(vl-load-com)
(prompt "\nChon Block mau :")
(setq   rn (lambda(x)(vla-get-EffectiveName (vlax-ename->vla-object x)))
 blkName (rn (ssname (ssget ":S" (list (cons 0 "INSERT"))) 0)))
(prompt "\nChon khu vuc chua Block :")
(setq ssBlk (ssget (list (cons 0 "INSERT")(cons 2 (strcat "`*U*," blkName)))))
(mapcar '(lambda(x)(if (not (eq (rn x) blkName))(ssdel x ssblk)))
(mapcar 'cadr (vl-remove-if '(lambda(x)(listp (cadr x))) (ssnamex ssBlk)))) ;hoac thay bang acet neu thich nhe ^^
(sssetfirst nil ssBlk)
)

Search Diễn đàn có bài này của a Tùng chọn được block Dynamic nè bạn

 


<<

Filename: 437501_test.lsp
Tác giả: anhGeodesy
Bài viết gốc: 437679
Tên lệnh: gt cl
Xin lisp chèn ký tự vào Dimension như ảnh dưới.
5 giờ trước, NGUYENVANHIEUGTVT đã nói:

Bác nào có lisp gì...

>>
5 giờ trước, NGUYENVANHIEUGTVT đã nói:

Bác nào có lisp gì mà add vào 1 dim bước thép và đường kính thép như này đc k ạ

z1428960583018_b9d03108c595e56751abae9385f6b35d.thumb.jpg.8769aec364fc912d6a986f4f46df081f.jpg

@NGUYENVANHIEUGTVT Trên diễn đàn có rồi.

;https://www.cadviet.com/forum/topic/175922-nh%E1%BB%9D-s%E1%BB%ADa-lip-t%C3%ADnh-c%E1%BB%91t-%C4%91ai-v%C3%A0-ghi-v%C3%A0o-trong-dim/
;-------------------------------------------------------------------------------------------------------------------------
;          ==============>>  GT: TINH SL DAI VA GHI VAO DIM <<================ 
;-------------------------------------------------------------------------------------------------------------------------
(prompt "")
(defun C:gt (/ ctc ss d *d* *ctc*)
  (or *ctc* (setq *ctc* 200))
  (or *d* (setq *d* 10))
  (initget 6)
  (setq    ctc (getint
          (strcat "\nNh\U+1EADp b\U+01B0\U+1EDBc th\U+00E9p < "
              (itoa *ctc*)
              ">:"
          ) ;_ end of strcat
        ) ;_ end of getint
  ) ;_ end of setq
  (if ctc
    (setq *ctc* ctc)
  ) ;_ end of if
  (setq    d (getstring
          (strcat "\nNh\U+1EADp \U+0110\U+01B0\U+1EDDng k\U+00EDnh th\U+00E9p (Phi) < "
               (itoa *d*)
              ">:"
          ) ;_ end of strcat
        ) ;_ end of getint
  )
  (if d
    (setq *d* d)
  )
  (if (setq ss (ssget "_:L" (list (cons 0 "DIMENSION"))))
    (progn
      (command "_.undo" "_begin")
      (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    (vla-put-TextOverride
      (vlax-ename->vla-object ent)
;;;      (strcat
;;;        "<>\\X"
;;;;;;        (itoa (+ (fix (/ (cdr (assoc 42 (entget ent))) *ctc*)) 1))
;;;        (itoa (+ (fix (/ (- (cdr (assoc 42 (entget ent)))200) *ctc*)) 1))
;;;        ;"%%c10A"
;;;        (strcat "%%c" d "a")
;;;        (itoa *ctc*)
;;;      ) ;_ end of strcat

(strcat
;;;        (itoa (+ (fix (/ (cdr (assoc 42 (entget ent))) *ctc*)) 1))
;;;  "<> ="
  "<>\\X"
        (itoa (+ (fix (/ (- (cdr (assoc 42 (entget ent)))200) *ctc*)) 1))
        ;"%%c10A"
            (strcat "%%c" d "a")
        (itoa *ctc*)
;;;" - <>"
      ) ;_ end of strcat?

      
    ) ;_ end of vla-put-TextOverride
      ) ;_ end of foreach
      (command "_.undo" "_end")
      (princ)
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun
(defun C:cl (/ num ss)
  (if (setq ss (ssget "_:L"))
    (progn
      (command "_.undo" "_begin")
      (or *num* (setq *num* 15))
      (initget 4)
      (setq num (getint (strcat "\nNhap color <" (itoa *num*) ">:")))
      (while (not (if num
            (<= num 256)
            T
          ) ;_ end of if
         ) ;_ end of not
    (princ "\nGia tri <=256.")
    (setq num (getint (strcat "\nNhap color <" (itoa *num*) ">:")))
      ) ;_ end of while
      (if num
    (setq *num* num)
      ) ;_ end of if
      (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    (vla-put-Color (vlax-ename->vla-object ent) *num*)
      ) ;_ end of foreach
      (command "_.undo" "_end")
      (princ)
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun

 


<<

Filename: 437679_gt_cl.lsp
Tác giả: Doan Nguyen Van
Bài viết gốc: 437699
Tên lệnh: tt
Hỏi về cách chuyển đổi tọa độ
24 phút trước, Black_Cat_ đã nói:

 

1. ý em là có...

>>
24 phút trước, Black_Cat_ đã nói:

 

1. ý em là có cái phần mềm nào hoặc lisp để em chuyển đổi cho nhanh hơn ấy anh...là em nhập vô là nó tự chuyển đổi ra luôn ạ

2. Là sau khi em vẽ bản vẽ mặt bằng của một dự án thì nó chưa có tọa độ , em phải gán tọa độ cho bản vẽ đó, thông thường là em sử dụng lệnh AL để gán, không biết có tool hay lisp gì để gán nhanh hơn không anh??

(defun c:tt (/ tdx tdy ss pt)
  (setq tdx (getangle "\nNh\U+1EADp t\U+1ECDa \U+0111\U+1ED9 X: ")
	tdy (getangle "\nNh\U+1EADp t\U+1ECDa \U+0111\U+1ED9 Y: "))
  (setq tdx (/ (* tdx 180) pi)
	tdy (/ (* tdy 180) pi))
  (princ "\nQuet Chon Doi Tuong")
  (setq ss (ssget))
  (setq pt (getpoint "Diem Chuan"))
  (if (and ss tdx tdy pt)
    (command "move" ss "" "_non" pt "_non" (list tdx tdy)))
(sssetfirst nil ss)
  )

Không chuyên mảng bản đồ nhưng viết thử cho bạn lisp này. Ở bước nhập tọa độ. Ví dụ:  10°47'34.04"N thì nhập là 10d47'34.04"


<<

Filename: 437699_tt.lsp
Tác giả: huunhantvxdts
Bài viết gốc: 437745
Tên lệnh: chen
Chèn block bằng một lệnh

6 giờ trước, HOAILINHLINH đã nói:

 

>>
6 giờ trước, HOAILINHLINH đã nói:

Block mình sửa lại rồi nhé bạn xem chỉnh sửa theo yêu cầu của bạn, cái block của bạn có qua nhiều block chồng block

Lisp mình sửa thêm cho hợp lý, pick khi mô mỏi tay thì enter nhé

(defun c:CHEN ( / BLOCK_NAME PT)
  (setq block_name "D:/Block/trudientron.dwg")
  (while (setq PT (getpoint "\nPick diem chen block tru dien:"))
  (command "insert" block_name "non" PT 1 "" "")
  )
  (princ)
 )

 

Block.rar

2019-06-25.png

2019-06-25 (1).png


<<

Filename: 437745_chen.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 436954
Tên lệnh: ha3
Tìm chỗ bị hở khi vùng chưa khép kín

5 phút trước, AUTOCAD_2019 đã nói:

em muốn vẽ circle tại hai...

>>
5 phút trước, AUTOCAD_2019 đã nói:

em muốn vẽ circle tại hai điểm hở ạ


(defun C:HA3(/ bk ho ss i j e1 e2 sta1 end1 sta2 end2 dis1 dis2 dis3 dis4 dis5)
 (setq bk (/ (getvar "viewsize") 100)) ; user co the sua so 100 de lay ban kinh
 (setq ho (getreal "\nNhap khoang cach ho min: "))
 (princ "\nChon cac doi tuong kiem tra do ho...")
 (setq ss (ssget '((0 . "ARC,*LINE"))))
 (repeat (setq i (sslength ss))
  (setq i (1- i) e1 (ssname ss i) sta1 (vlax-curve-getstartpoint e1) end1 (vlax-curve-getendpoint e1) dis1 (distance sta1 end1))
  (if (< dis1 ho) (progn (VePoint-GR sta1 bk 1) (MkCircle end1 bk 1)))
  (repeat (setq j (sslength ss))
   (setq j (1- j) e2 (ssname ss j) sta2 (vlax-curve-getstartpoint e2) end2 (vlax-curve-getendpoint e2))
   (setq dis2 (distance end1 end2) dis3 (distance end1 sta2) dis4 (distance sta1 sta2) dis5 (distance sta1 end2))
   (if (< dis2 ho) (progn (MkCircle end1 bk 1) (MkCircle end2 bk 1)))
   (if (< dis3 ho) (progn (MkCircle end1 bk 1) (MkCircle sta2 bk 1)))
   (if (< dis4 ho) (progn (MkCircle sta1 bk 1) (MkCircle sta2 bk 1)))
   (if (< dis5 ho) (progn (MkCircle sta1 bk 1) (MkCircle end2 bk 1))))))
(defun MkCircle(pt bk col)
 (entmake (list '(0 . "CIRCLE") (cons 62 col) (cons 10 pt) (cons 40 bk))))
(vl-load-com)   


<<

Filename: 436954_ha3.lsp
Tác giả: hhhhgggg
Bài viết gốc: 121175
Tên lệnh: cp
cách chọn đối tượng vừa được copy ra ?
Nếu vẫn là đối tượng cuối cungùng, thì lisp bác Tuệ dùng cho multi cũng đẹp rồi :undecided:

 

;; free lisp from cadviet.com

(defun c:cp( / ss frome toe...
>>
Nếu vẫn là đối tượng cuối cungùng, thì lisp bác Tuệ dùng cho multi cũng đẹp rồi :undecided:

 

;; free lisp from cadviet.com

(defun c:cp( / ss frome toe cur obj po1 po2)
(setvar "grips" 0)
(Command "undo" "be")
(setq frome (entlast));; chon doi tuong cuoi cung truoc khi Copy

(Prompt "\nChon doi tuong :")
(setq obj (ssget))
(sssetfirst obj obj)

(setq po1 (getpoint "\n Base point : "))
(setq po2 (getpoint po1 "\n Specify second point of displacement : "))
(Command "Copy" "p" "" po1 po2)
(setq toe (entlast));; chon doi tuong cuoi cung sau khi Copy

(setq cur frome; khoi tao
ss (ssadd)
)
(while (not (eq cur toe));; chon cac doi tuong tu frome den toe
(setq
cur (entnext cur)
ss (ssadd cur ss)
)
)

(sssetfirst ss ss);; highlight ket qua

(setq po1 po2)

(while

(setq po2 (getpoint po1 "\n Specify second point of displacement : "))
(setq frome (entlast))
(Command "Copy" ss "" po1 po2)
(setq toe (entlast))

(setq cur frome; khoi tao
ss (ssadd)
)
(while (not (eq cur toe));; chon cac doi tuong tu frome den toe
(setq
cur (entnext cur)
ss (ssadd cur ss)
)
)
(setq po1 po2)
(sssetfirst ss ss);; highlight ket qua
)

(setvar "grips" 1)
(Command "undo" "end")
(princ)
)

CÒn nếu là chọn toàn bộ các đối tượng từ lúc bắt đầu đến lúc kết thúc copy thì thay đổi chút ^^

em ko hiểu cái lisp "CP" của bác để làm gì ? Nếu khó khăn quá thì bác sửa thành Move các đối tượng sinh ra cuối cùng của lệnh copy vừa được thực hiện đi ạ ?


<<

Filename: 121175_cp.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 437849
Tên lệnh: ha
NHỜ GIÚP ĐỠ VIẾT LISP CHỌN KÝ TỰ SỐ TRONG TEXT

Câu hỏi khá hời hợt nên chỉ làm cho bạn đến đây (lệnh "HA", bấm F2 để xem kết quả). Mọi y/c thêm đều không đáp ứng.


; Nhom list text tren ban ve thanh tung nhom theo so luong ten trung nhau, 28/06/2019. 
; Yeu cau cac ky tu trong 1 text phai viet lien nhau.
; VD tren ban ve co cac Texxt: 12A+23B+34C ; 1A+2B+3C' ; 2B+3A'+4C ; 2B ; 2A'+23B'+34C ; 12C1+3B'+4C' >> nhom thanh: (("A" 13) ("A'" 15) ("B" 29)...
>>

Câu hỏi khá hời hợt nên chỉ làm cho bạn đến đây (lệnh "HA", bấm F2 để xem kết quả). Mọi y/c thêm đều không đáp ứng.


; Nhom list text tren ban ve thanh tung nhom theo so luong ten trung nhau, 28/06/2019. 
; Yeu cau cac ky tu trong 1 text phai viet lien nhau.
; VD tren ban ve co cac Texxt: 12A+23B+34C ; 1A+2B+3C' ; 2B+3A'+4C ; 2B ; 2A'+23B'+34C ; 12C1+3B'+4C' >> nhom thanh: (("A" 13) ("A'" 15) ("B" 29) ("B'" 26) ("C" 72) ("C'" 7) ("C1" 12))
(defun C:HA(/ lst1 lst2 lst3)
 (princ "\nChon cac Text can cong...")
 (setq lst1 (Ss->Lst (ssget '((0 . "*Text"))) nil))
 (setq lst2 (apply 'append (mapcar '(lambda(e) (String->ListString (cdr (assoc 1 (entget e))) "+")) lst1)))
 (setq lst3 (mapcar '(lambda(x) (setq so(atoi x) sostr (itoa so) loai (substr x (1+ (strlen sostr)) (strlen x))) (list loai so)) lst2))
 (vl-sort (mapcar '(lambda(x) (setq loai (car x) sl (apply '+ (mapcar 'cadr (cdr x)))) (list loai sl)) (GroupBy 'car lst3)) '(lambda(x y) (< (car x) (car y)))))
(defun String->ListString(str del / pos lst)
 (while (setq pos (vl-string-search del str)) (setq lst (cons (substr str 1 pos) lst) str (substr str (+ pos 1 (strlen del))))) (reverse (cons str lst)))
(defun Ss->Lst (ss flag / lst)
 (and ss (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) (if flag (setq lst (mapcar 'vlax-ename->vla-object lst)))) lst)
(defun GroupBy (fun lst / key sub res)
 (setq fun (eval fun))
 (mapcar '(lambda (l) (cons (car l) (reverse (cdr l)))) (foreach l lst (setq res (if (setq sub (assoc (setq key (fun l)) res)) (subst (vl-list* key l (cdr sub)) sub res) (cons (list key l) res))))))


<<

Filename: 437849_ha.lsp
Tác giả: trieubb
Bài viết gốc: 75542
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ỳ
Bạn thử Code này nhé :

 
(defun c:ckc(/ oldim ent ndung po1 po2 po3 S entl ndung1)
(setq oldim (getvar "DIMZIN"))
(setvar "DIMZIN" 0)
(setq ent (car(entsel "\n Pick chon text...
>>
Bạn thử Code này nhé :

 
(defun c:ckc(/ oldim ent ndung po1 po2 po3 S entl ndung1)
(setq oldim (getvar "DIMZIN"))
(setvar "DIMZIN" 0)
(setq ent (car(entsel "\n Pick chon text :")))
(setq ndung (atof(cdr(assoc 1 (entget ent)))))

(if (not tpo) (setq tpo 0)) 
(setq tp (getint (strcat "\n So chu so thap phan <" (itoa tpo) "> :")))
(if (not tp) (setq tp tpo) (setq tpo tp))

(setq po1 (getpoint "\n Pick diem A :"))
(setq po2 (getpoint po1 "\n Pick diem B :"))
(setq S (distance po1 po2))

(Command "copy" ent "" po1 po2)
(setq entl (entget (entlast)))

(setq ndung1 (+ ndung S))

(setq entl (entmod (subst (cons 1 (rtos ndung1 2 tp)) (assoc 1 entl) entl)))  

(while 
(setq po3 (getpoint po2 "\n Pick diem tiep theo de tinh khoang cach/ Enter de ket thuc :"))
(setq S (+ S (distance po2 po3)))

(Command "copy" "L" "" po2 po3)
(setq entl (entget (entlast)))

(setq ndung1 (+ ndung S) po2 po3)

(setq entl (entmod (subst (cons 1 (rtos ndung1 2 tp)) (assoc 1 entl) entl)))
)

;(alert (strcat "Tong S = " (rtos S)))
(setvar "DIMZIN" oldim)
(princ)
)

:bigsmile:

 

Bạn nên sửa lisp này

các số sau phải nằm đúng giữa AB, BC ....

tức là giữa po1, po2 ... ấy

chứ không thì rối dắm lắm


<<

Filename: 75542_ckc.lsp
Tác giả: ketxu
Bài viết gốc: 420442
Tên lệnh: foo
lisp gán giá trị khoảng cách cho attribute

Quick code, không bẫy lỗi cho bạn. Cứ cái j chỉnh được là nó chỉnh (Kể cả Text trong Dim, text trong Block, Att ... - Nhớ Regen nếu chưa thấy cập nhật ^^)

(defun c:foo(/ s e)
>>

Quick code, không bẫy lỗi cho bạn. Cứ cái j chỉnh được là nó chỉnh (Kể cả Text trong Dim, text trong Block, Att ... - Nhớ Regen nếu chưa thấy cập nhật ^^)

(defun c:foo(/ s e)
	(setq s (vl-princ-to-string (distance (setq p1 (getpoint "\nP1 :")) (getpoint p1 "\nP2 :")))) 
	(while  (setq e (nentsel "\nPick Att :")) (vla-put-textstring (vlax-ename->vla-object (car e)) s))
)

 


<<

Filename: 420442_foo.lsp
Tác giả: ketxu
Bài viết gốc: 420464
Tên lệnh: foo
lisp gán giá trị khoảng cách cho attribute

Lúc đầu đâu có nói rõ ^^
 

(defun c:foo(/ s e)
 	(setvar 'dimzin 8)
	(setq s (rtos (distance (setq p1 (getpoint...
>>

Lúc đầu đâu có nói rõ ^^
 

(defun c:foo(/ s e)
 	(setvar 'dimzin 8)
	(setq s (rtos (distance (setq p1 (getpoint "\nP1 :")) (getpoint p1 "\nP2 :"))) 2 2) 
	(while  (setq e (nentsel "\nPick Att :")) (vla-put-textstring (vlax-ename->vla-object (car e)) s))
)

 


<<

Filename: 420464_foo.lsp

Trang 294/303

294