[NO]Bài 10: Biến hệ thống - Lisp

[cadvietedu 26]

 

 

[caiquattran1609 0]

Em đã học xong chương trình ACAD Online của trung tâm. Em thấy rất hay và bổ ích.Em rất cảm ơn trung tâm!

Nhưng em có thắc mắc là em vẫn chưa biết cách tạo nên 1 file giống file CADVIETSTANDARD ?

Anh có thể chỉ giúp em cách tạo nên 1 file giống như vậy được không ạ?

Em cám ơn!

[Nguyen Hoanh 4670]

Cảm ơn bạn đã theo học cả 3 khóa học từ Cơ bản, Trung cấp đến Nâng cao của CADViet.

 

Về block CADViet Standard, thực tế là file CADVietStandard, nó là 1 file chứa đủ tất cả các block thôi mà bạn,

Bạn cứ tạo lần lượt các layer, block, text style, dim style rồi lưu lại thành 1 file cadstandard là được.

[caiquattran1609 0]

Vâng. Em đã hiểu. Em cám ơn!

[vangialoc 0]

Anh kiểm tra giúp E lisp đo chiều dài của các đối tượng là line, polyline, mline... bị lỗi khi sử dụng trong

AutoCad 2015 (lisp bị lỗi khi chọn nhiều đối tượng 1 lúc ah). Cám ơn Anh.

http://www.cadviet.com/upfiles/4/136894_tg_do_chieu_dai.lsp

 

[cadvietedu 26]

Bạn có thể paste mã lisp vào bài viết được không?

File bạn upload bị lỗi.

[vangialoc 0]

Mã lísp đây ah. Anh kiểm tra giúp E.

 

;; free lisp from cadviet.com

