Jump to content
InfoFile
Tác giả: hoangnam2017
Bài viết gốc: 418550
Tên lệnh: ha
Vẽ Một Hình Tứ Giác Khi Đã Biết Chiều Dài 4 Cạnh Và Diện Tích.

 

Đây là 2 hình thỏa mãn yêu cầu ngộ của bạn:

Cad:

 

Đây là 2 hình thỏa mãn yêu cầu ngộ của bạn:

Cad:

http://www.cadviet.com/upfiles/7/67029_dung_hinh_1.dwg

Lisp:

(defun C:HA(/ a1 a2 a3 a4 a5 step p1 p2 s1 s2 lst)
 (setq a1 4.050 a2 11.260 a3 4.00 a4 11.150 step 1E-6 a5 (+ (- a2 a1) step))
 (while (< (- a2 a1) a5 (+ a3 a4))
  (setq p1 (/ (+ a1 a2 a5) 2))
  (setq p2 (/ (+ a3 a4 a5) 2))
  (setq s1 (sqrt (* p1 (- p1 a1) (- p1 a2) (- p1 a5))))
  (setq s2 (sqrt (* p2 (- p2 a3) (- p2 a4) (- p2 a5))))
  (if (equal (+ s1 s2) 45.01 step) (setq lst (cons a5 lst)))
  (setq a5 (+ a5 step)))
 lst) 
; L=(12.1367 11.6696)
; S=(45.00994873 45.01000977)

Lisp này dùng thế nào bác nhể.

Em gõ lệnh HA mà k thấy ra kết quả gì ạ.


<<

Filename: 418550_ha.lsp
Tác giả: ngokiet
Bài viết gốc: 436192
Tên lệnh: vbk
Lisp đo bán kính sau khi Fillet
47 phút trước, huunhantvxdts đã nói:

Lisp ở trên nó cho phép đo...

>>
47 phút trước, huunhantvxdts đã nói:

Lisp ở trên nó cho phép đo đường cong rồi nên không cần kiểm tra chỉ cần bắt được đối tượng polyline đưa vào thôi.

đây là lisp mình viết có thêm 1 bước là chọn đối tượng sau khi filett

  • vbk.lsp
    lisp help
  •  

