Nhờ chỉnh sửa lisp

[CadExTools 102]

27 phút trước, khanhkasu đã nói:

Chào anh (chị) CadExTools.

HIện tại mục đích của em chỉ là để lọc bản vẽ theo list có sẵn anh (chị) à.

Em có cái ý tưởng là lọc bản vẽ cuối cùng nữa - Em xin giải thích sơ bộ về cái em cần lọc.

Đề bài: Giả sử em có các bản vẽ có tên lần lượt là NS1CL001-R0, NS1CL001-R1, NS1CL001-R2 , NS1CL002-R0, NS1CL002-R1, NS1CL003-R0, NS1CL003-R1. Dựa vào số R0 hoặc R1 hoặc R2

để lấy bản vẽ final.

Kết quả: Em sẽ lấy được các ản vẽ final sau: NS1CL001-R2, NS1CL002-R1, NS1CL003-R1.

Anh ( chị) có thể giúp em cái này không?

Thân mến!

 

Đảm bảo rằng cái tên files của bạn đúng định dạng như bạn nói thì okie

[khanhkasu 2]

31 phút trước, CadExTools đã nói:

 

Đảm bảo rằng cái tên files của bạn đúng định dạng như bạn nói thì okie

Đúng như định dạng em nói anh à.

Thân mến!

[CadExTools 102]

10 phút trước, khanhkasu đã nói:

Đúng như định dạng em nói anh à.

Thân mến!

 

Okie. Gửi bạn.

CadExTools.rar

Giải nén để vào trong Folder -> Nhấn chạy.

chú ý: Mình chỉ xây dựng cho Revision từ R0-R7 mà thôi. Thử và cho két quả

[khanhkasu 2]

12 phút trước, CadExTools đã nói:

 

Okie. Gửi bạn.

CadExTools.rar

Giải nén để vào trong Folder -> Nhấn chạy.

chú ý: Mình chỉ xây dựng cho Revision từ R0-R7 mà thôi. Thử và cho két quả

Em cảm ơn anh - File chạy rất tốt.

Nếu được anh giúp em làm đến R12 là OK luôn.

Thân mến anh!

[CadExTools 102]

10 phút trước, khanhkasu đã nói:

Em cảm ơn anh - File chạy rất tốt.

Nếu được anh giúp em làm đến R12 là OK luôn.

Thân mến anh!

 

Okie, tới Rev bao nhiêu cũng dc

CadExTools.rar

[khanhkasu 2]

11 phút trước, CadExTools đã nói:

 

Okie, tới Rev bao nhiêu cũng dc

CadExTools.rar

Em cảm ơn anh (chị) rất nhiều. anh (chị) rất nhiệt tình.

Chúc anh (chị) và gia đình sức khỏe.

Thân mến!

[Van Phuong 1]

Thân gửi các anh em.

 

Mình có 1 lisp của hà quốc họ viết rất hay nhưng mình không load lên cad  của mình được. Toàn bị báo lỗi. 

Nội dung lisp cơ bản là: thể hiện chi tiết số đo chiều dài của 1 loạt đường pline.

ví dụ :  500+800+100+1000=24000

rất tiện lợi khi cần lập bảng khối lượng chi tiết. 

 

Mong các cao nhân kiểm tra và sửa lisp dùm. trong lisp có 1 số chỗ là tiếng hàn. sẽ bị lỗi font nên ko hiển thị được. 

Địa chỉ mail của mình :  dnfntk78@gmail.com.

 

