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

ngokiet

Thành viên
  • Số lượng nội dung

    404
  • Đã tham gia

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

  • Ngày trúng

    43

Bài đăng được đăng bởi ngokiet


  1. 12 phút trước, DuongTrungHuy đã nói:

    Gửi Bạn:

     

    Định copy ra đây mấy thứ thì đã có người kiếm được trang web. Cái này mình viết lâu quá nên cũng không nhớ hết cũng copy lại các Bạn xem sao

     

              (setq tamO2 (cal "plt(dOO3,dOO4,0.5)+kctron2*dau42*nor(dOO3,dOO4)"))
              (setq kcO2 (cal "dpl(tamO2,dOO1,dOO2)") dcO2 (distance dOO1 tamO2))
             (setq da1 (cal "diemO1+huong*1.5*lanve*nor(diemO1,diemO2)") da2 (cal "diemO2+huong*1.5*lanve*nor(diemO1,diemO2)"))
             (setq da1 (cal "rot(diemO1,tamquay,huong*2.0*lanve)") da2 (cal "rot(diemO2,tamquay,huong*2.0*lanve)"))
             (cal "2+3*5^2 + sin(2.3)") 

    Thanks bác. Có điều lệnh cal này hơi khó chịu 1 chút là nếu sai thì dễ gây treo khi lập trình lisp khi chạy thử. Nhiều hàm cũng hay và có hàm lisp tương ứng. Nếu rảnh thì viết lại bằng lisp thì mình nghĩ hay hơn.

    • Like 2

  2. Test thử lệnh cal thây có Hàm nor cũng vui nên thử viết lisp chuyển 3dpolyline thành lwpoline.

    (defun c:test(/ en lp a210 a70 p1 p2 p3)
      (setq en (car(entsel "select 3d polyline"))
    	lp (acet-geom-vertex-list en))
      (mapcar 'set '(p1 p2 p3) lp)
      (setq a210 (cal "nor(p1,p2,p3)"))
      (if (eq (car lp) (last lp))
        (setq a70 1
    	  lp (reverse (cdr (reverse lp))))
        (setq a70 0))
      (setq lp (mapcar '(lambda(x) (trans x 0 a210)) lp))
    	
      (entmakex (append
    	      (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
    		    (cons 38 (caddar lp)) (cons 90 (length lp)) (cons 70 a70))
    	      (mapcar '(lambda(x) (list 10 (car x) (cadr x))) lp)
    	      (list (cons 210 a210))))
      (princ))

    Viết sơ đơn giản nên không kiễm tra đấu vào và yêu cầu 3 điểm đấu tiên của 3dpolyline phải không thăng hàng.

    Chưa kiểm tra đồng phẳng của 3d polyline (Kiềm tra lại z của các đinh sau khi trans.)

    Lệnh cal nor sẽ tính pháp vector làm assoc 210. Bình thường nếu không dùng lệnh cal nor này thì có thể dùng lisp của leemac để tính.

    https://www.cadtutor.net/forum/topic/24823-3-3d-point-to-ucs-extrusion-direction/

    • Like 1

  3. Autolisp là ngôn ngữ lập trình bậc cao.

    Nó thật sự là nói cho máy hiểu phải làm gì.

    Mối cầu lệnh như 1 câu nói. 1 lệnh có cấu trúc là 1 danh sách được viết giữa 2 dấu (). Trong đó đầu tiên là tên lệnh và các tham số của nó. Máy sẽ đọc tên lệnh và dựa trên các tham số để thực hiện.

    Do cấu trúc () nên nó sẽ thực hiện từ đầu đến cuối, từ trong ra ngoài. Tức là nó găp 1 lệnh nếu bên trong có lệnh nó sẽ làm bên trong trước.

    Ngoại trước lệnh defun lambda là 2 lệnh tạo lệnh là nó ghi nhớ để thực hiện nhóm lệnh khi được gọi. Đây là 2 lệnh tạo lệnh mới.

    Các lệnh autolisp luôn trả về 1 giá trị nào đó. Thường là giá trị sau cùng của lệnh. Bạn có thể sử dụng tiếp hay không. Vì lý do này nên thường cuối 1 hàm hay 1 líp thì người ta thường viết thêm (princ) để giá trị hàm trả về là null. (hàm princ ko có tham số nó sẽ trả về null] và bạn sẽ ko thấy gì thể hiện ra.

    • Like 1

  4. 20 phút trước, Ngô Tuấn bn đã nói:

    vâng ạ, ý em là làm thế làm để convert đối tượng 3d kia về 2d để thao tác CNC thôi bác ạ.

     

    Vào lúc 4/7/2020 tại 14:03, ngokiet đã nói:

    Cái bản vẽ bạn gởi tham khảo thì cũng chĩ 2D thôi. Do nó có thickness nên nó thành 3D thôi.

    - Bạn chọn tất cả rồi bên bản properties - Thickness sửa thành 0 là được.

    Cái này đôi khi do vẽ 2d nhưng thickness mặc dịnh #0 nên nó có thêm chiều cao.

    Bạn làm theo chữ in đậm chưa?

    • Like 1

  5. 2 giờ trước, Duong Nhat Duy đã nói:

    Thì ý mình là mình ko muốn nút chuột back tự nhiên lại có thêm chức năng Ctrl Z trong windows, word, excel, như thế lại thành bất tiện. Còn mình chỉ ví dụ trường hợp Cut, cụ thể là ntn: mình làm việc trên server, file xóa thì ko lấy lại được, giả sử mình cut 1 file nào đó rồi đè lên 1 file khác, xong Ctrl Z thì file đó bốc khói luôn. Ý nói đến những khả năng không lường trước được của thao tác gán Ctrl Z vào chuột

    Trong CUI thì button 2 là nút phải, Button 3 là nút giửa. các button khác thì mình thấy không sài bao giờ. Nếu có chắc là Cad phải có drive riêng.

    Bạn có thể set thêm shotcut khác cho undo/redo sau đó gán cho mouse. Tuy nhiên sẽ không sài được chức năng chuột trong chương trình khác.

    Còn nếu bạn sài logitech giống mình thì có thể set riêng cho ứng dụng. Lúc này chỉ có ứng dụng bạn gán là nó hoạt đông như vậy. Các chương trình khác thì bình thường

    image.thumb.png.b0eb0bd2046f380975d7b7d6b8786a51.png

    • Vote tăng 1

  6. Đọc hiểu ý chủ thớt thôi cũng mệt.

    Mình có 2 lisp này viết cho vui.

    - Lisp 1. Loại bỏ dỉnh trùng nhau liên tiếp và tụ động close pline nếu điểm đầu cuối trùng nhau.

    (defun c:fixpl(/ fpl)
      (defun fpl(e1 / c s1 s2 s3 st pn)
        (setq e1 (entget e1)
    	  s1 (vl-remove-if '(lambda(x / sa) (Cond ((= (Setq sa (car x)) 10)
    						   (setq s2 (cons (reverse st) s2)
    						         st (list (cdr x))))
    						  ((member sa '(40 41 42 91)) (setq st (cons (cdr x) st)))))
    	       e1)
    	  c (cdr(assoc 70 s1))
    	  s2 (cdr (reverse (cons (reverse st) s2)))
    	  pn (car s2))
        (foreach x (cdr s2)
          (if (>= (distance (car pn) (car x)) 1e-6)
            (setq s3 (cons pn s3)))
          (setq pn x))
        (if (< (distance (car pn) (car(last s3))) 1e-6)
          (setq c 1)
          (setq s3 (cons pn s3)))
        (entmod (append (subst (cons 70 c) (assoc 70 s1) (subst (cons 90 (length s3)) (assoc 90 s1) s1))
    		      (apply 'append (mapcar '(lambda(x) (mapcar 'cons '(10 40 41 42 91) x)) (reverse s3))))))
      (mapcar 'fpl (acet-ss-to-list (ssget '((0 . "LWPOLYLINE")))))
      
      (princ))

    Lisp 2. Là chọn nhanh polyline theo cạnh hay open/close. Muốn đổi màu hay làm gì thì tùy.

    (defun c:sspl(/ a)
      (initget 0 "Open Close")
      (if (setq a (getint "Chon so dinh polyline [Open/Close]:")
    	    a (cond ((= a "Open") '(70 . 0))
    		    ((= a "Close") '(70 . 0))
    		    (a (cons 90 a))))
        (sssetfirst nil (ssget (list '(0 . "LWPOLYLINE") a)))))

    Ai thích thì có thể thêm chọn nhanh hình chữ nhật, polygon thì tùy.

    @Doan Nguyen Van Nếu pline có cạnh là arc mà 4 dĩnh theo hình chữ nhật thì lisp của bạn vẫn xem là hình chữ nhật nhỉ.

    • Like 1

  7. 9 giờ trước, Duong Nhat Duy đã nói:

    Bạn cho mình hỏi thêm chút là làm sao để lấy được đống point nhập từ người dùng kia, hay là số, xâu đối với các hàm command khác ?

    Mình cảm ơn !

    Dùng initget và getpoint để nhận thông tin rồi mới truyền lại cho command bpoly.  Lúc đó bạn mới lưu được các điểm hay string nhập vào.


  8. 1 giờ trước, minhtri2701 đã nói:

    Thân gửi ANh Em!

    hiện tại mình dùng lệnh Torient để xoay chử theo 1 đường thẳng cho trước!

    tuy nhiên, kho thao tác trong bản vẽ thì xuất hiện lỗi (theo hình đính kèm)

    rất mong Anh Em hướng dẫn cách khắc phục

    cảm ơn

     

    Dịch cái lỗi đó ra là hiểu mà. Object bạn chọn có ucs không song song với ucs hiện hành.

    Nếu chuyển về Wcs mà text vẫn ko có ucs song song với wcs nó vẫn bị lỗi.

    Cách khắc phục :  FLATTEN để chuyển text về ucs hiện hành.


  9. 1 giờ} trướ}c, Duong Nhat Duy đã nói:

    Mình cảm ơn nhé, tiện bạn cho mình hỏi đoạn 

    (setq lastent (entlast))

    (while (setq x (entnext lastent)) (setq lastent x))

    có ý nghĩa gì nhỉ, khi nào thì (entlast) không lấy được đối tượng sau cùng của bản vẽ

    Khi entlast là block có att. Có thể là 1 ent khác có ent con đọc bằng entnext. Mình chưa test hết.


  10. 2 giờ trước, Duong Nhat Duy đã nói:

    Các bạn cho mình hỏi:

    Mình có đoạn code

    • cadvietlisp.lsp
      lisp help
    •  
    
    (command "._BPOLY")
    (while (> (getvar "CMDACTIVE") 0)
     (command pause)
     )

    Lệnh BPOLY nó tạo 1 vài polyline, làm thế nào để lấy được thông tin các polyline đó, như dạng selection set chẳng hạn.

    Mình cảm ơn !

    Lưu lại entlast. Trước Rồi entnext để lấy.

    (setq lastent (entlast))

    (while (setq x (entnext lastent)) (setq lastent x))

    (setq x nil))

    (command "._BPOLY") (while (> (getvar "CMDACTIVE") 0) (command pause) )
    (while  (setq lastent (entnext lastent)) (setq x (cons lastent x)))

    • Vote tăng 1

  11. 44 phút trước, nguyen son hai đã nói:

    em biết về lisp đâu bác. sửa như nào giúp em với ạ

    Lười nên viết đơn giản. Nếu bạn viết 1 text trước đó rồi thì nó theo text cũ.

    Mình không biết tỉ lệ vẽ bạn nên có sữa tại text cao là 10.0 bạn muốn thay đổi thì sửa lại. (sửa trên lisp cũ ở trên)

    Còn text ghi ra theo unit mặc định. Nếu thích thì tự sửa.

    Bác sài lisp thì nên nghiên cứu sơ mấy lệnh cơ bản để sửa lisp thích hợp với mình.


  12. Vào lúc 14/4/2020 tại 16:06, nguyen son hai đã nói:

    không phải lisp này bác ơi. cái này là tính diện tích các vùng kín riêng biệt, ý em là trên trắc ngang có rất nhiều điểm, muốn tính diện tích tạo bở 1 vài điểm bất kỳ, ta bấm giống lệnh aa của acad ấy ạ. nhưng sau đó  có mục ghi ra nền chứ không phải xem ở    f2 ạ

    Thử lisp này

    (defun c:test2()
      (command "area")
      (while (not (zerop (getvar 'cmdactive)))
        (command pause))
      (command "_text" (getpoint "diem dat text") 10.0 "" (rtos (getvar 'area)) "")
      (princ))

     


  13. 32 phút trước, thanhduan2407 đã nói:

    Viết lisp tạo block động khó không anh? Em nghĩ code sẽ rất dài. 
    Thường thì em tạo block động trên Cad thôi.

     

    Hình như không tạo được. Chỉ tạo sẵn rồi copy lại code file dxf chèn vào lisp.

    Em viết cái lisp vẽ cầu dài quá làm nản ai muôn học lisp luôn.

    Anh viết đơn giản tí.

    (defun c:vc(/ p1 p2 p3 p1+ p2+ ang ang1 old d)
      (setq p1 (getpoint "Nhap diem 1:")
    	p2 (getpoint "Nhap diem 2:")
    	p3 (getpoint "Nhap diem 3:")
    	old (getvar 'osmode)
    	ang (angle p1 p2)
    	d  (* (distance p3 p1) (sin (- (angle p1 p3) ang)))
    	p1+ (polar p1 (+ ang (/ pi 2)) d)
    	p2+ (polar p2 (+ ang (/ pi 2)) d)
    	ang2 (if (< d 0) (/ pi 4) (/ pi -4)))
      (setvar 'osmode 0)
      (command "_pline" (polar p1 (+ ang (* 3 ang2)) 2) p1 p2 (polar p2 (+ ang ang2)2) "")
      (command "_pline" (polar p1+ (- ang (* 3 ang2)) 2) p1+ p2+ (polar p2+ (- ang ang2) 2) "")
      (setvar 'osmode old)
      (princ))

     

    • Like 1

  14. 15 giờ trước, lethanh2004 đã nói:

    Cảm ơn bác Duân . ko ngờ để làm đc 1 lisp khó vậy . chắc phải mót nhiều nhiều chắc mới làm đc 1 lisp cho riêng mình

    Không khó như vậy đâu. Bạn phải nhận Đức liệu cho đủ. Rồi tính toán thành 8 điểm tương ứng. Sau đó rồi vẽ ra thôi.

    Tham khảo thêm lệnh polar, angle là có thể tạo ra 1 lisp  đơn giản cho mình. Sau đó bổ sung thêm những thứ linh tinh như layer, nét vẽ.

    Tuy nhiên mình thấy vẽ cầu thì nên vẽ bằng block động thì đơn giản hơn.

    • Vote tăng 1

  15. 48 phút trước, thiep đã nói:

     

    Cũng vì muốn truy cho ra lỗi này, mà mình đã tìm được cách thêm tiền tố hay hậu tố trong field đưa ra text có sẵn: ví dụ giá trị thuộc tính là 123.45;

     

    Do bạn nói ở lệnh fdt2 nên mình chỉ xem lệnh fdt2. Khi nó tính field trong biểu thức thì nó dùng kiểu số thực/ số nguyên nếu text là số thực/số nguyên.

    Nếu tất cả là số nguyên thì nó ra kết quả số nguyên. Còn không thì ra kiểu số thực.

    Measurement của Dim là số thực nên khi cộng xong nó sẽ cho ra số thực. 

    Mà số thực thì field thể hiện theo mặc định là 6 chữ số lẻ. Cho nên nếu bạn muốn ghi số lẻ cho đúng theo kiểu cùa dim thì bạn phải xem kiểu dim có bao nhiêu số lẻ rồi set tương ứng thôi.

     

    Lưu ý là trong biểu thức field thì các giá tri con không cần format vì nó ko có nghĩa.

    VD:  "%<\\AcExpr (%<\\AcObjProp Object(%<\\_ObjId 2202349431104>%).Length \\f \"%lu2%pr1\">%+%<\\AcObjProp Object(%<\\_ObjId 2202349431152>%).Length \\f \"%lu2%pr1\">%) >%"

    Thì nó cũng ra 6 số lẻ tương đương

     "%<\\AcExpr (%<\\AcObjProp Object(%<\\_ObjId 2202349431104>%).Length>%+%<\\AcObjProp Object(%<\\_ObjId 2202349431152>%).Length>%) >%"

    (Chỉ có cái format sau cùng là có nghĩa)

     

    Còn tự động bỏ số 0 thừa phía sau lá "\\f \"%zs8\">%". Lưu ý nếu Measurement  có sai số thì sẽ không thực hiện được.

    Theo yêu cầu nếu sửa thay đổi thì bạn làm 1 hàm đổi các dim mặc định thành Dim TextOverride thì dễ hơn.

     

    • Like 1

  16. Vào lúc 7/4/2020 tại 10:41, thiep đã nói:

     

    
    ;;; LISP  FIELD SUM DIMENSIONS, TEXTs, MTEXTs, LENGTHs, AREAs, CIRCUMFERENCEs TO A TEXT
    ;;;          by TrânThiêp 04/2020
    ;;;		09188411230
    ;;;=======================================================
    ;;; command         fdt1 : field sum DIMENSIONS                        
    ;;; command         fdt2 : field sum TEXTs, MTEXTs                     
    ;;; command         fdt3 : field sum LENGTHs                           
    ;;; command         fdt4 : field sum AREAs                             
    ;;; command         fdt5 : field sum CIRCUMFERENCEs                    
    ;;;                                                       
    (defun DXF (code en) (cdr (assoc code (entget en))))
    ;;;===========================================================================1: sum DIMENSIONs =========
    (defun c:fdt1 (/  ss ent_T Obj_Text str prec Lobj_dim ID_Dim_lst field_lst)
        (vl-load-com)
        (command "undo" "be")
        (defun *error* (msg)
            (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
                (princ (strcat "\n** Error: " msg " **"))
            )
            (acet-sysvar-restore)
            (command "undo" "en")
            (princ)
        )
        (acet-sysvar-set '("cmdecho" 0 "osmode" 0))
        (acet-ui-status "Select DIMENSIONs FOR GET SUM" "Prompt")
        (setq ss (ssget '((0 . "DIMENSION"))))
        (acet-ui-status)
        (while (OR (NOT (setq ent_T
                                 (car (entsel
                                          "\nPick a Text object for set sum dimensions"
                                      )
                                 )
                        )
                   )
                   (NOT (eq (cdr (assoc 0 (entget ent_T))) "TEXT"))
               )
            (prompt "\nPick not right TEXT object, please pick again")
        )
        (setq Obj_Text (vlax-ename->vla-object ent_T))
        (if (null (setq prec (getint (acet-str-format
                                         "\nEnter number of decimal places: <%1> "
                                         (itoa (getvar "useri1"))
                                     )
                             )
                  )
            )
            (setq prec (getvar "useri1"))
        )
        (setvar "useri1" prec)
        (if ss
            (progn
                (mapcar
                    '(lambda (x)
                         (setq Lobj_dim (CONS (vlax-ename->vla-object x) Lobj_dim))
                     )
                    (acet-ss-to-list ss)
                )
                (setq ID_Dim_lst (mapcar 'vla-get-objectid Lobj_dim))
                (Setq field_lst
                         (mapcar
                             '(lambda (ob id)
                                  (if (distof (vla-get-TextOverride ob))
                                      (acet-str-format
                                          "%<\\AcObjProp Object(%<\\_ObjId %1>%).%2>%+"
                                          (itoa id)
                                          "TextOverride"
                                      )
                                      (acet-str-format
                                          "%<\\AcObjProp Object(%<\\_ObjId %1>%).%3 \\f \"%lu2%pr%2\">%+"
                                          (itoa id)
                                          (itoa prec)
                                          "Measurement"
                                      )
                                  )
                              )
                             Lobj_dim
                             ID_Dim_lst
                         )
                )
                (setq str (acet-str-format
                              "%<\\AcExpr (%1) \\f \"%lu2%pr%2\">%"
                              (vl-string-right-trim "+" (apply 'strcat field_lst))
                              (itoa prec)
                          )
                )
                (vla-put-TextString Obj_Text str)
            ) ;_PROGN
        ) ;_IF
        (ACET-SYSVAR-RESTORE)
        (command "undo" "en")
        (PRINC str)
        (princ "\nOK")
        
    )
    ;;;===========================================================================2: sum TEXTs, MTEXTs NUMBER=========
    (defun c:fdt2 (/  ss ent_T Obj_Text str prec Lobj_text ID_text_lst field_lst)
        (vl-load-com)
        (command "undo" "be")
        (defun *error* (msg)
            (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
                (princ (strcat "\n** Error: " msg " **"))
            )
            (acet-sysvar-restore)
            (command "undo" "en")
            (princ)
        )
        (acet-sysvar-set '("cmdecho" 0 "osmode" 0))
        (acet-ui-status "Select:  TEXT, MTEXT NUMBER FOR GET SUM" "Prompt")
        (setq ss (ssget '((0 . "*TEXT"))))
        (acet-ui-status)
        (if ss
            (progn
                (while (OR (NOT (setq ent_T
                                         (car
                                             (entsel
                                                 "\nPick a Text object for set sum text number"
                                             )
                                         )
                                )
                           )
                           (NOT (eq (cdr (assoc 0 (entget ent_T))) "TEXT"))
                       )
                    (prompt "\nPick not right TEXT object, please pick again")
                )
                (setq Obj_Text (vlax-ename->vla-object ent_T))
                (if (null (setq
                              prec (getint
                                       (acet-str-format
                                           "\nEnter number of decimal places: <%1> "
                                           (itoa (getvar "useri2"))
                                       )
                                   )
                          )
                    )
                    (setq prec (getvar "useri2"))
                )
                (setvar "useri2" prec)
                (mapcar
                    '(lambda (x)
                         (if (Numberp (atof (dxf 1 x)))
                             (setq Lobj_text (CONS (vlax-ename->vla-object x)
                                                   Lobj_text
                                             )
                             )
                         )
                     )
                    (acet-ss-to-list ss)
                )
                (setq ID_text_lst (mapcar 'vla-get-objectid Lobj_text))
                (setq field_lst
                         (mapcar
                             '(lambda (x)
                                  (acet-str-format
                                      "%<\\AcObjProp Object(%<\\_ObjId %1>%).TextString>% +"
                                      (itoa x)
                                  )
                              )
                             ID_text_lst
                         )
                )
                (setq str (acet-str-format
                              "%<\\AcExpr (%1)>%"
                              (vl-string-right-trim "+" (apply 'strcat field_lst))
                          )
                )
                (vla-put-TextString Obj_Text str)
            ) ;_PROGN
        ) ;_IF
        (ACET-SYSVAR-RESTORE)
        (command "undo" "en")
        (princ "\nOK")
        (PRINC)
    )
    ;;;===========================================================================3: LENGTHs=========
    (defun c:fdt3 (/ ss ent_T Obj_Text str prec Lobj_leng ID_leng_lst field_lst)
        (vl-load-com)
        (command "undo" "be")
        (defun *error* (msg)
            (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
                (princ (strcat "\n** Error: " msg " **"))
            )
            (acet-sysvar-restore)
            (command "undo" "en")
            (princ)
        )
        (acet-sysvar-set '("cmdecho" 0 "osmode" 0))
        (acet-ui-status "Select:  LINE, POLYLINE, for GET SUM LENGTH"
                        "Prompt"
        )
        (setq ss (ssget '((0 . "LINE,*POLYLINE"))))
        (acet-ui-status)
        (if ss
            (progn
                (while (OR (NOT (setq ent_T
                                         (car
                                             (entsel
                                                 "\nPick a Text object for set sum length value"
                                             )
                                         )
                                )
                           )
                           (NOT (eq (cdr (assoc 0 (entget ent_T))) "TEXT"))
                       )
                    (prompt "\nPick not right TEXT object, please pick again")
                )
                (setq Obj_Text (vlax-ename->vla-object ent_T))
                (if (null (setq
                              prec (getint
                                       (acet-str-format
                                           "\nEnter number of decimal places: <%1> "
                                           (itoa (getvar "useri3"))
                                       )
                                   )
                          )
                    )
                    (setq prec (getvar "useri3"))
                )
                (setvar "useri3" prec)
                (mapcar
                    '(lambda (x)
                         (if (vlax-property-available-p (vlax-ename->vla-object x)
                                                        'length
                             )
                             (setq Lobj_leng (CONS (vlax-ename->vla-object x)
                                                   Lobj_leng
                                             )
                             )
                         )
                     )
                    (acet-ss-to-list ss)
                )
                (setq ID_leng_lst (mapcar 'vla-get-objectid Lobj_leng))
                (setq field_lst
                         (mapcar
                             '(lambda (id)
                                  (acet-str-format
                                      "%<\\AcObjProp Object(%<\\_ObjId %1>%).Length \\f \"%lu2%pr%2\">%+"
                                      (itoa id)
                                      (itoa prec)
                                  )
                              )
                             ID_leng_lst
                         )
                )
                (setq str (acet-str-format
                              "%<\\AcExpr (%1) \\f \"%lu2%pr%2\">%"
                              (vl-string-right-trim "+" (apply 'strcat field_lst))
                              (itoa prec)
                          )
                )
                (vla-put-TextString Obj_Text str)
            ) ;_PROGN
        ) ;_IF
        (ACET-SYSVAR-RESTORE)
        (command "undo" "en")
        (princ "\nOK")
        (PRINC)
    )
    ;;;===========================================================================4: AREAs=========
    (defun c:fdt4 (/ ss ent_T Obj_Text Lobj_area ID_area_lst str prec field_lst)
        (vl-load-com)
        (command "undo" "be")
        (defun *error* (msg)
            (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
                (princ (strcat "\n** Error: " msg " **"))
            )
            (acet-sysvar-restore)
            (command "undo" "en")
            (princ)
        )
        (acet-sysvar-set '("cmdecho" 0 "osmode" 0))
        (acet-ui-status
            "Select: POLYLINE, HATCH, ARC, CIRCLE, REGION, ELLIPSE for GET SUM AREA"
            "Prompt"
        )
        (setq ss (ssget '((0 . "*POLYLINE,HATCH,ARC,CIRCLE,ELLIPSE,REGION"))))
        (acet-ui-status)
        (if ss
            (progn
                
                (mapcar
                    '(lambda (x)
                         (if (vlax-property-available-p (vlax-ename->vla-object x)
                                                        'area
                             )
                             (setq Lobj_area (CONS (vlax-ename->vla-object x) Lobj_area))
                         )
                     )
                    (acet-ss-to-list ss)
                )
                (if (null (setq
                              prec (getint
                                       (acet-str-format
                                           "\nEnter number of decimal places: <%1> "
                                           (itoa (getvar "useri4"))
                                       )
                                   )
                          )
                    )
                    (setq prec (getvar "useri4"))
                )
                (setvar "useri4" prec)
                (setq ID_area_lst (mapcar 'vla-get-objectid Lobj_area))
                (setq field_lst
                         (mapcar
                             '(lambda (id)
                                  (acet-str-format
                                      "%<\\AcObjProp Object(%<\\_ObjId %1>%).Area \\f \"%lu2%pr%2\">%+"
                                      (itoa id)
                                      (itoa prec)
                                  )
                              )
                             ID_area_lst
                         )
                )
                (setq str (acet-str-format "%<\\AcExpr (%1) \\f \"%lu2%pr%2\">%"
                                           (vl-string-right-trim "+" (apply 'strcat field_lst))
                                           (itoa prec)
                          )
                )
                (while (OR (NOT (setq ent_T
                                         (car
                                             (entsel
                                                 "\nPick a Text object for set sum area value"
                                             )
                                         )
                                )
                           )
                           (NOT (eq (cdr (assoc 0 (entget ent_T))) "TEXT"))
                       )
                    (prompt "\nPick not right TEXT object, please pick again")
                )
                (setq Obj_Text (vlax-ename->vla-object ent_T))
                (vla-put-TextString Obj_Text str)
            ) ;_PROGN
        ) ;_IF
        (ACET-SYSVAR-RESTORE)
        (command "undo" "en")
        (princ "\nOK")
        (PRINC)
    )
    ;;;==================================================================    5: CIRCUMFERENCEs: CHU VI VÒNG TRÒN
    (defun c:fdt5 (/  ss ent_T Obj_Text Lobj_CIR ID_CIR_lst str prec field_lst)
        (vl-load-com)
        (command "undo" "be")
        (defun *error* (msg)
            (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
                (princ (strcat "\n** Error: " msg " **"))
            )
            (acet-sysvar-restore)
            (command "undo" "en")
            (princ)
        )
        (acet-sysvar-set '("cmdecho" 0 "osmode" 0))
        (acet-ui-status "Select: CIRCLE for GET SUM CIRCUMFERENCE" "Prompt")
        (setq ss (ssget '((0 . "CIRCLE"))))
        (acet-ui-status)
        (while (OR (NOT (setq ent_T
                                 (car
                                     (entsel
                                         "\nPick a Text object for set sum circumference value"
                                     )
                                 )
                        )
                   )
                   (NOT (eq (cdr (assoc 0 (entget ent_T))) "TEXT"))
               )
            (prompt "\nPick not right TEXT object, please pick again")
        )
        (setq Obj_Text (vlax-ename->vla-object ent_T))
        (if ss
            (progn
                (mapcar
                    '(lambda (x)
                         (setq Lobj_CIR (CONS (vlax-ename->vla-object x) Lobj_CIR))
                     )
                    (acet-ss-to-list ss)
                )
                (if (null (setq
                              prec (getint
                                       (acet-str-format
                                           "\nEnter number of decimal places: <%1> "
                                           (itoa (getvar "useri5"))
                                       )
                                   )
                          )
                    )
                    (setq prec (getvar "useri5"))
                )
                (setvar "useri5" prec)
                (setq ID_CIR_lst (mapcar 'vla-get-objectid Lobj_CIR))
                (setq field_lst
                         (mapcar
                             '(lambda (id)
                                  (acet-str-format
                                      "%<\\AcObjProp Object(%<\\_ObjId %1>%).Circumference \\f \"%lu2%pr%2\">%+"
                                      (itoa id)
                                      (itoa prec)
                                  )
                              )
                             ID_CIR_lst
                         )
                )
                (setq str (acet-str-format
                              "%<\\AcExpr (%1) \\f \"%lu2%pr%2\">%"
                              (vl-string-right-trim "+" (apply 'strcat field_lst))
                              (itoa prec)
                          )
                )
                (vla-put-TextString Obj_Text str)
            ) ;_PROGN
        ) ;_IF
        (ACET-SYSVAR-RESTORE)
        (command "undo" "en")
        (princ "\nOK")
        (PRINC)
    )

    910.1 thì nó ra 910.100000; Nhờ các ae chỉ ra chỗ còn khiếm khuyết này)

     

    Mình xem thì cái này không phải là lỗi. Do bạn chưa format trường thôi.

    Xem sơ thì bạn muốn đặt User12 làm biến số chữ số thập phân. Nhưng nếu bạn làm theo mặc định units Cad cũng ok mà.

     

    Kiến nghị đổi dòng

     

     

    (setq str (acet-str-format
                              "%<\\AcExpr (%1)>%"
                              (vl-string-right-trim "+" (apply 'strcat field_lst))
                          )
                )

     

    Thành:

    (setq str (acet-str-format
                              "%<\\AcExpr (%1) \\f \"%lu%2%pr%3\" >%"
                              (vl-string-right-trim "+" (apply 'strcat field_lst))
                              (itoa (getvar 'lunits))
                              (itoa (getvar 'luprec))  
                          )
                )

     

    Nó sẽ format theo unit hiện hành.

     

     

     

     

    • Like 1

  17. 1 giờ} trướ}c, thiep đã nói:

     

    Đề bài cứ tưởng đơn giản nhưng phức tạp, vì đôi khi join các đối tượng vừa có line vừa có arc rồi xoá bớt các nút nằm thẳng hàng. Hoặc đơn giản chỉ xoá bớt các nút trên polyline nằm thẳng hàng, polyline có thể không có arc hoặc có arc. Lisp join có điều kiện thực hiện như trên clip này:

     

    2 arc liên tiếp có R và center xấp xỉ nhau có được không bác.

×