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

trungkaka119

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

    7
  • Đã tham gia

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

  • Ngày trúng

    1

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


  1. Vào lúc 25/11/2011 tại 08:39, ketxu đã nói:

    Ồ, mình cứ tếu táo vậy thôi. Dạo này bận quá, lên đâm chọt 1 2 câu rồi lại té, k có thời gian đọc kỹ bài của mọi người ^^

    Lisp dịch chuyển text dim theo vecto, lệnh mtd :

    http://www.cadviet.com/upfiles/3/24067_mtd_dich_chuyen_text_dim.rar

    Ai còn lisp này cho mình xin. Tải ko được.

     


  2. Vào lúc 20/6/2015 tại 07:24, Tue_NV đã nói:

     

    Sorry! Do mình làm trên 2 CAD2008 và 2012, buồn ngủ nữa nên test CAD2012 cứ tưởng là test trên CAD 2008

    code mình sửa

     

    
    (defun c:dopl(/ ghidim acadObj doc modelSpace e ddat)
    (defun ghidim(e ddat i / dis lst-dim)
           (setq obj (vlax-ename->vla-object e))
           (setq dis (distance ddat (vlax-curve-getclosestpointto e ddat t)))
         (Repeat (fix (vlax-curve-getEndParam e))
           (if (= 0 (vla-GetBulge obj i))
          (vla-AddDimAligned modelSpace
                        (vlax-3d-point (vlax-curve-getpointatparam e i)) (vlax-3d-point (vlax-curve-getpointatparam e (1+ i)) )
                        (vlax-3d-point (polar (vlax-curve-getpointatparam e (+ i 0.5))
                               (- (angle '(0 0 0) (vlax-curve-getFirstDeriv e (+ i 0.5))) (/ pi 2.0)) dis)
                        )
          )
    (progn
     (vla-adddimradial modelSpace (vlax-3d-point (mapcar '+ (vlax-curve-getpointatparam e (+ i 0.5)) (vlax-curve-getSecondDeriv e (+ i 0.5)))) 
      (vlax-3d-point (vlax-curve-getpointatparam e (+ i 0.5))) 0.0
     ) (setq lst-dim (append lst-dim (list (entlast))))
              (vla-AddDimArc modelSpace (vlax-3d-point (mapcar '+ (vlax-curve-getpointatparam e (+ i 0.5)) (vlax-curve-getSecondDeriv e (+ i 0.5))))
                        (vlax-3d-point (vlax-curve-getpointatparam e i)) (vlax-3d-point (vlax-curve-getpointatparam e (1+ i)) )
                        (vlax-3d-point (polar (vlax-curve-getpointatparam e (+ i 0.5))
                               (- (angle '(0 0 0) (vlax-curve-getFirstDeriv e (+ i 0.5))) (/ pi 2.0)) dis)
                        )
              )
    )
            );if
    (setq lst-dim (append lst-dim (list (entlast))))
        (setq i (1+ i))
        );Repeat
    lst-dim
    )
        (setq acadObj (vlax-get-acad-object))
        (setq doc (vla-get-ActiveDocument acadObj))
     
        (setq modelSpace (vla-get-ModelSpace doc))
      (if (and (setq e (car(entsel "\n Chon Pline : "))) (setq ddat (getpoint (vlax-curve-getstartpoint e) "\nDist (Pick diem) :")))
         (progn
    (setq lst-dim (ghidim e ddat 0))
    (initget "Y N")
    (if (= "Y" (getkword "\nBan muon ghi dim theo huong nguoc lai <Y/N>")) (progn
       (mapcar 'entdel lst-dim) ;(command "._pedit" e "R" "") 
       (ghidim (Rpl e) ddat 0)
    ))
      );progn
     );if
    (princ)
    )
    (defun rpl (p-ent)
    (setq again nil)
    ;;;;(setq p-ent nil)
    ;;;;;;;;;;(prompt "\nSelect a polyline: ")
    ;;;;;(while (not p-ent)
    ;;;(setq p-ent (car (entsel)))
    (if (not p-ent)
    (progn
    (if (and (/= (dxf 0 p-ent) "POLYLINE")
    (/= (dxf 0 p-ent) "LWPOLYLINE")
    ) ;_ end of and
    (progn
    (prompt "\nNot a polyline, select again:"
    ) ;_ end of prompt
    (setq p-ent nil)
    ) ; progn
    ) ;_ end of if
    ) ;_ end of progn
    ) ;_ end of if
    ;;;) ;_ end of while
    (setq etype (dxf 0 p-ent)
    x-ent p-ent
    is-closed (dxf 70 p-ent)
    ) ; setq
    (if (= etype "LWPOLYLINE")
    (progn
    (setq num-vert (dxf 90 p-ent)
    elist (entget p-ent)
    elist (member (assoc 10 elist) elist)
    vvlist nil
    ) ; setq
    (repeat num-vert
    (setq vlist (list (cdr (assoc 10 elist))))
    (setq vlist
    (append vlist
    (list (cdr (assoc 42 elist)))
    ) ;_ end of append
    ) ;_ end of setq
    (setq vvlist (append vvlist
    (list vlist)
    ) ;_ end of append
    ) ;_ end of setq
    (setq elist (cdr elist)
    elist (member (assoc 10 elist) elist)
    ) ; setq
    ) ; repeat
    ) ; progn lwpolyline
    (progn
    (setq vvlist nil
    p-ent (entnext p-ent)
    ) ; setq
    (while (/= "SEQEND"
    (cdr
    (assoc 0 (entget p-ent))
    ) ;_ end of cdr
    ) ;_ end of /=
    (setq vlist (list (dxf 10 p-ent)))
    (setq vlist (append vlist
    (list (dxf 42 p-ent))
    ) ;_ end of append
    ) ;_ end of setq
    (setq vvlist (append vvlist
    (list vlist)
    ) ;_ end of append
    ) ;_ end of setq
    (setq p-ent (entnext p-ent))
    ) ; while
    ) ; progn polyline
    ) ; if
    (setq p-list (mapcar 'car vvlist)
    p-list (reverse p-list)
    b-list (mapcar 'cadr vvlist)
    b-list (reverse b-list)
    b-first (car b-list)
    b-list (cdr b-list)
    b-list (append b-list (list b-first))
    b-list (mapcar '- b-list)
    ) ; setq
    (setq enlist (list '(0 . "LWPOLYLINE")
    '(100 . "AcDbEntity")
    '(100 . "AcDbPolyline")
    (cons 90 (length p-list))
    (cons 70 (dxf 70 x-ent))
    (cons 8 (dxf 8 x-ent))
    ) ; list
    ) ; setq
    (setq elst nil)
    (repeat (length p-list)
    (setq
    elst (append elst
    (list (cons 10 (car p-list)))
    ) ;_ end of append
    ) ; setq
    (setq
    elst (append elst
    (list (cons 42 (car b-list)))
    ) ;_ end of append
    ) ; setq
    (setq p-list (cdr p-list))
    (setq b-list (cdr b-list))
    ) ; repeat
    (setq enlist (append enlist elst))
    (entdel x-ent)
    (entmakex enlist)
    ;;;;;(prompt "\nPolyline direction is reversed.\n ")
    ;;;(princ)
    );rpl
    (defun dxf (code ename)
    (cdr (assoc code (entget ename)))
    ) 

    Mong AD có thể sửa code về cad 2007 được không ạ?

×