Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
5 replies to this topic

#1 quan08

quan08

    biết vẽ pline

  • Members
  • PipPip
  • 67 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 11 October 2011 - 06:40 PM

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)
)

  • 0

#2 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 11 October 2011 - 07:42 PM

Đố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)
)
)
)

  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3 quan08

quan08

    biết vẽ pline

  • Members
  • PipPip
  • 67 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 11 October 2011 - 08:02 PM

Đố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.
  • 0

#4 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 11 October 2011 - 08:04 PM

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)
)
)
)

  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#5 quan08

quan08

    biết vẽ pline

  • Members
  • PipPip
  • 67 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 11 October 2011 - 08:12 PM

Bạn chú ý linetype CENTER Phải đã được load Hình đã gửi 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?
  • 0

#6 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 11 October 2011 - 08:18 PM

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)
)
)
)

  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC