Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
quan08

[Nhờ chỉnh sửa]Vẽ trục cho đường tròn

Các bài được khuyến nghị

Mình down được trên diễn đàn lisp vẽ trục cho đường tròn,nay nhờ các bác chỉnh sửa lại sao cho lisp có thể định được trục cho hình vuông,hình chữ nhật được vẽ bằng polyline.Chân thành cảm ơn trước.

 
defun NewLayer (Name Col Typ)
(if (not (tblsearch "layer" Name))
(command "-layer" "n" Name "c" Col Name "l" Typ Name "" ))
)
(defun c:tdx ( / ss oldos oldla ent r c)
 (setq oldos (getvar "osmode"))
 (setq oldla (getvar "clayer"))
 (NewLayer "TRUCDX" 9 "CENTER2")
 (setvar "osmode" 0)
 (setvar "clayer" "TRUCDX")
 (setq ss (ssget '((0 . "CIRCLE"))))
 (setq c 0)
 (repeat (sslength ss)
(setq ent (entget (ssname ss c)))
(setq r (cdr (assoc 40 ent)))
(setq pt (cdr (assoc 10 ent)))
(command ".pline" (list (- (car pt) r (/ r 5)) (cadr pt)) (list (+ (car pt) r (/ r 5)) (cadr pt)) "")
(command ".pline" (list (car pt) (- (cadr pt) r (/ r 5))) (list (car pt) (+ (cadr pt) r (/ r 5))) "")
(setq c (1+ c))
)
 (setvar "osmode" oldos)
 (setvar "clayer" oldla)
 (princ "\n* * * Completed! * * *")
 (princ)
 )

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Đối tượng bất kỳ :

(defun c:cl(/ eLine ll ur pl pr pt pb ex ss)
(vl-load-com)
(defun eLine(p1 p2)(entmakex (list (cons 0 "LINE")(cons 62 3)(cons 10 p1)(cons 11 p2)(cons 6 "CENTER"))))
(while (setq ss (ssget))
(vlax-for e (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-getboundingbox e 'll 'ur)
(setq ll (vlax-safearray->list ll)
 ur (vlax-safearray->list ur)
 ex (/ (abs (-(car ll)(car ur))) 6) ;Extend outside Rectangle
 pl (list (- (car ll) ex) (/ (+ (cadr ll)(cadr ur)) 2))
 pr (list (+ (car ur) ex) (cadr pl))
 pt (list (/ (+ (car ll)(car ur)) 2) (+ (cadr ur) ex))
 pb (list (car pt) (- (cadr ll) ex))
)
(eLine pl pr)
(eLine pt pb)
)
)
)

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Đối tượng bất kỳ :

(defun c:cl(/ eLine ll ur pl pr pt pb ex ss)
(vl-load-com)
(defun eLine(p1 p2)(entmakex (list (cons 0 "LINE")(cons 62 3)(cons 10 p1)(cons 11 p2)(cons 6 "CENTER"))))
(while (setq ss (ssget))
(vlax-for e (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-getboundingbox e 'll 'ur)
(setq ll (vlax-safearray->list ll)
 ur (vlax-safearray->list ur)
 ex (/ (abs (-(car ll)(car ur))) 6) ;Extend outside Rectangle
 pl (list (- (car ll) ex) (/ (+ (cadr ll)(cadr ur)) 2))
 pr (list (+ (car ur) ex) (cadr pl))
 pt (list (/ (+ (car ll)(car ur)) 2) (+ (cadr ur) ex))
 pb (list (car pt) (- (cadr ll) ex))
)
(eLine pl pr)
(eLine pt pb)
)
)
)

Bạn xem lại giùm sau khi kêu chọn đối tượng thì lisp không hoạt động.Thanks.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Bạn chú ý linetype CENTER Phải đã được load :) Không thì thêm đoạn này vào đầu lisp :

(if (= (tblsearch "ltype" "CENTER") nil)(command "-linetype" "l" "CENTER" "acad.lin" ""))

 

=> Lisp thành :

 

(defun c:cl(/ eLine ll ur pl pr pt pb ex ss)
(vl-load-com)
(if (= (tblsearch "ltype" "CENTER") nil)(command "-linetype" "l" "CENTER" "acad.lin" ""))
(grtext -1 "Center Line @Ketxu")
(defun eLine(p1 p2)(entmakex (list (cons 0 "LINE")(cons 62 3)(cons 10 p1)(cons 11 p2)(cons 6 "CENTER"))))
(while (setq ss (ssget))
(vlax-for e (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-getboundingbox e 'll 'ur)
(setq ll (vlax-safearray->list ll)
 ur (vlax-safearray->list ur)
 ex (/ (abs (-(car ll)(car ur))) 6) ;Extend outside Rectangle
 pl (list (- (car ll) ex) (/ (+ (cadr ll)(cadr ur)) 2))
 pr (list (+ (car ur) ex) (cadr pl))
 pt (list (/ (+ (car ll)(car ur)) 2) (+ (cadr ur) ex))
 pb (list (car pt) (- (cadr ll) ex))
)
(eLine pl pr)
(eLine pt pb)
)
)
)

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Bạn chú ý linetype CENTER Phải đã được load smile.png Không thì thêm đoạn này vào đầu lisp :

 

 

=> Lisp thành :

 

(defun c:cl(/ eLine ll ur pl pr pt pb ex ss)
(vl-load-com)
(if (= (tblsearch "ltype" "CENTER") nil)(command "-linetype" "l" "CENTER" "acad.lin" ""))
(grtext -1 "Center Line @Ketxu")
(defun eLine(p1 p2)(entmakex (list (cons 0 "LINE")(cons 62 3)(cons 10 p1)(cons 11 p2)(cons 6 "CENTER"))))
(while (setq ss (ssget))
(vlax-for e (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-getboundingbox e 'll 'ur)
(setq ll (vlax-safearray->list ll)
 ur (vlax-safearray->list ur)
 ex (/ (abs (-(car ll)(car ur))) 6) ;Extend outside Rectangle
 pl (list (- (car ll) ex) (/ (+ (cadr ll)(cadr ur)) 2))
 pr (list (+ (car ur) ex) (cadr pl))
 pt (list (/ (+ (car ll)(car ur)) 2) (+ (cadr ur) ex))
 pb (list (car pt) (- (cadr ll) ex))
)
(eLine pl pr)
(eLine pt pb)
)
)
)

Cảm ơn bạn nhiều,nhưng mình muốn khi vẽ đường trục đó mặc định nó vẽ đường trục đó bằng layer TRUC đã có trên bản vẽ,tiện thể cho mình hỏi phần trục dư ra ngoài các hình kích thước dài như thế nào vậy?

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Cảm ơn bạn nhiều,nhưng mình muốn khi vẽ đường trục đó mặc định nó vẽ đường trục đó bằng layer TRUC đã có trên bản vẽ,tiện thể cho mình hỏi phần trục dư ra ngoài các hình kích thước dài như thế nào vậy?

Mình để lại kiểu layer như lisp cũ của bạn, chỗ nào có thể thay đổi mình đã ghi chú trong lisp, bạn có thể tự sửa theo ý bạn :)

