Chuyển đến nội dung
Diễn đàn CADViet

Thaistreetz

Nhà quảng cáo
  • Số lượng nội dung

    897
  • Đã tham gia

  • Lần ghé thăm cuối

  • Ngày trúng

    23

Cộng đồng

518 (tốt)

About Thaistreetz

  • Cấp bậc
    biết lệnh adcenter

Phương pháp liên hệ

  • ICQ
    0

Thông tin hồ sơ

  • Giới tính
    Male
  • Vị trí
    HN-QN-HD

Khách truy cập Tiểu sử gần đây

14.888 chế độ xem tiểu sử
  1. [Yêu cầu] - Lisp tự động tạo thư viện mẫu Hatch

    Cái này tùy thuộc vào nhu cầu của mỗi người mà chủ động điều chỉnh cho phù hợp thôi. Mình thì xây dựng toàn bộ ứng dụng lisp của mình theo project và build thành 1 file fas duy nhất. trong đó có mọi lệnh, ứng dụng, tiện ích, thư viện layer, thư viện block, thư viện dimstyte, textstyle, khung bản vẽ... mà mình cần. đồng thời bao gồm cả 1 lệnh setup để tạo môi trường làm việc quen thuộc và 1 lệnh hoàn trả môi trường làm việc như trước khi setup. Lưu nó lên mây hoặc vào điện thoại, tiện khi làm việc ở máy tính khác, và cũng đỡ mất thời gian mỗi khi cài lại autocad. Ý tưởng của mình được vẽ ra theo hướng này :D
  2. [Yêu cầu] - Lisp tự động tạo thư viện mẫu Hatch

    Em chưa viết hàm con trích xuất các thông tin này bác ạ. Khi nghiên cứu code dxf của đối tượng hatch em thấy kết quả trả về có cái thì phức tạp dài lê thê, có cái thì rất ngắn và không phụ thuộc vào hình dạng của đối tượng hatch. Khi đó em lờ mờ đoán cái đoạn dài hay ngắn đó có thể chính là mô tả cấu tạo của pattern. sau đó em mởi file thư viện của hatch và một số file custom hatch thì thấy các file này có nội dung như trong dxf mô tả. Từ đó em mới có khẳng định như trên. Tuy nhiên lúc đó chưa nghĩ đến có thể ứng dụng vào việc gì nên chỉ hiểu rồi để đó thôi. Giờ mới nảy sinh ra ý tưởng khi mà vấp phải bản vẽ lạ
  3. [Yêu cầu] - Lisp tự động tạo thư viện mẫu Hatch

    Hề hề, ý tưởng nào của mềnh mà lai hông hay :D Cũng từ nguyên lý cơ bản để viết lisp này, các bác có thể phát triển một lệnh cài đặt thư viện mẫu hatch thường dùng của mình rồi nhúng luôn trong lisp. Mỗi lần cài đặt lại Autocad chỉ cần gõ 1 lệnh là nó khởi tạo cho các bác thư viện mà không cần copy thủ công nữa.
  4. [Yêu cầu] - Lisp tự động tạo thư viện mẫu Hatch

    Chào các bác, lâu lắm mới đụng đến CAD, mình có một nhu cầu như thế này chắc cũng nhiều người cần nên post ý tưởng xem có bác nào hứng thú thì triển nhé. Chiều nay mình nhận được bản vẽ thiết kế kiến trúc của đối tác tư vấn, mấy ông này chơi toàn mẫu hatch lạ không có sẵn trong thư viện custom hatch nên chỉ hiển thị chứ không chỉnh sửa được. Mình nhớ trước đây khi nghiên cứu để viết mấy hàm con entmake object thì cấu trúc code dxf của đối tượng hatch có các thông tin sau: 1. Tên pattern (mẫu hatch) của đối tượng hatch. 2. Giá trị mô tả toàn bộ tập hợp vector cấu tạo ra mẫu pattern của đối tượng hatch. Như chúng ta đã biết (có thể một số bác không biết), thư viện pattern của hatch được đặt trong 1 file đặt trong thư mục support của cad (tên gì mình cũng quên rồi, post bài này bằng máy tính ở nhà không có Cad các bác thông cảm) . Nó lưu giữ 2 thông tin mình nêu trên và được tải vào cad khi khởi động. Như vậy với 1 mẫu hatch lạ từ một bản vẽ lạ, ta có thể thu được thông tin của pattern mà mẫu hatch đó sử dụng để cập nhật vào thư viện của mình. Việc cập nhật này cho phép chúng ta làm được 2 việc: 1 là có thể thực hiện thao tác Edit bất cứ đối tượng hatch nào. kể cả là mẫu hatch lạ. 2 là có thêm đồ để chơi cho bằng anh bằng em. Ý tưởng thì như vậy. Triển khai thì chỉ đơn giản là nhúng thêm 1 đoạn code vào lệnh Hatchedit như sau: đọc mã DXF của đối tượng hatch -> kiểm tra xem tên pattern đã có trong thư viện chưa -> Nếu chưa thì đọc code cấu tạo vector của nó -> ghi thông tin thu được vào file thư viện -> load lại file thư viện -> tiếp tục thực hiện lệnh hatch edit như bình thường. Mình chỉ nêu ý tưởng và hóng thôi chứ giờ không viết nổi. Thank các bác đã đọc đến đây :D
  5. [Lisp tặng] Viết DCL bằng tiếng Việt font Unicode

    Giải pháp dành cho ai không muốn phải kèm cặp thêm file của bác ĐVH. - Viết sẵn 1 hạm dịch unicode sang hexcode và đặt trong thư viện hàm con vì còn dùng nó vào rất nhiều việc khác. - Khi viết code DCL thì nên lựa chọn giải pháp nhúng code DCL vào lisp luôn. - Đặt hàm dịch vào trước chuỗi code DCL. Hàm dịch thì mình nhớ trước đây mình đã từng chia sẻ trong diễn đàn rồi.
  6. Alt+Tab Từ Cad 2013+ Gây Ức Chế.

    Có bác nào ức chế khi sử dụng cụm phím này trong các bản autocad từ 2013 trở lên không ạ?. Mình hay phải copy thông tin từ bản vẽ ra word hoặc excel. Nếu mà mở 2 bản vẽ trở lên thì khi Alt+tab để chuyển sang Word hoặc Excel cứ phải nhấn 2 lần. Vấn đề là từ các chương trình khác khi muốn Switch sang cad thì chỉ cần 1 lần Alt+tab. quay ngược lại thì phải nhấn 2 lần. Nó khiến cho việc chuyển đổi qua lại giữa 2 phần mềm khó khăn hơn bình thường. Hỏi: Có cách nào để khắc phục được không?
  7. [Thư Viện] Tập hợp một số hàm entmake object

    Chưa đủ, vì đụng đến thằng nào thì mình mới viết cho thằng đấy. các bác bổ sung thêm các đối tượng khác cho em nó được tròn trịa. Tiện đây mình đố bác nào viết được cái hàm make MLine. mình trả 20 (+) luôn, hề hề :lol: ;|================================================= Entmake object defun by Thaistreetz - Cadviet.com ================================================== ====== List support object ======== - Text - Line - Point - LWPolyline - Spline - MakeCircle - MakeRectang - Layer - Wipeout - Group - MlineStyle (view more DelMLineStyle defun) - MakeMline _false :( - MakeRegion (one Boundary and Two Boundary) - Insert (support ATT Block) - Xline - Ray - Light ... ===================================|; (defun MakeText (point string Height Ang justify Style Layer Color xdata / Lst); Ang: Radial (setq Lst (list '(0 . "TEXT") (cons 8 (if Layer Layer (getvar "Clayer"))) (cons 62 (if Color Color 256)) (cons 10 point) (cons 40 Height) (cons 1 string) (if Ang (cons 50 Ang)) (cons 7 (if Style Style (getvar "Textstyle"))) (cons -3 (if xdata (list xdata) nil))) justify (strcase justify)) (cond ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point))))) ((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point))))) ((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point))))) ((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3))))) ((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3))))) ((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3))))) ((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2))))) ((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2))))) ((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2))))) ((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1))))) ((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1))))) ((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1)))))) (entmakex Lst));end ;================================= (defun MakeLine (PT1 PT2 Linetype LTScale Layer Color xdata) (entmakex (list '(0 . "LINE") (cons 8 (if Layer Layer (getvar "Clayer"))) (cons 6 (if Linetype Linetype "bylayer")) (cons 48 (if LTScale LTScale 1)) (cons 62 (if Color Color 256)) (cons 10 PT1) (cons 11 PT2) (cons -3 (if xdata (list xdata) nil)))));end ;================================= (defun MakeLWPolyline (listpoint closed Linetype LTScale Layer Color xdata / Lst) (setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity") (cons 8 (if Layer Layer (getvar "Clayer"))) (cons 6 (if Linetype Linetype "bylayer")) (cons 48 (if LTScale LTScale 1)) (cons 62 (if Color Color 256)) '(100 . "AcDbPolyline") (cons 90 (length listpoint)) (cons 70 (if closed 1 0)))) (foreach PP listpoint (setq Lst (append Lst (list (cons 10 PP))))) (if xdata (setq Lst (append lst (list (cons -3 (list xdata)))))) (entmakex Lst));end ;================================= (defun MakeCircle (point R Linetype LTScale Layer Color xdata) (entmakex (list '(0 . "CIRCLE") (cons 8 (if Layer Layer (getvar "Clayer"))) (cons 6 (if Linetype Linetype "bylayer")) (cons 48 (if LTScale LTScale 1)) (cons 62 (if Color Color 256)) (cons 10 point) (cons 40 R) (cons -3 (if xdata (list xdata) nil)))));end ;================================= (defun MakeRectang (PT1 PT2 Linetype LTScale Layer Color xdata) (entmakex (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity") (cons 8 (if Layer Layer (getvar "Clayer"))) (cons 6 (if Linetype Linetype "bylayer")) (cons 48 (if LTScale LTScale 1)) (cons 62 (if Color Color 256)) '(100 . "AcDbPolyline") (cons 90 4) (cons 70 1) (cons 10 PT1) (cons 10 (list (car PT1) (cadr PT2))) (cons 10 PT2) (cons 10 (list (car PT2) (cadr PT1))) (cons -3 (if xdata (list xdata) nil)))));end ;================================ (defun MakeLayer (name color linetype lineWeight plot) (entmakex (list '(0 . "LAYER") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbLayerTableRecord") (cons 2 name) (cons 70 0) (cons 62 (if color color 7)) (cons 6 (if linetype linetype "Continuous")) (cons 290 (if plot 1 0)) (cons 370 (if lineWeight (fix (* 100 lineWeight)) -3)))));end ;================================= (defun MakeSPline (listpoint Linetype LTScale Layer Color xdata / Lst) (setq lst (list '(0 . "SPLINE")'(100 . "AcDbEntity") (cons 8 (if Layer Layer (getvar "Clayer"))) (cons 6 (if Linetype Linetype "bylayer")) (cons 48 (if LTScale LTScale 1)) (cons 62 (if Color Color 256)) '(100 . "AcDbSpline") (cons 71 3) (cons 74 (length listpoint)))) (foreach PP listpoint (setq Lst (append Lst (list (cons 11 PP))))) (if xdata (setq Lst (append lst (list (cons -3 (list xdata)))))) (entmakex Lst));end ;================================ (defun MakeWipeout (listpoint Layer Color xdata / dxf10 max_dist cen dxf14) (if (not (member "acwipeout.arx" (arx))) (arxload "acwipeout.arx")) (setq dxf10 (list(apply'min(mapcar'car listpoint))(apply'min(mapcar'cadr listpoint))(if(caddar listpoint)(caddar listpoint)0)) max_dist(float(apply'max(mapcar'-(apply'mapcar(cons'max listpoint))dxf10))) cen (mapcar'+ dxf10(list(/ max_dist 2)(/ max_dist 2) 0.0)) dxf14 (mapcar'(lambda(p)(mapcar'/(mapcar'- p cen)(list max_dist(- max_dist)1.0)))listpoint) dxf14 (reverse(cons(car dxf14)(reverse dxf14)))) (entmakex (append (list '(0 . "WIPEOUT")'(100 . "AcDbEntity") (cons 8 (if Layer Layer (getvar "Clayer"))) (cons 62 (if Color Color 256)) '(100 . "AcDbWipeout")'(90 . 0) (cons 10 (trans dxf10 (list 0 0 1) 0)) (cons 11 (trans (list max_dist 0.0 0.0) (list 0 0 1) 0)) (cons 12 (trans (list 0.0 max_dist 0.0) (list 0 0 1) 0)) '(13 1.0 1.0 0.0)'(70 . 7)'(280 . 1)'(71 . 2) (cons 91 (length dxf14))) (mapcar'(lambda(p)(cons 14 p))dxf14) (list (cons -3 (if xdata (list xdata) nil))))));end ;================================ (defun MakeGroup (lstEname Description / dict ind) (setq dict (dictsearch (namedobjdict) "ACAD_GROUP") ind "GRP1") (while (member (cons 3 ind) dict) (setq ind (strcat "GRP" (itoa (1+ (atoi (substr ind 4))))))) (dictadd (cdr (assoc -1 dict)) ind (entmakex (append (list '(0 . "GROUP")'(100 . "AcDbGroup")(cons 300 Description)'(70 . 0)'(71 . 1))(mapcar'(lambda(x)(cons 340 x))lstEname)))) );end ;================================ (defun MakeMlineStyle (Name Description ColorFill LineLst / Dic Lst Obj) ; (LineLst: offset color linetype) (setq Lst (list (cons 0 "MLINESTYLE") (cons 100 "AcDbMlineStyle") (cons 2 Name) (if (and ColorFill (< 0 ColorFill 256)) (cons 70 1) (cons 70 0)) (cons 3 Description) (if (and ColorFill (< 0 ColorFill 256)) (cons 62 ColorFill) (cons 62 256)) (cons 51 (* pi 0.5)) (cons 52 (* pi 0.5)) (cons 71 (length LineLst)))) (foreach LL LineLst (setq Lst (append Lst (list (cons 49 (car LL)) (cons 62 (if (and (cadr LL) (< 0 (cadr LL) 256)) (cadr LL) 256)) (cons 6 (if (caddr LL) (caddr LL) "BYLAYER")))))) (if (and (setq Dic (dictsearch (namedobjdict) "ACAD_MLINESTYLE")) (not (dictsearch (setq Dic (cdr (assoc -1 Dic))) (cdr (assoc 2 LST)))) (setq Obj (entmakex Lst))) (dictadd Dic (cdr (assoc 2 Lst)) Obj)) );end (defun DelMLineStyle ( Name / Dic ) ; Remove Mline Style (if (setq Dic (dictsearch (namedobjdict) "ACAD_MLINESTYLE"))(dictremove (cdr (assoc -1 Dic)) Name)) );end ;================================ ;|(defun MakeMline (listpoint closed MLstyle Scale LTScale Justify Layer / LST) ;Justify: T M B (setq Lst (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (cons 8 (if Layer Layer (getvar "Clayer"))) '(100 . "AcDbMline") (cons 2 MLstyle) (cons 40 (if Scale Scale 1)) (cons 70 (cond ((= Justify "T") 0) ((= Justify "M") 1) ((= Justify "B") 2))) (cons 71 (if closed 3 1)) (cons 72 (length listpoint)) (cons 48 (if LTScale LTScale 1)) )))|; (defun MakeRegion (en) (if (vlax-curve-isClosed en) (vlax-invoke(vlax-get-property(vla-get-ActiveDocument(vlax-get-acad-object))(if(= 1(getvar'CVPORT))'Paperspace'Modelspace))'AddRegion(list(vlax-ename->vla-object en))))nil) (defun MakeRegion2 (en1 en2 / space) (setq space (vlax-get-property (vla-get-ActiveDocument (vlax-get-acad-object)) (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace))) (if (and (vlax-curve-isClosed en1) (vlax-curve-isClosed en1)) (vla-Boolean (vlax-invoke 'AddRegion (list (vlax-ename->vla-object en1))) acSubtraction (vlax-invoke 'AddRegion (list (vlax-ename->vla-object en2)))) nil) ) ;;;=============== Make insert block (defun MakeInsert (Blkname inspoint scale ang list_att layer color xdata / lst obj i) (setq lst '() i -1 en (cdr (last (tblsearch "block" Blkname))) obj (entget en)) (if (= (cdr(assoc 0 obj)) "ATTDEF") (setq lst (list (list (cdr(assoc 10 obj))(cdr(assoc 11 obj))(cdr(assoc 50 obj))(cdr(assoc 8 obj))(cdr(assoc 70 obj))(cdr(assoc 62 obj)) (cdr(assoc 40 obj))(assoc 7 obj)(assoc 71 obj)(assoc 72 obj)(assoc 2 obj))))) (while (setq en (entnext en)) (if (= (cdr(assoc 0 (setq obj(entget en)))) "ATTDEF") (setq lst (cons (list (cdr(assoc 10 obj))(cdr(assoc 11 obj))(cdr(assoc 50 obj))(cdr(assoc 8 obj))(cdr(assoc 70 obj))(cdr(assoc 62 obj)) (cdr(assoc 40 obj))(assoc 7 obj)(assoc 71 obj)(assoc 72 obj)(assoc 2 obj))lst)))) (entmakex(list '(0 . "INSERT")'(100 . "AcDbEntity") (cons 8 (if Layer Layer (getvar "Clayer"))) (cons 62 (if Color Color 256)) '(100 . "AcDbBlockReference") (if list_att '(66 . 1) '(66 . 0)) (cons 2 Blkname) (cons 10 (trans inspoint 1 0)) (cons 41 scale)(cons 42 scale)(cons 43 scale) (cons 50 Ang) (cons -3 (if xdata (list xdata) nil)))) (if lst (foreach LL (reverse lst) (entmake(list '(0 . "ATTRIB")'(100 . "AcDbEntity")(cons 8 (cadddr LL))(cons 60 (nth 4 LL)) (if (nth 5 LL) (cons 62 (nth 5 LL)) '(62 . 256))'(100 . "AcDbText") (cons 10(mapcar'+(trans inspoint 1 0)(mapcar'(lambda(x)(* scale x))(polar'(0 0 0)(+(angle'(0 0 0)(car LL))ang)(distance'(0 0 0)(car LL)))))) (cons 40 (* scale (nth 6 LL))) (cons 1 (nth (setq i (1+ i))list_att)) (cons 50 (+ ang (caddr LL))) '(41 . 1.0)(nth 7 LL)(nth 8 LL)(nth 9 LL) (if (= 0(cdr (nth 8 LL))(cdr(nth 9 LL)))(cons 11(list 0 0 0)) (cons 11(mapcar'+(trans inspoint 1 0)(mapcar'(lambda(x)(* scale x))(polar'(0 0 0)(+(angle'(0 0 0)(cadr LL))ang)(distance'(0 0 0)(cadr LL))))))) '(100 . "AcDbAttribute")'(280 . 0)(last LL)'(70 . 0)'(280 . 1))))) (dxf 330 (entmakex (list '(0 . "SEQEND") (cons 8 (if Layer Layer (getvar "Clayer"))))))) ;;;================ make point (defun MakePoint (point layer color) (entmakex (list '(0 . "POINT")'(100 . "AcDbEntity") (cons 8 (if Layer Layer (getvar "Clayer"))) (cons 62 (if Color Color 256)) '(100 . "AcDbPoint")(cons 10 point)))) ;;;================ make ray (defun MakeRay (Point vector layer color) (entmakex (list '(0 . "RAY")'(100 . "AcDbEntity") (cons 8 (if Layer Layer (getvar "Clayer"))) (cons 62 (if Color Color 256)) '(100 . "AcDbRay") (cons 10 Point) (cons 11 vector)))) (defun MakeXline (Point vector layer color) (entmakex (list '(0 . "XLINE")'(100 . "AcDbEntity") (cons 8 (if Layer Layer (getvar "Clayer"))) (cons 62 (if Color Color 256)) '(100 . "AcDbXline") (cons 10 Point) (cons 11 vector)))) ;;;================ make point light (defun MakeLight (Point) (if PointLightName (setq PointLightName (strcat "PtLight" (itoa (1+ (atoi (substr PointLightName 8)))))) (setq PointLightName "PtLight1")) (entmakex (list '(0 . "LIGHT")'(100 . "AcDbEntity")'(8 . "*ADSK_SYSTEM_LIGHTS")'(100 . "AcDbLight")'(90 . 1)(cons 1 PointLightName)(cons 10 Point))) );end Edit: Chú ý: - với code trên, bác nào không có nhu cầu dùng xdata thì nên sửa lại bỏ nó đi cho gọn. - Các tham số về layer, Color, Linetype, LTScale, Angle... Nếu đặt là nil thì hàm sẽ lấy các giá trị hiện hành của bản vẽ.
×