(defun add_mline ()

  (foreach e_record_sub e_record

    (cond ((= 10 (car e_record_sub))

  (setq pt1   (cdr e_record_sub)

mline_len 0.0

  )

 )

 ((= 11 (car e_record_sub))

  (setq pt2   (cdr e_record_sub)

mline_len (+ mline_len (distance pt2 pt1))

pt1   pt2

  )

 )

    )

  )

  (setq tot_len (+ tot_len mline_len))

  (ssdel e_name ss)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun C:tg (/ tot_len ss e_name e_record e_type)

  (setq tot_len 0.0)

  (setq ss (ssget))

  (if (null ss)

    (exit)

  )

  (while (> (sslength ss) 0)

    (setq e_name (ssname ss 0))

    (setq e_record (entget e_name))

    (setq e_type (cdr (assoc '0 e_record)))

    (cond ((wcmatch e_type "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")

  (command "lengthen" e_name "")

  (setq tot_len (+ tot_len (getvar "PERIMETER")))

  (ssdel e_name ss)

 )

 ((wcmatch e_type "MLINE") (add_mline))

 (e_type (ssdel e_name ss))

    )

  )

  (prompt (strcat "\nTotal length is: " (rtos tot_len 2 2)))

  (princ)

)

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:GG ( / *error* vl ov LastEntity ent ss )

 

CADVIET

 

(defun *error* ( msg )

 

(mapcar 'setvar vl ov)

 

(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")

 

(princ (strcat "\n** Error: " msg " **")))

 

(princ)

 

)

 

(setq vl '("CMDECHO" "PEDITACCEPT" "QAFLAGS")

 

ov (mapcar 'getvar vl))

 

(setq LastEntity (entlast))

 

(command "_.mline")

 

(while (= 1 (logand 1 (getvar 'CMDACTIVE)))

 

(command pause)

 

)

 

(if (not (equal LastEntity (setq ent (entlast))))

 

(progn

 

(mapcar 'setvar vl '(0 1 5))

 

(vl-cmdf "_.explode" ent "")

 

(setq ss (ssadd))

 

(mapcar '(lambda ( e ) (ssadd e ss)) (LM:EntnexttoEnd ent))

 

(vl-cmdf "_.pedit" "_M" ss "" "_J" "" "")

 

)

 

)

 

(mapcar 'setvar vl ov)

 

(princ)

 

)

 

(defun LM:EntnexttoEnd ( e )

 

(if (setq e (entnext e))

 

(cons e (LM:EntnexttoEnd e))

 

)

 

)

[vangialoc 0]

;; free lisp from cadviet.com
(defun add_mline ()
(foreach e_record_sub e_record
(cond ((= 10 (car e_record_sub))
(setq pt1 (cdr e_record_sub)
mline_len 0.0
)
)
((= 11 (car e_record_sub))
(setq pt2 (cdr e_record_sub)
mline_len (+ mline_len (distance pt2 pt1))
pt1 pt2
)
)
)
)
(setq tot_len (+ tot_len mline_len))
(ssdel e_name ss)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:tg (/ tot_len ss e_name e_record e_type)
(setq tot_len 0.0)
(setq ss (ssget))
(if (null ss)
(exit)
)
(while (> (sslength ss) 0)
(setq e_name (ssname ss 0))
(setq e_record (entget e_name))
(setq e_type (cdr (assoc '0 e_record)))
(cond ((wcmatch e_type "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")
(command "lengthen" e_name "")
(setq tot_len (+ tot_len (getvar "PERIMETER")))
(ssdel e_name ss)
)
((wcmatch e_type "MLINE") (add_mline))
(e_type (ssdel e_name ss))
)
)
(prompt (strcat "\nTotal length is: " (rtos tot_len 2 2)))
(princ)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:GG ( / *error* vl ov LastEntity ent ss )

CADVIET

(defun *error* ( msg )

(mapcar 'setvar vl ov)

(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")

(princ (strcat "\n** Error: " msg " **")))

(princ)

)

(setq vl '("CMDECHO" "PEDITACCEPT" "QAFLAGS")

ov (mapcar 'getvar vl))

(setq LastEntity (entlast))

(command "_.mline")

(while (= 1 (logand 1 (getvar 'CMDACTIVE)))

(command pause)

)

(if (not (equal LastEntity (setq ent (entlast))))

(progn

(mapcar 'setvar vl '(0 1 5))

(vl-cmdf "_.explode" ent "")

(setq ss (ssadd))

(mapcar '(lambda ( e ) (ssadd e ss)) (LM:EntnexttoEnd ent))

(vl-cmdf "_.pedit" "_M" ss "" "_J" "" "")

)

)

(mapcar 'setvar vl ov)

(princ)

)

(defun LM:EntnexttoEnd ( e )

(if (setq e (entnext e))

(cons e (LM:EntnexttoEnd e))

)

)

[Nguyen Hoanh 4670]

Nội dung cần sửa:

Sửa đoạn mã

(command "lengthen" e_name "")

(setq tot_len (+ tot_len (getvar "PERIMETER")))

 

Bằng

(setq tot_len (+ tot_len (setq dai (vlax-curve-getDistAtParam e_name (vlax-curve-getEndParam e_name )))))

 

Và đây là toàn bộ lisp sau khi sửa:

;; free lisp from cadviet.com

;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/109599-no-bai-10-bien-he-thong-lisp/#entry333892

;; free lisp from cadviet.com
 

(defun add_mline ()
 

(foreach e_record_sub e_record
 

(cond ((= 10 (car e_record_sub))
 

(setq pt1 (cdr e_record_sub)
 

mline_len 0.0
 

)
 

)
 

((= 11 (car e_record_sub))
 

(setq pt2 (cdr e_record_sub)
 

mline_len (+ mline_len (distance pt2 pt1))
 

pt1 pt2
 

)
 

)
 

)
 

)
 

(setq tot_len (+ tot_len mline_len))
 

(ssdel e_name ss)
 

)
 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 

(defun C:tg (/ tot_len ss e_name e_record e_type)
 

(setq tot_len 0.0)
 

(setq ss (ssget))
 

(if (null ss)
 

(exit)
 

)
 

(while (> (sslength ss) 0)
 

(setq e_name (ssname ss 0))
 

(setq e_record (entget e_name))
 

(setq e_type (cdr (assoc '0 e_record)))
 

(cond ((wcmatch e_type

"LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE"

)
 

;(command "lengthen" e_name "")
 

(setq tot_len (+ tot_len (setq dai (vlax-curve-getDistAtParam e_name (vlax-curve-getEndParam e_name )))))
 

(ssdel e_name ss)
 

)
 

((wcmatch e_type "MLINE") (add_mline))
 

(e_type (ssdel e_name ss))
 

)
 

)
 

(prompt (strcat "\nTotal length is: " (rtos tot_len 2 2)))
 

(princ)
 

)
 
 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 

(defun c:GG (/ *error* vl ov LastEntity ent ss)
 
 

CADVIET
 
 

(defun *error* (msg)
 
 

(mapcar 'setvar vl ov)
 
 

(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
 
 

(princ (strcat "\n** Error: " msg " **"))

)
 
 

(princ)
 
 

)
 
 

(setq vl '("CMDECHO" "PEDITACCEPT" "QAFLAGS")
 
 

ov (mapcar 'getvar vl)

)
 
 

(setq LastEntity (entlast))
 
 

(command "_.mline")
 
 

(while (= 1 (logand 1 (getvar 'CMDACTIVE)))
 
 

(command pause)
 
 

)
 
 

(if (not (equal LastEntity (setq ent (entlast))))
 
 

(progn
 
 

(mapcar 'setvar vl '(0 1 5))
 
 

(vl-cmdf "_.explode" ent "")
 
 

(setq ss (ssadd))
 
 

(mapcar '(lambda (e) (ssadd e ss)) (LM:EntnexttoEnd ent))
 
 

(vl-cmdf "_.pedit" "_M" ss "" "_J" "" "")
 
 

)
 
 

)
 
 

(mapcar 'setvar vl ov)
 
 

(princ)
 
 

)
 
 

(defun LM:EntnexttoEnd (e)
 
 

(if (setq e (entnext e))
 
 

(cons e (LM:EntnexttoEnd e))
 
 

)
 
 

)

[jangboko 10]

Không biết em post bài ở đây có đúng hay không, nếu không đúng xin anh di chuyển bài tới topic phù hợp hộ em nhé. 

- Em sử dụng Sheet set, khi em etransmist hoặc archive thì cad hiện ra cái dòng sau:"  Archive ( etransmit) can not continue because the following drawing(s) require saving: E:\huy\..." 

- Mong anh chỉ giúp em với

[cadvietedu 26]

Bạn thử kiểm tra xem đường dẫn của bạn có tiếng Việt có dấu không?

 

Nếu có thì phải sửa đường dẫn (tên thư mục, tên file) về không dấu.

 

Lệnh etransmit không thực hiện được khi tên file hoặc tên thư mục có dấu.

[anducmanhsqc 0]

Anh ơi các file sau không download được, anh fix lại nhé

. Mplot: https://dl.dropbox.c...10/MPLOT104.VLX

. ACV: http://www.cadviet.c...?showtopic=3825

. CADViet Vaccine: http://www.cadviet.c...showtopic=22411

. CADViet Antivirus: http://www.cadviet.c...?showtopic=9088

[cadvietedu 26]

59 phút trước, anducmanhsqc đã nói:

Anh ơi các file sau không download được, anh fix lại nhé

. Mplot: https://dl.dropbox.c...10/MPLOT104.VLX

. ACV: http://www.cadviet.c...?showtopic=3825

. CADViet Vaccine: http://www.cadviet.c...showtopic=22411

. CADViet Antivirus: http://www.cadviet.c...?showtopic=9088

Cảm ơn bạn,

 

Chúng tôi đã fix, bạn kiểm lại nhé.

[vangialoc 0]

Anh có thể giúp Em sửa lại lisp đếm block dinamic này được không ạ? (Đoạn lisp hoạt động tương tự như lệnh selectsimilar)

- Đoạn lisp đang chọn đối tượng quét chọn là toàn bộ bản vẽ ---> sửa thành chỉ quét chọn vùng cần đếm block .

- Thêm tùy chọn: đếm tổng số block dinamic giống đối tượng mẫu hoặc thống kê từng block con trong block dinamic đó.

Cảm ơn Anh. Dưới đây là lisp cần edit lại ạ.

 

(defun c:sw(/ aaa ls dt dt1 sdt sdt1 ent ent1 id id1)
 (setq AAA(SSGET)
sdt (sslength AAA)
id 0
dt (ssadd)
)
 (repeat sdt;;repeat1
(setq ent (ssname AAA id)
id (1+ id)
);;setq
(setq ls (entget ent))
(if (= (cdr (assoc 0 ls)) "INSERT")
     (get-block ent)
     (setq dt1(ssget"all"(list(assoc 0 ls) (assoc 8 ls))))
     );;if
(setq sdt1 (sslength dt1)
  id1 -1)
(while (setq ent1(ssname dt1 (setq id1 (1+ id1))))
     (setq dt (ssadd ent1 dt))
     );;While
(sssetfirst dt dt)  
);;repeat1
 (princ (strcat "\nco " (rtos (sslength dt)) " doi tuong." ))
 (princ)
 )
;;;;;;;;;;;;;;;;;;;;;;;;
(defun get-block(entm / sdtb idb ent2 entb dtm namem name BBB entb)
 (setq dtm (vlax-ename->vla-object entm))
 (setq namem (if(vlax-property-available-p dtm 'effectivename)
  (vla-get-effectivename dtm)
  (vla-get-name dtm)
  ));;;
 (setq BBB(SSGET "all" (list(cons 0 "INSERT") (assoc 8 (entget entm))))
sdtb (sslength BBB)
idb 0
dt1 (ssadd)
)
 (repeat sdtb;;repeat
(setq entb (ssname BBB idb)
idb (1+ idb)
)
(setq ent2(vlax-ename->vla-object entb))
(setq name (if(vlax-property-available-p ent2 'effectivename)
  (vla-get-effectivename ent2)
  (vla-get-name ent2)
  ))
(if (= name namem)
     (setq dt1 (ssadd entb dt1))
     )
);;repeat
 ) 

[Danh Cong 424]

50 phút trước, vangialoc đã nói:

(setq BBB(SSGET "all" (list(cons 0 "INSERT") (assoc 8 (entget entm))))

Bỏ chữ "all" thử xem thế nào?

[vangialoc 0]

Bỏ chữ "all" đã quét được vùng cần chọn. Anh sửa giúp E thêm phần tùy chọn thống kê khối lượng từng loại block trong block dinamic được không ạ. Cảm ơn Anh.