Nhớ là lisp chạy với mọi đối tượng, kín hở ok tất, quét chọn chán thì thôi.

(defun c:cl(/ eLine ll ur pl pr pt pb ex ss)
(vl-load-com)
(defun NewLayer (Name Col Typ)
(if (not (tblsearch "layer" Name))
(command "-layer" "n" Name "c" Col Name "l" Typ Name "" ))
)
(NewLayer "TRUCDX" 9 "CENTER2") ;TRUCDX la ten layer, 9 la mau cua layer, CENTER2 la linetype
(if (= (tblsearch "ltype" "CENTER") nil)(command "-linetype" "l" "CENTER" "acad.lin" ""))
(grtext -1 "Center Line @Ketxu")
(defun eLine(p1 p2)(entmakex (list (cons 0 "LINE")(cons 8 "TRUCDX") (cons 10 p1)(cons 11 p2))))
(while (setq ss (ssget))
(vlax-for e (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-getboundingbox e 'll 'ur)
(setq ll (vlax-safearray->list ll)
 ur (vlax-safearray->list ur)
 ex (/ (abs (-(car ll)(car ur))) 6) ;Chieu dai extend bang 1/6 chieu dai ben trong, neu khong thich thi thay ca doan (/ (abs (-(car ll)(car ur))) 6) bang 1 so bat ky
 pl (list (- (car ll) ex) (/ (+ (cadr ll)(cadr ur)) 2))
 pr (list (+ (car ur) ex) (cadr pl))
 pt (list (/ (+ (car ll)(car ur)) 2) (+ (cadr ur) ex))
 pb (list (car pt) (- (cadr ll) ex))
)
(eLine pl pr)
(eLine pt pb)
)
)
)

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay
Đăng nhập để thực hiện theo  

×