(defun C:VBK(/ )
(command "undo" "be")
(setq cur_lay (getvar "clayer" ))
(setq oldos (getvar "OSMODE"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(while ;(setq dtuong1 (car (entsel "\nChon doi tuong 1")))
(or (and bkinh (or (= (type bkinh) 'int) (= (type bkinh) 'real))) (setq bkinh 5.00))
(setq bkinh (cond ((getreal (strcat "\nNhap ban kinh cong (m) <" (rtos bkinh 2 2) ">: "))) (bkinh)))
(command "FILLET" "R" bkinh)
(command "FILLET" pause pause)
(dobk)
)
(setvar "clayer" cur_lay)
(setvar "osmode" oldos)
(setvar "CMDECHO" 1)
(command "undo" "end")
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;
(defun dobk (/ acadobj doc i modelspace obj LM:BulgeCenter)
(defun LM:BulgeCenter (p1 p2 B)
(polar p1 (+ (angle p1 p2) (- (/ pi 2) (* 2 (atan B)))) (/ (* (distance p1 p2) (1+ (* b B))) 4 B)))
(setq acadObj (vlax-get-acad-object))
(setq doc (vla-get-activedocument acadObj))
(setq modelSpace (vla-get-modelspace doc))
(setq i 0)
(setq e (car (entsel "\nChon cung dien ban kinh")))
(setq obj (vlax-ename->vla-object e))
(repeat (fix (vlax-curve-getendparam e))
(if (/= 0 (vla-getbulge obj i))
(vla-adddimradial modelSpace
(vlax-3d-point (LM:BulgeCenter (vlax-curve-getpointatparam e i)
(vlax-curve-getpointatparam e (1+ i))
(vla-getbulge obj i)))
(vlax-3d-point (vlax-curve-getpointatparam e (+ i 0.5)))
-0.5)
)
(setq i (1+ i))
)
(princ)
)

 

Sao bạn làm rắc rối vậy.

Bác chỉ cần thêm dòng này thay cho gọi hàm dobk là được rồi.

(command "dimradius" "mid" pause "")

Với lại vòng lặp while của bạn không có kết thúc trừ nhấn Esc nên các biến bạn lưu lại nó không trả về.

Còn mình chỉ cần viết vậy là đủ

(defun c:vbk(/ bkinh)
  (If (setq bkinh (getreal (strcat "\nNhap ban kinh cong (m) <" (rtos (getvar 'filletrad) 2 2) ">: "))
     (setvar 'filletrad bkinh))
  (command "fillet" pause pause)
  (command "dimradius" pause ""))

Còn hàm dobk của bạn hình như là ghi kích thước tất cả các arc có trong polyline nên dễ bị trùng dim nếu polyline có arc trước khi fillet.

Còn nếu bạn muốn bỏ chọn như bạn nói thì có mấy trường hợp

- 2 line or 2 arc thì  nó là (entlast)

- nếu đối tượng 1 là polyline thì nó là đối tượng 1 còn ko thì đối tượng 2.

Vì vậy nếu bạn chắc chắn dt1 là polyline thì bạn muốn lấy đối tượng đó thì bạn đổi dòng

(command "FILLET" pause pause)

Thành 

(if (setq dt1 (entsel "Nhap doi tuong 1")) (command "fillet" dt1 pause))

 


<<

Filename: 436192_vbk.lsp
Tác giả: hungptbk
Bài viết gốc: 146460
Tên lệnh: cad2geo cad2geo
Cần lisp chuyển dwg/dxf sang Plaxis

Lisp dưới đây sẽ giúp bạn chuyển dữ liệu từ AutoCAD sang file . Tên lệnh là cad2geo

The lisp routine...

>>

Lisp dưới đây sẽ giúp bạn chuyển dữ liệu từ AutoCAD sang file . Tên lệnh là cad2geo

The lisp routine below will help you to transfer data from AutoCAD to file format. Command's name is cad2geo

 

  (defun dxf(ent code)
   (cdr (assoc code (entget ent)))
 )
 (defun p2s(p)
   (apply 'strcat (mapcar '(lambda (x) (fullstr (rtos x 2 Accuracydigit) 14)) p))
 )
 (defun line2param(ent)
   (list (p2s (dxf ent 10)) (p2s (dxf ent 11)))
 )

 (defun lwpolyline2param(ent / tt z)
   (setq 
  z  (dxf ent 38)
  tt (vl-remove-if '(lambda (x) (/= (car x) 10) ) (entget ent))
  tt (mapcar '(lambda (x) (p2s (append (cdr x) (list z)))) tt)
   )
   tt
 )

 (defun polyline2param(ent / kq)
   (setq ent (entnext ent)
  kq nil)
   (while (and ent (= (dxf ent 0) "VERTEX"))
     (setq kq (append kq (list (p2s (dxf ent 10))))
    ent (entnext ent)
     )

   )
   kq
 )


 (defun getpointindex(pp / tmp)
   (if (setq tmp (member pp points))
     (1+ (- (length points) (length tmp)))
     (length (setq points (append points (list pp))))
   )
 )

 (defun fullstr(str num / sl)
   (setq sl (- num (strlen str)))
   (repeat sl
     (setq str (strcat " " str))
   )
 )
 (defun converttogeometry()
   (setq 
  index 0
         sl (if ss (sslength ss) 0)
   )
   (repeat sl
     (setq ent (ssname ss index)

     )
     (cond
((= (dxf ent 0) "LINE") (setq tmp (line2param ent)))
((= (dxf ent 0) "LWPOLYLINE") (setq tmp (lwpolyline2param ent)))
(T (setq tmp (polyline2param ent)))
     )


     (setq pline (strcat (fullstr (itoa (length tmp)) 5) "  - points on layerboundary" (fullstr (itoa index) 6) "\n      ")
    currentnumberinrow 0)

     (foreach point tmp
(setq pline (strcat pline (fullstr (itoa (getpointindex point)) 5))
      currentnumberinrow (1+ currentnumberinrow))
(if (>= currentnumberinrow 10)
  (progn
    (setq currentnumberinrow 0
	  pline (strcat pline "\n      "))
  )
)
     )
     (setq plines (append plines (list pline))
    index (1+ index))
   )       	  
   (princ)
 )

(defun getinput()
 (princ "\nPlease select LINE, POLYLINE: ")
 (setq ss (ssget '((0 . "*LINE")))
Accuracydigit (getint "\nEnter a integer value to choose Accuracy level (1=0.1, 2=0.01, 3=0.001,...)<2>: ")
Accuracydigit (if Accuracydigit Accuracydigit 2) 
fname (getfiled "Please specify  file" (getvar "dwgprefix") "geo" 1)
 )
)  

(defun expten(count / kq)
 (setq kq 1.0)
 (repeat count
   (setq kq (* 10.0 kq))
 )
)
(defun writeoutput()
 (setq fhnd (open fname "w"))
 (if (not fhnd)
   (alert (strcat "error when write to " fname))
   (progn
     (write-line (strcat
         "GEOMETRY FILE FOR THE M-SERIES\n" 
         "==============================================================================\n"
         "==========================    BEGINNING OF DATA     ==========================\n"
         "POINTS      Accuracy = " (fullstr (rtos (/ 1.0 (expten Accuracydigit)) 2 4) 12) "\n"
  (fullstr (itoa (length points)) 5) "  - Number of geometry-points -"	  
       )
fhnd
     )
     (setq index 1)
     (foreach point points
(write-line (strcat (fullstr (itoa index) 8) point) fhnd)
(setq index (1+ index))
     )
     (write-line "LAYERS" fhnd)
     (write-line (strcat (fullstr (itoa (1- (length plines))) 5) "  - Number of layers -") fhnd)

     (setq index 0)
     (foreach pline plines
(write-line pline fhnd)
(setq index (1+ index))	      
     )
     (write-line "" fhnd)
     (write-line "END OF DATA FILE" fhnd)
     (close fhnd)
   )
 )
)

(defun c:cad2geo( / ss)
 (setq points nil)
 (setq plines nil)
 (getinput)
 (converttogeometry)
 (writeoutput)
 (alert "Export to  file successfully!")
 (princ)
)

Bác cho em hỏi là lisp này của Bác sao chỉ có thể export Line nhưng Circle thì không được. Em đang cần lisp này nhưng không biết phải edit đoạn code nào để có thể export thêm được Circle. Mong Bác chỉ giáo. Thanks Bác Nguyen Hoanh


<<

Filename: 146460_cad2geo_cad2geo.lsp
Tác giả: duy782006
Bài viết gốc: 442234
Tên lệnh: xtt
Trao đổi dữ liệu từ Autocad sang Excel.

Tôi đã viết được như vầy rồi. các ký tự dư bạn tự bỏ bằng excel nhé. Tôi lười rồi. Lệnh là XTT

(Defun duy:xd_listngngancach<kytu (chuoi kytu / chuoi kytu ckq) 
(setq lkq nil)
(setq bdd 1) 
(setq b 1)
(setq l (fix (strlen chuoi)))
(repeat l
(setq a (substr chuoi b 1))
(cond
((= a kytu) 
(setq dkt (substr chuoi bdd (- b bdd)))
(setq lkq (append lkq (list dkt)))
(setq bdd...
>>

Tôi đã viết được như vầy rồi. các ký tự dư bạn tự bỏ bằng excel nhé. Tôi lười rồi. Lệnh là XTT

(Defun duy:xd_listngngancach<kytu (chuoi kytu / chuoi kytu ckq) 
(setq lkq nil)
(setq bdd 1) 
(setq b 1)
(setq l (fix (strlen chuoi)))
(repeat l
(setq a (substr chuoi b 1))
(cond
((= a kytu) 
(setq dkt (substr chuoi bdd (- b bdd)))
(setq lkq (append lkq (list dkt)))
(setq bdd (+ b 1)) 
)
)
(setq b (+ b 1))
)
(setq dkt (substr chuoi bdd (+ (- l bdd) 1)))
(setq lkq (append lkq (list dkt)))
lkq)
;;;;;;;;;;;;;;;;;;;
(defun c:xtt ()
(command "undo" "be")
(princ "\nChon cac text can xuat")
(setq taptextchon (ssget (list (cons 0 "TEXT"))))
(setq vitrifiledulieu (getfiled "File xuat du lieu " "" "csv" 1))

(setq filedulieu (open vitrifiledulieu "w"))

 (setq stt 0)
 (setq sotext (sslength taptextchon))
 (while (< stt sotext)
 (setq noidungdocduoc (cdr (assoc 1 (entget (ssname taptextchon stt)))))
(setq nddongviet (duy:xd_listngngancach<kytu noidungdocduoc " "))
 (write-line (strcat (nth 0 nddongviet) "\;" (nth 1 nddongviet) "\;" (nth 2 nddongviet) "\;" (nth 3 nddongviet)) filedulieu)
 (setq stt (+ stt 1))
 )

(close filedulieu)
(command "undo" "end")
)

 

texraex.jpg


<<

Filename: 442234_xtt.lsp
Tác giả: huunhantvxdts
Bài viết gốc: 361353
Tên lệnh: ad
Lisp dim khoảng cách liên tiếp trên Polyline - Pline


(defun c:ad (/ _dxf _mid _Lw->lst LM:BulgeCentre _DimArc _DimAligned
*error* doc spc...
>>


(defun c:ad (/ _dxf _mid _Lw->lst LM:BulgeCentre _DimArc _DimAligned
*error* doc spc s i e el typ p1 p2 pt cen r a1 a2 l)

(defun _dxf (code el) (cdr (assoc code el)))

(defun _mid (p1 p2 /) (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5 0.5)))

(defun _Lw->lst (e / o p1 p2 mid b pr lst)
(setq o (vlax-ename->vla-object e)
pr -1
)
(repeat (fix (vlax-curve-getEndParam o))
(setq
p1 (vlax-curve-getpointatparam o (setq pr (1+ pr)))
p2 (vlax-curve-getpointatparam o (1+ pr))
mid (vlax-curve-getpointatparam o (+ pr 0.5))
b (vla-getbulge o pr)
lst (cons (list p1 p2 mid b) lst)
)
)
(reverse lst)
)

;; Bulge Centre - Lee Mac 2012
;; p1 - start vertex
;; p2 - end vertex
;; b - bulge
;; Returns the centre of the arc described by the given bulge and
;; vertices

(defun LM:BulgeCentre (p1 p2 b)
(polar p1
(+ (angle p1 p2) (- (/ pi 2) (* 2 (atan b))))
(/ (* (distance p1 p2) (1+ (* b b))) 4 b)
)
)

(defun _DimArc (spc cen p1 p2 parc)
(vlax-invoke spc 'addDimArc cen p1 p2 parc)
)

(defun _DimAligned (spc p1 p2 pt)
(vlax-invoke spc 'adddimaligned p1 p2 pt)
)

(defun *error* (msg)

(and doc (vla-endundomark doc))
(if (and msg
(not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,"))
)
(princ (strcat "\nError: " msg))
)
)

;;===========================MAIN================================;;

(setq doc (vla-get-activedocument (vlax-get-acad-object))
spc (vlax-get doc
(if (eq (getvar 'CVPORT) 1)
'Paperspace
'Modelspace
)
)
)
(if (setq i -1
s (ssget '((0 . "LINE,ARC,LWPOLYLINE")))
)
(progn (vla-startundomark doc)
(repeat (sslength s)
(setq e (ssname s (setq i (1+ i)))
el (entget e)
typ (cdr (assoc 0 (entget e)))
)
(cond
((equal typ "LINE")
(setq p1 (_dxf 10 el)
p2 (_dxf 11 el)
pt (_mid p1 p2)
)
(_DimAligned spc p1 p2 pt)
)
((equal typ "LWPOLYLINE")
(setq l (_Lw->lst e))
(foreach l1 l
(if (/= (cadddr l1) 0.0)
(_DimArc spc
(LM:BulgeCentre
(car l1)
(cadr l1)
(cadddr l1)
)
(car l1) (cadr l1) (caddr l1)
)
(_DimAligned spc (car l1) (cadr l1) (caddr l1))
)
)
)
((equal typ "ARC")
(setq cen (_dxf 10 el)
r (_dxf 40 el)
a1 (_dxf 50 el)
a2 (_dxf 51 el)
p1 (polar cen a1 r)
p2 (polar cen a2 r)
pt (polar cen (/ (- a2 a1) 2) r)
)
(_DimArc spc cen p1 p2 pt)
)
)
)
)
)
(*error* nil)
(princ)
)
(vl-load-com)
;|«Visual LISP© Format Options»
(70 2 1 2 nil "_eof " 100 9 0 0 1 T T T T)
;*** DO NOT add text below the comment! ***|;

Đã đo được PL không phụ thuộc vào điểm đầu và điểm cuối

Bạn bổ sung thêm điểm đặt nữa chứ còn đo trên đường pl thì không hợp lý tí nào

Bạn có thể làm đo thêm bán kính cung tròn luôn nhé

 


<<

Filename: 361353_ad.lsp
Tác giả: comeonnow
Bài viết gốc: 436773
Tên lệnh: clx
Viết lisp từ script
(defun c: CLX()
(command "MODEL")
(command "AUDIT" "Y")
(command "-XREF" "D" "*")
(command "-VPORTS" "SI")
(command "-VIEW" "TOP")
(command "SCALELISTEDIT" "R" "Y" "E")
(command "REGENALL")
(command "-PURGE" "R" "*" "N")
(command "-PURGE" "A" "*" "N")
(command "SNAPANG" "0")
(command "-PURGE" "R" "*" "N")
(command "-SETBYLAYER" "ALL" "Y" "Y")
(command "-PURGE" "A" "*" "N")
(command "-PURGE" "R" "*" "N")
(command "ZOOM"...
>>
(defun c: CLX()
(command "MODEL")
(command "AUDIT" "Y")
(command "-XREF" "D" "*")
(command "-VPORTS" "SI")
(command "-VIEW" "TOP")
(command "SCALELISTEDIT" "R" "Y" "E")
(command "REGENALL")
(command "-PURGE" "R" "*" "N")
(command "-PURGE" "A" "*" "N")
(command "SNAPANG" "0")
(command "-PURGE" "R" "*" "N")
(command "-SETBYLAYER" "ALL" "Y" "Y")
(command "-PURGE" "A" "*" "N")
(command "-PURGE" "R" "*" "N")
(command "ZOOM" "E")
(command "QSAVE")
)

Em viết như này nhưng không chạy được, các bác chỉ giúp với


<<

Filename: 436773_clx.lsp
Tác giả: duy782006
Bài viết gốc: 442296
Tên lệnh: chenbl
Chèn block vào tâm các hình tròn
Vào lúc 28/10/2019 tại 13:11, thien316 đã nói:

Xin nhờ diễn đàn...

>>
Vào lúc 28/10/2019 tại 13:11, thien316 đã nói:

Xin nhờ diễn đàn triển khai giúp em một lisp để có thể chèn Blok hàng loạt tại tâm các đường tròn trong bản vẽ. Gửi file đính kèm mọi người xem giúp đỡ. Nội dung cụ thể:

Blok là block sẵn có mình tạo ra trên bản vẽ, các vòng tròn cũng có sẵn.

- Lệnh: ChenBL

- Chọn Block cần chèn

- Chọn điểm trên Block

- Chọn tất cả các đường tròn trên bản vẽ cần chèn block

- Enter để kết thúc

Xin nhờ diễn đàn giúp đỡ.

tam vong tron.dwg

Vì đề bài có bước chọn điểm gốc để copy nên tôi viết tổng quát là copy 1 nhóm đối tượng bất kỳ từ điểm chọn đến tâm các hình tròn. Còn như bạn thích dùng cho block thì trong bước chọn đối tượng chỉ cần chọn cái blocl đó là được. Tên lệnh vẫn giữ như yêu cầu.

(defun c:chenbl ()
(command "undo" "be")
(princ "\n Chon cac doi tuong muon copy")
(setq tapcopy (ssget))
(setq diemgoc (getpoint "\n Dim goc cua doi tuong"))
(princ "\n Chon cac CIRCLE dich")
(setq taptronchon (ssget (list (cons 0 "CIRCLE"))))
 (setq stt 0)
 (setq sotron (sslength taptronchon))
 (while (< stt sotron)
 (setq toadotam (cdr (assoc 10 (entget (ssname  taptronchon stt)))))
(command ".copy" tapcopy "" "_non" diemgoc "_non" toadotam "")
 (setq stt (+ stt 1))
 )
(command "undo" "end")
)

 


<<

Filename: 442296_chenbl.lsp
Tác giả: huunhantvxdts
Bài viết gốc: 438782
Tên lệnh: gfi
Tọa độ của điểm đặt block khác với ma 10 DFX

Mình dùng lisp sau để xem tọa độ của điểm đặt block thì cho ra kết quả khác với dùng lệnh mo xem tọa độ

Mọi người biết lý do giúp mình với

(defun c:gfi()
(setq ma (car (entsel)))
(setq ma1 (entget ma))
(princ ma1)
(princ)
)

 

>>

Mình dùng lisp sau để xem tọa độ của điểm đặt block thì cho ra kết quả khác với dùng lệnh mo xem tọa độ

Mọi người biết lý do giúp mình với

(defun c:gfi()
(setq ma (car (entsel)))
(setq ma1 (entget ma))
(princ ma1)
(princ)
)

 

2019-07-19 (1).png

Toa do Block.dwg


<<

Filename: 438782_gfi.lsp
Tác giả: vtd_xd
Bài viết gốc: 203025
Tên lệnh: bt 10
Lisp ghi bước thép với khoảng cách thép đều nhau

Thêm 1 phương án :

(defun C:bt(/ ctc ss)
 (or *ctc* (setq *ctc* 200))
 (initget 6)
 (setq ctc (getint (strcat"\nNhap buoc thep...
>>

Thêm 1 phương án :

(defun C:bt(/ ctc ss)
 (or *ctc* (setq *ctc* 200))
 (initget 6)
 (setq ctc (getint (strcat"\nNhap buoc thep <" (itoa *ctc*) ">:")) )
 (if ctc (setq *ctc* ctc))
 (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 (itoa (fix(/ (cdr (assoc 42 (entget ent))) *ctc*)))
"x" (itoa *ctc*) "=<>"))	)
 	(command "_.undo" "_end") (princ)  )))
(defun C:10(/ 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) )
(princ "\nGia tri <=256.")
(setq num (getint (strcat"\nNhap color <" (itoa *num*) ">:")) ))
 	(if num (setq *num* num))
 	(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(vla-put-Color (vlax-ename->vla-object ent)*num* )	)
 	(command "_.undo" "_end") (princ)  )))

 

Chào bác giabach, bác có thể thêm phần lựa chọn "thêm 1 thanh, bớt 1 thanh hoặc giữ nguyên giá trị" trước khi tính toán được không?

- Khi tính toán thêm hàm làm tròn (Round) giống như excel được không vậy, Lisp rất tiện lợi, thanks bác nhiều


<<

Filename: 203025_bt_10.lsp
Tác giả: SAGI-Viz
Bài viết gốc: 437056
Tên lệnh: test1
Nhờ hướng dẫn về selection set filter trong LISP

Em cảm ơn anh Tue_NV đã nhiệt tình hướng dẫn ah.

 

Câu 1: Em đã hiểu vấn đề và xử lý xong được rồi ah.

(E phải hỏi thêm các anh khác mới giải quyết được vì trình còn thấp nên chỉ có function không thì chưa hiểu rõ để ứng dụng ra sao.)

Code để giải quyết câu 1 cho các bạn newbie giống mình tham khảo như sau (Trích Lee Mac hướng...

>>

Em cảm ơn anh Tue_NV đã nhiệt tình hướng dẫn ah.

 

Câu 1: Em đã hiểu vấn đề và xử lý xong được rồi ah.

(E phải hỏi thêm các anh khác mới giải quyết được vì trình còn thấp nên chỉ có function không thì chưa hiểu rõ để ứng dụng ra sao.)

Code để giải quyết câu 1 cho các bạn newbie giống mình tham khảo như sau (Trích Lee Mac hướng dẫn, chứ ko phải tự em nghĩ ra được)

(defun c:test1 ( / mss dss ent idx )
	(if (setq mss (ssget "_:L" '((0 . "MTEXT,*DIMENSION"))))
		(progn
			(setq dss (ssadd))
			(repeat (setq idx (sslength mss))
				(setq idx (1- idx)
					  ent (ssname mss idx)
				)
				(if (/= (cdr (assoc 0 (entget ent))) "MTEXT")
					(progn
						(ssdel ent mss)
						(ssadd ent dss)
					)
				)
			)
			(princ
				(strcat
					"\nSelect contained "
					(itoa (sslength mss)) " Mtext and "
					(itoa (sslength dss)) " Dimensions."
				)
			)
		)
	)
	(princ)
)

Câu hỏi phụ: anh Tue_NV có thể cho em một vài ví dụ về function ssname sẽ trả về kết quả như thế nào được ko ah? Em tham khảo trang chủ về lệnh mà chỉ nhận dc giải thích như vầy nên không hiểu và ứng dụng thế nào ah.
     (setq ent1 (ssname ss 0))

     <Entity name: 1d62d68>

 

Câu 2: Em hiểu cách giải quyết rồi ah, nhưng ko biết câu lệnh để lấy được Properties, anh có thể cho em xin 1 cấu trúc câu lệnh mẫu để lấy được properties của Dimension được không ah?

- Sau đó em sẽ dùng repeat tách các entity ra 2 tập khác nhau. Tác động lệnh DIMOVER với các Dimension Variables lên các selection set đã tách ra được phải không ah?

 

Cảm ơn anh.


<<

Filename: 437056_test1.lsp
Tác giả: tnmtpc
Bài viết gốc: 11745
Tên lệnh: doctext
lisp đọc số thành chữ
Lisp dưới đây biến 1 text là số nguyên dương thành một dòng text, là chữ viết.

 

Ví dụ: 1234567890 sẽ trở thành 'mot nghin hai tram ba muoi tu ty nam tram sau muoi...

>>
Lisp dưới đây biến 1 text là số nguyên dương thành một dòng text, là chữ viết.

 

Ví dụ: 1234567890 sẽ trở thành 'mot nghin hai tram ba muoi tu ty nam tram sau muoi bay trieu tam tram chin muoi'

 

tên lệnh là doctext (đọc text).

 

(setq
 donvi (list " nghin" " trieu" " ty")
 lstso (list
	(cons "0" " khong")
	(cons "1" " mot")
	(cons "2" " hai")
	(cons "3" " ba")
	(cons "4" " bon")
	(cons "5" " nam")
	(cons "6" " sau")
	(cons "7" " bay")
	(cons "8" " tam")
	(cons "9" " chin")
	(cons "0" " muoi")
)
 s_tram " tram"
 s_muoi " muoi"
 s_linh " linh"
 s_tu " tu"
)
(defun c:doctext()  
 (setq ent (car (entsel "\nHay pick vao text so can doc: "))	
tt  (entget ent)
gt  (cdr (assoc 1 tt))
ok  t
lst (mapcar '(lambda (x) (if (or (> x 57) (< x 48)) (setq ok nil))) (vl-string->list gt))
 )
 (if ok
   (progn
     (setq
p   (getpoint "\nPick toa do cua text moi: ")
tt (subst (cons 1 (substr (docso gt) 2)) (cons 1 gt) tt)
    tt (subst (cons 10 p) (assoc 10 tt) tt)
     )
     (entmake tt)
   )
   (alert "\nText vua chon khong phai la so nguyen duong")
 )
)
(defun docso (str)


 (defun doc1 (so)
   (cdr (assoc so lstso))
 )
 (defun doc3 (a b c)
   (if	(= a "0")
     (setq a1 "")
     (setq a1 (strcat (doc1 a) s_tram))
   )
   (if	(= b "0")
     (if (/= a "0")
(setq b1 s_linh)
(setq b1 "")
     )
     (if (= b "1")
(setq b1 s_muoi)
(setq b1 (strcat (doc1 B ) s_muoi))
     )
   )
   (if	(= c "0")
     (setq c1 "")
     (if (and (/= b "0") (= c "4"))
(setq c1 s_tu)
(setq c1 (doc1 c))
     )
   )
   (strcat a1 b1 c1)
 )

 (setq	lstchar	(reverse (mapcar 'chr (vl-string->list str)))
len	(length lstchar)	
dvht	0
kq	""
strdonvi ""
 )

 (while (>= (length lstchar) 3)
   (setq
     kqht    (strcat
	(doc3 (nth 2 lstchar) (nth 1 lstchar) (nth 0 lstchar))
      )
     kq      (strcat kqht strdonvi kq)
     lstchar (cdddr lstchar)
     dvht    (if (= dvht 2)
	0
	(1+ dvht)
      )
     strdonvi (nth dvht donvi)
   )
 )
 (if (/= (length lstchar) 0)
   (progn
     (while (< (length lstchar) 3)
(setq lstchar (append lstchar (list "0")))
     )
     (setq kqht (strcat
	   (doc3 (nth 2 lstchar) (nth 1 lstchar) (nth 0 lstchar))
	 )
    kq	 (strcat kqht (nth dvht donvi) kq)
     )
   )
 )
 kq
)

Bác Hòanh viết cừ thật, nhưng lisp đọc không đúng và "ngọng líu ngọng lo" Bác ạ, ví dụ nhé:114565231, đọc là: mot tram muoi tu ty nam tram sau muoi nam trieu hai tram ba muoi mot . Không phân biệt "năm", "lăm"...Bác sửa lisp lại chút đi! thêm phần số thập phân nữa chớ


<<

Filename: 11745_doctext.lsp
Tác giả: girl
Bài viết gốc: 218549
Tên lệnh: ttt
Lisp điền cao độ cho line, pline !

(defun C:ttt(/ cd ss)
(setq cd (atof (cdr (assoc 1 (entget (car (entsel "\n Chon text cao do")))))))
(setq ss (ssget '((0 ....
>>

(defun C:ttt(/ cd ss)
(setq cd (atof (cdr (assoc 1 (entget (car (entsel "\n Chon text cao do")))))))
(setq ss (ssget '((0 . "*LINE"))))
(command "change" ss "" "P" "E" cd "")
)

 

Lisp chạy chuẩn đúng yêu cầu. Cảm ơn CADVIET nhiều ạ !


<<

Filename: 218549_ttt.lsp
Tác giả: tientracdia
Bài viết gốc: 228750
Tên lệnh: khung scc
Cho mình hỏi cách cài đặt khung, Layer, dim, text sẵn trong cad khi khởi động là có luôn

 

tôi có 1 đoạn lisp này có thể bạn dùng được:

===================================
TAO CAC LOAI...
>>

 

tôi có 1 đoạn lisp này có thể bạn dùng được:

===================================
TAO CAC LOAI KHUNG MAU BAN VE CO SAN:
===================================
(defun C:KHUNG (/ )
  (command "cmdecho" 0)
  (command "osnap" "none")
  (setq DIEMCHEN (getpoint "CHON GOC TRAI-DUOI BAN VE"))
  (chenkhungCG DIEMCHEN) ;VE CAC KHUNG TY LE CHUAN DE DINH HUONG
  (setq MSTL (getreal "\nCHON TY LE BAN VE (BAM SO TUONG UNG T/LE:100;200;250;500;1000;2000): "))
;XOA CAC KHUNG DINH HUONG
(repeat 12 (command "_erase" (ssget "L") ""))
;CHEN MAU HO SO VAO
(setq DUONGDAN "c:\\program files\\AutoCAD 2004\\Khung\\")
  (setq LOAIHS "Khung")
  (setq TENFILE (strcat LOAIHS (rtos MSTL 2 0) ".dwg"))
  (ChenBlock DUONGDAN TENFILE DIEMCHEN (/ MSTL 1000))
(prompt "\nDA TAO XONG KHUNG BAN VE!")(command "osnap" "End,Mid,Int,Perp")(Princ)
);END DEFUN KHUNG
===================================
;SCALE BAN VE LAM TANG CO CHU KICH THUOC THEO TY LE
;;;=================================
(defun SCDim( / e ob OName SF LSF)
(while (setq e (ssname ssd 0))
(setq
ob (vlax-ename->vla-object e)
OName (vla-get-ObjectName ob)
SF (vla-get-ScaleFactor ob))
(if (not (wcmatch OName "*AngularDimension"))
(progn
(setq LSF (vla-get-LinearScaleFactor ob))
(command "dimoverride" "dimlfac" (/ LSF k) "" e "")))
(if (/= opt "N") (command "dimoverride" "dimscale" (* SF k) "" e ""))
(ssdel e ssd)))
;==========
(defun C:SCC( / ss ssd p k opt)(prompt "\nGo lenh: SCC de phong to hoac thu nho ban ve va kich thuoc ")
(vl-load-com)
(setq
ss (ssget)
ssd (ssget "p" '((0 . "DIMENSION")))
p (getpoint "\nTAM DIEM KHI SCALE:")
k (getreal "\nSCALE LEN MAY LAN:")
;opt (strcase (getstring "\nDim scale overall?  :"))
)
(if (= opt "") (setq opt "N"))
(if (> k 1)
(progn (command "scale" ss "" p k) (SCDim))
(progn (SCDim) (command "scale" ss "" p k))
)
(prompt "\nDA PHONG TO BAN VE VA KICH THUOC!")(Princ)
)
VÀ TẠO CÁC FILE MẪU TỈ LỆ: 1/100; 1/200; 1/250; 1/500; 1/1000; 1/2000.

LƯU Ý: TẠO 1 FILE MẪU TỈ LỆ 1/1000, SAU ĐÓ COPY THÀNH CÁC FILE NHƯNG VẪN DỮ NGUYÊN TỈ LỆ 1/1000 VÀ CHỈ SỬA CHỮ TỈ LỆ Ở PHẦN NHƯ HÌNH MINH HỌA KÈM THEO" TỶ LỆ: 1/1*** (Đơn vị cm)" BÊN TRONG BẢN VẼ VÀ XỬ DỤNG LỆNH SCC KÈM THEO ĐỂ SCALE DIM CHO ĐÚNG TỈ LỆ NGOÀI RA KHÔNG ĐƯỢC SCALE KHUNG RỒI LƯU FILE VẬY LÀ OK.

BẢN VẼ SẼ TỰ SCALE KHUNG KHI MÌNH GÕ LỆNH: KHUNG -> NHẬP SỐ TƯƠNG ỨNG VỚI TỈ LỆ 100 HOẶC 200 ...., VÀ NÓ SẼ HIỆN LÊN KHUNG NHƯ MÌNH ĐÃ MẶC ĐỊNH!

NHỚ COPY FILE KHUNG CỦA MÌNH THEO ĐÚNG ĐƯỜNG DẪN VÀO Ổ "c:\\program files\\AutoCAD 2004\\Khung\\"SAU ĐÓ SỬA VÀ LƯU FILE VÀO ĐÓ.

BẢN VẼ KÈM THEO ĐÃ CÓ KÍCH THƯỚC CHUẨN THEO TỪNG TỈ LỆ VÀ BẢN VẼ VẪN GIỮ NGUYÊN TỈ LỆ 1/1000:

http://www.cadviet.com/upfiles/3/62465_khung.rar

Cám ơn Bạn, nhưng sao mình chạy file lisp báo lỗi sau

CHON GOC TRAI-DUOI BAN VE; error: no function definition: CHENKHUNGCG

Xin nhờ Bạn giúp.

Cám ơn


<<

Filename: 228750_khung_scc.lsp
Tác giả: quansla
Bài viết gốc: 442526
Tên lệnh: 1111thunghiem
tính số thanh thép sàn

Đọc không hiểu gì cả, đoán này là làm thế này, còn bước tính tổng, bạn làm thủ công nốt nhé

 

 

(defun c:1111thunghiem()
  (if (setq ss (ssget '(( 0 . "*DIM*"))))
    (progn
      (while(not (and
           (setq phi (getstring "\nChon duong kinh thanh thep "))
           (member (atoi phi) '(6 8 10 12 14 16 18 20 22 25 28 32 35 38...
>>

Đọc không hiểu gì cả, đoán này là làm thế này, còn bước tính tổng, bạn làm thủ công nốt nhé

 

 

(defun c:1111thunghiem()
  (if (setq ss (ssget '(( 0 . "*DIM*"))))
    (progn
      (while(not (and
           (setq phi (getstring "\nChon duong kinh thanh thep "))
           (member (atoi phi) '(6 8 10 12 14 16 18 20 22 25 28 32 35 38 40 42 45))           
           ))
    (princ "\nDuong kinh thep phai la 6 8 10 12 14 16 18 20 22 25 28 30 32 35 38 40")
    )
      (while(not (and
           (setq khoang (getstring "\nChon Khoang cach can chia "))
           (not (equal 0.0 (atof khoang) 0.01))
           ))    
    )
      
      (princ (strcat "\Duong kinh thep D" phi "a" khoang))
      (setq ss (vl-remove-if'listp (mapcar 'cadr(ssnamex ss))))
      (foreach dt ss
    ;chay qua tat ca cac doi tuong de chuyen doi text
    (setq ent (entget dt))
    (entmod (subst (cons 1 (strcat (rtos (1+ (fix(/ (cdr(assoc 42 ent)) (atof khoang)))) 2 0) "D" phi "a" khoang "\\XL=<>")) (assoc 1 ent) ent))
    )
      )
    )
  (princ)
  )

 


<<

Filename: 442526_1111thunghiem.lsp
Tác giả: hiepttr
Bài viết gốc: 217615
Tên lệnh: udt
Tính tổng diện tích các hình trên bản vẽ, "Ed" vào text sẵn có

Lệnh UDT (Update diện tích) dưới đây sẽ làm điều bạn muốn:

(defun c:udt(/ ss tong ham tmp tt)  (setq    ss...
>>

Lệnh UDT (Update diện tích) dưới đây sẽ làm điều bạn muốn:

(defun c:udt(/ ss tong ham tmp tt)  (setq    ss (ssget '((-4 . "<or")(0 .="" "lwpolyline")(0="" "region")(0="" "circle")(0="" "arc")(-4="" "or="">")))    	tong 0.0    ham (lambda (x) (command ".area" "o" x) (setq tong (+ tong (getvar "area"))))    tmp (mapcar 'ham (ss2ent ss))      tt (entget (car (entsel "\nChon text ket qua: ")))    tong (vl-string-right-trim "." (vl-string-right-trim "0" (rtos tong)))  )  (entmod (subst (cons 1 tong) (assoc 1 tt) tt)))(defun ss2ent(ss / sodt index lstent)  (setq 	sodt (if ss (sslength ss) 0)         index 0  )  (repeat sodt    (setq ent (ssname ss index)  	index (1+ index)  	lstent (cons ent lstent)    )  )  (reverse lstent))(princ "\nUpdate Area - free lisp from cadviet.com")(princ "\nUse UDT command to start!")(vl-load-com)

</or")(0></p> <p>

</p> <p> </p><p>Hôm nay, trong công việc thấy có cái công tác tính tổng diện tích.<br></p><p>Em seach thấy Lisp của bác Hoanh ---> em cười như nghé, như địa chủ được mùa<br></p><p>Ai ngờ down về, load lên.......-----> "Unknown command "UDT". Press F1 for help."<br></p><p>Nhờ bác giúp dùm cho !<br></p>
<<

Filename: 217615_udt.lsp
Tác giả: Doan Nguyen Van
Bài viết gốc: 442723
Tên lệnh: te
Xin lisp chuyển layer
11 giờ trước, tranhongkhoa đã nói:

Chào mọi người, hiện...

>>
11 giờ trước, tranhongkhoa đã nói:

Chào mọi người, hiện tại em đang tìm lisp có thể chuyển tất cả các layer về layer current mà nó vẫn giữ linetype của layer cũ. 

Em cảm ơn ạ!

(defun c:te (/ y x )
  (foreach y (acet-ss-to-list (ssget (list (cons 0 "*LINE"))))
    (if (= "ByLayer" (vla-get-linetype (setq x (vlax-ename->vla-object y))))
      (vla-put-linetype x (cdr (assoc 6 (tblsearch "layer" (cdr (assoc 8 (entget y))))))) )
    (vla-put-layer x (getvar 'clayer))
    )
  )

Đây nhé bạn


<<

Filename: 442723_te.lsp
Tác giả: Doan Nguyen Van
Bài viết gốc: 442735
Tên lệnh: te
Xin lisp chuyển mỗi đối tượng sang mỗi layer khác nhau.
14 phút trước, thietke08 đã nói:

Đúng rồi, mà nó chạy hơi...

>>
14 phút trước, thietke08 đã nói:

Đúng rồi, mà nó chạy hơi lâu.

Thanks bạn nhiều.

Bạn dùng cái này cho nhanh nhé:

(defun c:te (/ x i)
  (foreach x (acet-ss-to-list (ssget ))
    (if (not i) (setq i 1) (setq i (1+ i)))
	    (if (< i 257) (progn (if (not (tblsearch "LAYER" (itoa i)))
(entmake   (list     (cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord")  (cons 100 "AcDbLayerTableRecord")  (CONS 2 (itoa i))  (CONS 62 I) (CONS 70 0)
          )))(vla-put-layer (vlax-ename->vla-object x) (itoa i)))))
	  )

 


<<

Filename: 442735_te.lsp
Tác giả: thanhduan2407
Bài viết gốc: 442739
Tên lệnh: 00
Xin lisp chuyển mỗi đối tượng sang mỗi layer khác nhau.

Đây nhé bạn!
 

(defun C:00 (/ i)
  (setq i 1)
  (while (< i 256)
    (_layer2 (rtos i 2 0) i)
    (setq i (1+ i))
  )
  (princ)
)
(defun _layer2 (name colour)
  (if (null (tblsearch "LAYER" name))
    (entmake
      (list
	'(0 . "LAYER")
	'(100 . "AcDbSymbolTableRecord")
	'(100 . "AcDbLayerTableRecord")
	'(70 . 0)
	(cons 2 name)
	(cons 62 colour)
      )
    )
  )
)

 


Filename: 442739_00.lsp
Tác giả: ukhoney
Bài viết gốc: 131575
Tên lệnh: fix
Text cao độ bị mất dấu chấm phần thập phân

Bạn thử sử dụng đoạn này xem sao. 1 ví dụ điển hình của việc biết lisp thì lợi ntn ^^

(defun c:fix ()
(defun...
>>

Bạn thử sử dụng đoạn này xem sao. 1 ví dụ điển hình của việc biết lisp thì lợi ntn ^^

(defun c:fix ()
(defun chDXF (dxf val ent) 
(entmod (subst (cons dxf val) (assoc dxf (entget ent)) (entget ent))))
(defun dxf (dxf ent) (cdr (assoc dxf (entget ent))))
(foreach e (acet-ss-to-list (ssget "X" (list (cons 0 "TEXT")(cons 1 "~-#")(cons 1 "##"))))
(chDXF  1 (strcat "." (dxf 1 e)) e)
)
)

Không còn j để diễn tả ^^


<<

Filename: 131575_fix.lsp
Tác giả: leejang
Bài viết gốc: 66552
Tên lệnh: df
Đưa thêm thuộc tính Bolder và Lisp ???? Xin giúp đỡ !!!
Thử cái này xem :

(defun c:df()
(command "undo" "be")
(command "-style" "df" "VHARIALB.TTF" "0" "1" "0" "n" "n") 
(prompt "\nChon chu muon chinh.")
(setq ss (ssget))
(setq c 0)
(if...
>>
Thử cái này xem :

(defun c:df()
(command "undo" "be")
(command "-style" "df" "VHARIALB.TTF" "0" "1" "0" "n" "n") 
(prompt "\nChon chu muon chinh.")
(setq ss (ssget))
(setq c 0)
(if ss (setq e (ssname ss c)))
(while e
(setq e (entget e))
(if (= (cdr (assoc 0 e)) "TEXT")
(progn
(setq txt "df")
(setq e (subst (cons 7 txt) (assoc 7 e) e))
(entmod e)
)
)
(setq c (1+ c))
(setq e (ssname ss c))
)
(command "undo" "end")
(Princ)
)

ok ! Té ra nó ở cái tên font, Vậy mà em loay hoay mãi. Cảm ơn bác nhìu nhé !!!


<<

Filename: 66552_df.lsp

Trang 304/306

304