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

cuongtk2

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

    441
  • Đã tham gia

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

  • Ngày trúng

    39

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


  1. Đây em

    (defun c:hcncheo( / ANG ANG1 DIST E ENT ENTS H L1 L2 LISTDINH NAME OBJ P1 P2 P3 P4 P5 P6 PARAM PE PS PT)
    (setq ents (entsel "\nPick entity"))
    (if (null ents) (exit))
    (setq pt (cadr ents)
          ent (car ents)
          name (acet-dxf 0 (entget ent)))
    (if (null (or (= name "LWPOLYLINE")
    	(= name "LINE"))
    	  )
      (exit)
      )
    (if (= name "LWPOLYLINE")
    (setq obj (vlax-ename->vla-object ent)
          pt (vlax-curve-getclosestpointto obj pt)
          param (fix (vlax-curve-getParamAtPoint obj pt))
          ps (vlax-curve-getPointAtParam obj param)
          pe (vlax-curve-getPointAtParam obj (+ param 1))
          )
      )
    (if (= name "LINE")
      (setq ps (acet-dxf 10 (entget ent))
    	pe (acet-dxf 11 (entget ent))
    	)
      )
    
    (setq p1 (if (< (car ps) (car pe)) ps pe)
          p2 (if (< (car ps) (car pe)) pe ps)
          ang (angle p1 p2)
          ang1 (+ ang (* pi 0.5))
          dist (DISTANCE p1 p2))
    (alert (strcat "L= "  (rtos dist 2 2)))
    (setq l1 (getdist "\nL1:"))
    (setq l2 (getdist "\nL2:"))
    (if (> (+ l1 l2) dist)
      (alert "Tong L1 + L2  qua lon")
      )
    (setq h (getdist "\nH:"))
    
    (setq p3 (polar p1 ang l1)
          p4 (polar p2 ang (- 0 l2))
          p5 (polar p4 ang1 h)
          p6 (polar p3 ang1 h)
          )
    
    (DEFUN make_lwpolyline  (list_dinh dong_lai do_day layer / dlist elist1 e_list n i)
      (SETQ n (LENGTH list_dinh))
      (SETQ dlist nil)
      (SETQ i 0)
      (WHILE (< i n)
        (SETQ dlist (APPEND dlist
                            (list_point_pline (NTH i list_dinh) do_day)
                            )
              )
        (SETQ i (1+ i))
        )
    
      (SETQ elist1 (LIST (CONS 0 "LWPOLYLINE")
                         (CONS 100 "AcDbEntity")
                         (CONS 410 "Model")
                         (CONS 8 layer)
                         (CONS 100 "AcDbPolyline")
                         (CONS 90 n)
                         (CONS 70 dong_lai)
     ;(cons 43 0.0)
                         (CONS 38 0.0)
                         (CONS 39 0.0)))
      (SETQ e_list nil)
      (SETQ e_list (APPEND elist1 dlist))
      (SETQ e_list (APPEND e_list (LIST '(210 0.0 0.0 1.0))))
      (ENTMAKE e_list)
      )
    
    (DEFUN make_dim_y1  (style p1 p2 p3  ang layer / d e_list basepoint p4)
      
      (SETQ e_list (LIST
                     (CONS 0 "DIMENSION")
                     (CONS 100 "AcDbEntity")
                     (CONS 67 0)
                     (CONS 410 "Model")
                     (CONS 8 layer)
                     (CONS 100 "AcDbDimension")
                     (cons 10 p3)
                     (cons 11 p3)
                     (LIST 12 0.0 0.0 0.0)
                     (CONS 70 32)
                     (CONS 1 "")
                     (CONS 71 5)
                     (CONS 72 1)
                     (CONS 41 1.0)
                     (CONS 42 0)
                     (CONS 52 0.0)
                     (CONS 53 0.0)
                     (CONS 54 0.0)
                     (CONS 51 0.0)
                     (LIST 210 0.0 0.0 1.0)
                     (CONS 3 style)
                     (CONS 100 "AcDbAlignedDimension")
                     (cons 13 p1)
                     (cons 14 p2)
                     (LIST 15 0.0 0.0 0.0)
                     (LIST 16 0.0 0.0 0.0)
                     (CONS 40 0.0)
                     (CONS 50 ang)
                     (CONS 100 "AcDbRotatedDimension")
    		 )
            )
      (ENTMAKE e_list)
    
    
      )
    
    (setq listdinh (mapcar '(lambda (e) (list (car e) (cadr e))
    			  )
    		       (list p3 p4 p5 p6))
          )
    (MAKE_LWPOLYLINE listdinh 1 0 "chunhat")
    
    (MAKE_DIM_Y1 "Standard" p3 p6 (polar p1 (- 0 ang) (+ h h)) ang1 "dim")
    (MAKE_DIM_Y1 "Standard" p1 p3 (polar p1 ang1 (+ h h)) ang  "dim")
    (MAKE_DIM_Y1 "Standard" p4 p2 (polar p1 ang1 (+ h h)) ang  "dim")
    
    
    )
    
    
    
    

     


  2. Với line nằm ngang thì dùng cái này

    (defun c:noiline ( / I KEY LS LS2 N P SS SS1 )
    
    (defun pointmininline (ent / ENTG LS LS1 PE PS)
      (setq entg (entget ent)
    	ps (acet-dxf 10 entg)
    	pe (acet-dxf 11 entg)
    	ls (list ps pe))
      (setq ls1 (vl-sort ls '(lambda (p1 p2) (< (car p1) (car p2))
    			   )
    		     )
    	)
      ls1
      )
    (DEFUN make_lwpolyline  (list_dinh dong_lai do_day layer / dlist elist1 e_list n i)
      (SETQ n (LENGTH list_dinh))
      (SETQ dlist nil)
      (SETQ i 0)
      (WHILE (< i n)
        (SETQ dlist (APPEND dlist
                            (list_point_pline (NTH i list_dinh) do_day)
                            )
              )
        (SETQ i (1+ i))
        )
    
      (SETQ elist1 (LIST (CONS 0 "LWPOLYLINE")
                         (CONS 100 "AcDbEntity")
                         (CONS 410 "Model")
                         (CONS 8 layer)
                         (CONS 100 "AcDbPolyline")
                         (CONS 90 n)
                         (CONS 70 dong_lai)
     ;(cons 43 0.0)
                         (CONS 38 0.0)
                         (CONS 39 0.0)))
      (SETQ e_list nil)
      (SETQ e_list (APPEND elist1 dlist))
      (SETQ e_list (APPEND e_list (LIST '(210 0.0 0.0 1.0))))
      (ENTMAKE e_list)
      )
    
    
    
    (setq ss (ssget '((0 . "LINE")))
          ss (acet-ss-to-list ss))
    (setq ss1 (vl-sort ss '(lambda (e1 e2) (< (cadr (car (pointmininline e1)))
    					 (cadr (car (pointmininline e2)))
    					 )
    			)
    		  )
          )
    (setq n (length ss1)
          i 0
          ls (list))
    (initget 1 "T P")
    (setq key (GETKWORD "Bat dau tu duoi Trai / Phai"))
    (if (= key "T")
      (while (< i n)
        (progn
          (setq ls2 (pointmininline (nth i ss1)))
          (if ( = (rem i 2) 0)
    	(setq ls (append ls (list (car ls2) (cadr ls2))))
    	(setq ls (append ls (list (cadr ls2) (car ls2))))
    	)
          )
        (setq i (1+ i))
        )
      (while (< i n)
        (progn
          (setq ls2 (pointmininline (nth i ss1)))
          (if ( = (rem i 2) 0)
    	(setq ls (append ls (list (cadr ls2) (car ls2))))
    	(setq ls (append ls (list (car ls2) (cadr ls2))))
    	)
          )
        (setq i (1+ i))
        )
      )
    (setq ls (mapcar '(lambda (p) (list (car p) (cadr p))) ls))
    (MAKE_LWPOLYLINE ls 0 0 "ketqua")
    	
    (initget 1 "Y N")
    (setq key (GETKWORD "Xoa line cu khong Yes / No"))
    (if (= key "Y")
      (foreach n ss1 (entdel n))
      )
    
    )
        
    
    

     

    • Like 1

  3. (defun c:test (/ A LS OBJ ss )
      (setq ss (mapcar '(lambda (x) (vlax-ename->vla-object x))
    		   (ACET-SS-TO-LIST (ssget '((0 . "INSERT"))))
    		   ))
      (foreach obj ss
        (progn
          (setq   color (vla-get-color obj)
    	    ls (vlax-safearray->list (vlax-variant-value (vla-Explode obj)))
    	     )
        (foreach n ls (if (= (vla-get-color n) 0) (vla-put-color n color))  )
          (vla-Erase obj)
          )
        )
    )

     

    • Like 2

  4. Thực ra lisp chỉ phục vụ mục tiêu đánh dấu hết vùng những text có nội dung giống nhau thôi, để khỏi bỏ sót.

    Ví dụ như trong đống số 8 có lẫn 1 cái số 7 thì đường bao 7 nó sẽ vươn đến.

    Bạn có thể coi đó là 1 bản nháp để xem những text đó nó có mặt đến đâu thôi.

    Bài toán của bạn có thể mở rộng bằng cách chọn một diện tích mẫu  đại diện cho 1 số để lấy 4 diểm góc cho 1 số, với getcorner.

    Sau đó nhân rộng diện tích với các text giống mẫu được chọn.

    baodiem.lsp

    Animation.gif


  5. Chủ yếu lấy thể tích thôi mà. 

    (defun c:khoiluong ( / DENSITATE KL MAT RO SS1 STR VOL X)
    (initget "S A C B Z T L N")
      (initget
        "Steel Aluminium Copper Brass Zinc Tin Lead Nickel"
      )
      (setq    densitate
         (getkword
           "\nChoose material Aluminium/Copper/Brass/Zinc/Tin/Lead/Nickel/<Steel>:"
         )
      )
      (cond
        ((or (= densitate "Aluminium") (= densitate "A"))
         (setq ro 2.70)
         (setq mat "Aluminium")
        )
        ((or (= densitate "Copper") (= densitate "C"))
         (setq ro 8.93)
         (setq mat "Copper")
        )
        ((or (= densitate "Brass") (= densitate "B"))
         (setq ro 8.80)
         (setq mat "Brass")
        )
        ((or (= densitate "Zinc") (= densitate "Z"))
         (setq ro 7.14)
         (setq mat "Zinc")
        )
        ((or (= densitate "Tin") (= densitate "T"))
         (setq ro 7.29)
         (setq mat "Tin")
        )
        ((or (= densitate "Lead") (= densitate "L"))
         (setq ro 11.34)
         (setq mat "Lead")
        )
        ((or (= densitate "Nickel") (= densitate "N"))
         (setq ro 8.86)
         (setq mat "Nickel")
        )
        (T
         (setq ro 7.85)
         (setq mat "Steel")
        )
      )
    (setq ss1 (ACET-SS-TO-LIST(ssget)))
      (if (= ss1 nil)
        (exit)
      )
     (setq ss1 (mapcar '(lambda (x) ( vlax-ename->vla-object x)) ss1)  )
    (setq vol 0)
    (foreach n ss1
      
           (if (= (vla-get-Objectname n) "AcDb3dSolid")
             (setq vol (+ vol (vla-get-Volume n)))
          )
      )
      ;;;he so chuyen mm3 sang m3
      (setq vol (* vol 0.0000001))
    (setq kl (* vol ro))
    (setq str (strcat "Vat lieu: \t" mat
              "\nKhoi luong rieng: \t" (rtos ro 2 2) " t/m3"
              "\nThe tich: \t" (rtos vol 2 3) " m3"
              "\nKhoi luong: \t" (rtos kl 2 3) " tan"
              )
          )
              
      (alert str)
    )

     

    • Like 1
    • Vote tăng 1
×