Nội dung lisp:

 

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;// Ver 2014.07.11
(defun dtr (a) (* pi (/ a 180.0))) ;Degree To Radian
(defun rtd (a) (/ (* a 180.0) pi)) ;Radian To Degree
;// Ver 2015.08.09 editer by JBD 010-2245-5880
--------------------------------------------------------------------------------------
(defun c:aaa (/ _mrRtosNum _mrPoint *error* _mrSta _mrEnd gv gvL 
                acObj acDoc acSpc acadVer cObj L p1 oldP1 pObj pLst p2 dis ang pm dL o lst-entText
        width-p width)
    ;--------------------------------------------------------------------------------------------------
    ; ¼ýÀÚ¸¦ ¹Ý¿Ã¸² ÇÑÈÄ¿¡ ¼Ò¼öÁ¡ ÀÌÇÏ ÀÚ¸´¼ö ¸ÂÃß±â
    ;--------------------------------------------------------------------------------------------------
(defun M-error (msg)
 (setvar "dimzin" old-dimzin)
 (princ msg)
 (princ "\n``")
)
    (defun _mrRtosNum (n d / _mrRoundUp nS dS)
        (defun _mrRoundUp (n d)
      (/ (fix (+ (* n (expt 10.0 d)) 0.5)) (expt 10.0 d))
    )
    (setq n (_mrRoundUp n d))
        (setq nS (itoa (fix n)))
        (setq dS (substr (rtos (rem n (fix n))) 3 d))
        (cond
            ((> d 0)
                (if (> d (strlen dS))(repeat (- d (strlen dS))(setq dS (strcat dS "0"))))
                (setq nS (strcat ns "." dS))
            )
        ) nS
    )
    
    ;--------------------------------------------------------------------------------------------------
    ; ÁÂÇ¥¹Þ±â ¿É¼Ç
    ;--------------------------------------------------------------------------------------------------
    (defun _mrPoint (/ p1 Heigth DecimalTmp)
        (or Line_Decimal (setq Line_Decimal 2)) ; ¼Ò¼öÁ¡ ÀÌÇÏ ÀÚ¸´¼ö´Â ±¤¿ªº¯¼ö·Î ¼±¾ð
        (initget 16 "H D h d W w")
        (setq p1 (getpoint "\n½ÃÀÛÁ¡ ÁöÁ¤ ¶Ç´Â [Æø(W)/¹®ÀÚÅ©±â(H)/¼Ò¼öÁ¡ÀÚ¸´¼ö(D)]: "))
        (while (or (= p1 "H")(= p1 "D")(= p1 "h")(= p1 "d")(= p1 "W")(= p1 "w"))
            (cond
                ((or (= p1 "H")(= p1 "h"))
                    (and 
                        (setq Heigth (getdist (strcat "\n¹®ÀÚÅ©±â<" (rtos (getvar "textsize")) ">: ")))
                        (setvar "textsize" Heigth)
                    )
                )
                ((or (= p1 "D")(= p1 "d"))
                    (and
                        (setq DecimalTmp (getint (strcat "\¼Ò¼öÁ¡ÀÚ¸´¼ö<" (itoa Line_Decimal) ">: ")))
                        (setq Line_Decimal DecimalTmp)
                    )
                )
                ((or (= p1 "W")(= p1 "w"))
            (setq width-p (getdist (strcat "\Æø ÁöÁ¤<" (rtos width) ">: ")))
            (if width-p
               (Setq width width-p)
            )
                        (setcfg "appdata/distsum" (rtos width))
        )
            )
        (initget 16 "H D h d W w")
            (setq p1 (getpoint "\n½ÃÀÛÁ¡ ÁöÁ¤ ¶Ç´Â [Æø(W)/¹®ÀÚÅ©±â(H)/¼Ò¼öÁ¡ÀÚ¸´¼ö(D)]: "))
        )
    p1
    )
    
    ;--------------------------------------------------------------------------------------------------
    ; ¸®½ºÆ® Áߺ¹¿ä¼ÒÀÇ °¹¼ö¸¦ »êÃâÇÏ¿© ¸®½ºÆ® À籸¼º
    ;--------------------------------------------------------------------------------------------------
  (defun f:vl-remove (rm r_list  / temp temp_list)
(Setq temp_list '())
(foreach temp r_list 
         (If (not (equal temp rm 0.0001))
           (Setq temp_list (append temp_list (list temp)))
         )
)
temp_list
)
;--------------------------------------------------------------------------------------------------
(defun _mrListOccurrences (L / L1 L2 L3)
 (Setq temp '())
(Setq hhh L)
 (while L 
      (Setq L1 (car L))
      (Setq L2 (f:vl-remove L1 L))
      (Setq L3 (- (length L) (length L2) ))
      (Setq temp (append temp (list (list L1 L3))))
      (Setq L L2)
   );end while
   temp
    )
    
    ;--------------------------------------------------------------------------------------------------
    ; ¹®ÀÚ¸®½ºÆ®¸¦ ±¸ºÐÀÚ·Î »ç¿ëÇÏ¿© ÇϳªÀÇ ¹®ÀÚ·Î ¿¬°áÇÔ
    ;--------------------------------------------------------------------------------------------------
    (defun _mrLstStr (L d)
        (if (cdr L)(strcat (car L) d (_mrLstStr (cdr L) d))(car L))
    )
        
    ; º»¹®
    ;--------------------------------------------------------------------------------------------------
    (defun *error* (msg)
    ;(_mrEnd)
        (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
      (princ (strcat "\n** Error: " msg " **")))(princ)
    (command "undo" "end")
)
    ;--------------------------------------------------------------------------------------------------
    (defun _mrSta ()
        (and (= 8 (logand 8 (getvar 'UNDOCTL)))(vla-endundomark acDoc))
        (vla-startundomark acDoc)
        (setq gv (mapcar 'getvar (setq gvL '("CMDECHO"))))
        (mapcar 'setvar gvL '(0))
    )
    ;--------------------------------------------------------------------------------------------------
(defun _mrEnd ()
      (and gvL gv (mapcar 'setvar gvL gv))
      (vla-endundomark acDoc)
)
;--------------------------------------------------------------------------------------------------

;---------------------¹®ÀÚ ¸¸µé±â ---------------------------------------------------------------
(defun f:make_text (arrange_pt1 arrange_pt2 text_height color_number asscoc_72 asscoc_73 layer_name  text_style text_string
                    text_angle text_width /)
 (entmake (list (cons 0 "text")
                (cons 10 arrange_pt1);¹®ÀÚ¿­ ¿ÞÂÊ Á¤·ÄÁ¡
                (cons 11 arrange_pt2);72,73°ª¿¡ µû¶ó À¯µ¿
                (cons 40 text_height);¹®ÀÚ ³ôÀÌ
                (cons 62 color_number);»ö»ó
                (cons 71 0);¹®ÀÚ¹æÇâ,À§¾Æ·¡ µÚÁý±â
                (cons 72 asscoc_72);¼öÆòÀÚ¸® ¬ÁÖ±â 0=¿ÞÂÊ 1=Á᫐ 2=¿À¸¥ÂÊ 3,4,5----
                (cons 73 asscoc_73);¼öÁ÷ ¹®ÀÚ ÀÚ¸® ¸ÂÃß±â 0=±âÁؼ± 1=¸Ç¾Æ·¡ 2=Áß°£ 3=¸ÇÀ§
                (cons 8 layer_name)
                (cons 7 text_style)
                (cons 1 text_string)
                (cons 50 text_angle);¹®ÀÚ °¢µµ
;                (cons 51 text_obliqu) ;Oblique angle
                (cons 41 text_width);¹®ÀÚ Æø
           )
 )
 (setq p1  arrange_pt1)
 (setq h1  text_height)
 (setq ang text_angle)
 (setq pp1 (polar p1 (+ (dtr 90) ang) (* h1 3)))
 (command "text" "J" "MC" pp1 h1 (rtd ang) cnt)
 (setq cnt (1+ cnt))
 (command "circle" pp1 h1 )
)
;---------------- ·¹ÀÌ¾î ¸¸µé±â ------------------------------------------------------------
(defun f:make_layer (layer_name linetype_ color_number)
      (entmake (list (cons 0 "LAYER")
                 (cons 100 "AcDbSymbolTableRecord")(cons 100 "AcDbLayerTableRecord")
                 (cons 2 layer_name)
                 (cons 6 linetype_)
                 (cons 62 color_number)
                 (cons 70 0)
                 (cons 290 1);µµ¸é ÇÃ·Ô À¯¹« ¼³Á¤
                 (cons 370 0))
      )
)  
;---------------- Æú¸®¼± ¸¸µé±â ------------------------------------------------------
(defun f:make_lwpolyline (lst-pt layer-name tag width / )
(Setq lst-entmake-pt '())
(foreach x lst-pt
   (Setq lst-entmake-pt (append
                                  lst-entmake-pt
                                   (list (cons 10 x)(cons 40 0)(cons 41 0)(cons 42 0))
                              )
   )
)
(entmake
    (append 
     (list (cons 0 "lwpolyline")
           (cons 8 layer-name)
           (cons 100  "AcDbEntity")
           (cons 100  "AcDbPolyline")
           (cons 90 (length lst-pt))
           (cons 62 256)
           (cons 70 tag);1 = ´ÝÈù Æú¸®¼±
           (cons 43 width);°íÁ¤ Æø
      )
      lst-entmake-pt
    )
)
)
;------------------------------------------------------------------
      (defun s:marking-text ()
                    (setq dis (/ (distance p1 p2) 1000))
                    (setq ang (angle p1 p2))
                    (setq pm (mapcar '* '(0.5 0.5 0.5)(mapcar '+ p1 p2)))

;          (setq dL (append dL (list dis)))
;|
          (if (>= dis 1.0)
              (Setq strText (_mrRtosNum dis Line_Decimal))
              (progn
                 (Setq strText (rtos dis 2 Line_Decimal))
                 (Setq roundLen (- Line_Decimal (strlen (substr strText 3))))
                 (if (> roundLen 0)
                    (Repeat roundLen
                       (Setq strText (strcat strText "0"))
                   )
                );end if
             )
           );end if
|;
(Setq strText (rtos dis 2 Line_Decimal))
          
          (f:make_text 
                           pm ; arrange_pt1
                           pm ; arrange_pt2
                           (getvar "textsize"); text_height
                           6; color_number
                           1; asscoc_72
                           2; asscoc_73
                           "Line_Sanchul" ;layer_name
                           (getvar "TEXTSTYLE") ;text_style
                           strText; text_string
                           ang ;text_angle
                           1; text_width
          )
                    (setq dL (append dL (list strText))
                 lst-entText (append lst-entText (list (entlast)))
          )
          (setq p1 p2)
        )
;------------------------------------------------------------------
(defun f:vl-remove2 (rm element1 / temp temp_list)
(Setq temp_list '())
(Setq index 1)
(Repeat rm
   (Setq temp (nth (- index 1) element1)) 
   (And 
     (/= rm index)
     (Setq temp_list (append temp_list (list temp)))
   )
   (Setq index (+ index 1))
)
temp_list
)

;======== Main Start ===================================
(vl-load-com)
(Setq *error* M-error)
(Setq old-dimzin (getvar "dimzin"))
(setvar "dimzin" 8)

(command "undo" "be")
(setq cnt 1)
(And 
   (not (tblsearch "LAYER" "Line_Sanchul"))
   (f:make_layer "Line_Sanchul" "Continuous" 40)
)
(And 
    (not (Setq width (getcfg "appdata/distsum")))
    (setcfg "appdata/distsum" "0") 
    (Setq width "0")
)
(Setq width (atof width))

(setq dL '() ;°Å¸®ÇÕ ¸®½ºÆ®
        lst-entText '();°Å¸®ÇÕ ÅؽºÆ® ¸®½ºÆ®
)
(while (setq p1 (_mrPoint))
    (setq oldP1 p1 pObj nil)
    (setq pLst (list (list (car p1)(cadr p1))))
    (while 
        (progn
                (setq  end-close "T")
            (if (> (length pLst) 2)
        (progn
                (initget "C c U u")
                  (setq p2 (getpoint p1 "\n½ÇÇàÃë¼Ò(U)/´ÙÀ½Á¡ ÁöÁ¤ ¶Ç´Â [´Ý±â(C)]: "))
        )
                (if  (> (length pLst) 1)
          (progn
                  (initget "C c U u")
            (setq p2 (getpoint p1 "\n½ÇÇàÃë¼Ò(U)/´ÙÀ½Á¡ ÁöÁ¤: "))
          )
          (setq p2 (getpoint p1 "\n´ÙÀ½Á¡ ÁöÁ¤: "))
        )
            )
            (if p2
                (progn
                    (cond 
           ((or (= p2 "C") (= p2 "c"))
              (f:make_lwpolyline pLst "Line_Sanchul" 1 width);´ÝÈù Æú¸®¼±
                            (setq p2 oldP1)
              (Setq end-close nil)
              (s:marking-text)
           )
           ((or (= p2 "U") (= p2 "u"))
             (and
                 pObj 
               (entdel pObj)
               )
             (setq pLst (f:vl-remove (list (car p1)(cadr p1)) pLst));Æú¸®¼± ÁÂÇ¥°ª »èÁ¦ CADian 2010¿¡¼­´Â vl-removeÇÔ¼ö¿¡ ¿¡·¯°¡ ÀÖ´Ù.
             (setq dL (f:vl-remove (last dL) dL));°Å¸®ÇÕ »èÁ¦
             (Setq p1 (last pLst))
             (entdel (last lst-entText))
             (Setq lst-entText (f:vl-remove2 (length lst-entText) lst-entText));°Å¸®ÇÕ °´Ã¼ ¸®½ºÆ® »èÁ¦
             (if (/= (length pLst) 1)
                (progn
                 (f:make_lwpolyline pLst "Line_Sanchul" 0 width);¿­¸° Æú¸®¼±
                 (Setq pObj (entlast))
                )
                (Setq pObj nil)
             )
           )
                        ((not nil)
              (and pObj (entdel pObj))
                            (setq pLst (append pLst (list (list (car p2)(cadr p2)))))
              (f:make_lwpolyline pLst "Line_Sanchul" 0 width);¿­¸° Æú¸®¼±
              (Setq pObj (entlast))
              (s:marking-text )
            )
                    )
;//// Æú¸®¼± ±×¸®°í ÅؽºÆ® ÀÛµµ 
                    (if end-close t nil);close ¿É¼Ç µ¿À۽à ·çÇÁ Å»ÃâÇÑ´Ù. (progn )À» °á°ú¸¦ nil·Î ¸®ÅÏÇÏ°í ·çÇÁ¸¦ Å»ÃâÇÑ´Ù.
        )
            )
        )
    )

);end while
        ; °á°ú°ªÃâ·Â

(And
  dL 
  (progn
    (setq pm (getpoint "\n°á°ú°ª »ðÀÔÁ¡: "))
    (Setq sumStr "")
    (Setq Lst-length (_mrListOccurrences dL))
(princ Lst-length)
    (Setq totsum 0)
    (foreach x Lst-length
       (Setq totsum (+ totsum (* (atof (car x)) (cadr x))))
       (if (= (cadr x) 1.0)
           (Setq sumStr (strcat sumStr "+" (car x))) ;Line_Decimal
       (Setq sumStr  (strcat sumStr "+"  (strcat (car x) "*" (rtos (cadr x) 2 0)))) ;Line_Decimal
;           (Setq sumStr (strcat sumStr "+" (_mrRtosNum (car x) 1))) ;Line_Decimal
;                 (Setq sumStr  (strcat sumStr "+"  (strcat (_mrRtosNum (car x) 1) "*" (rtos (cadr x) 2 0)))) ;Line_Decimal
      )
    )
    (f:make_text 
                    pm ; arrange_pt1
                    pm ; arrange_pt2
                    (getvar "textsize"); text_height
                    7; color_number
                    1; asscoc_72
                    2; asscoc_73
                    "Line_Sanchul" ;layer_name
                    (getvar "TEXTSTYLE") ;text_style
                    (substr (strcat sumStr "=" (rtos totsum 2 Line_Decimal)) 2)
                    0 ;text_angle
                    1; text_width
    )
  )
);and
(command "undo" "end")
(setvar "dimzin" old-dimzin)
(Setq f:make_text nil f:make_lwpolyline nil f:make_layer nil  f:vl-remove nil f:vl-remove2 nil)
(princ)
)
(princ "[¸í·É¾î : `` ]")(princ)
 

 

 

 

Xin cảm ơn.

 

 

산출(4)주로사용.lsp