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

trungkaka119

Thành viên
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    17

  • Đã tham gia

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

  • Ngày trúng

    1

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

  10. Đã đăng · Trả lời báo cáo

    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.

     

  12. Đã đăng · Trả lời báo cáo

    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 ạ?

×