Đến nội dung


Hình ảnh
- - - - -

[Yêu cầu] nhờ làm lisp vẽ tường....


  • Please log in to reply
9 replies to this topic

#1 nhatphong

nhatphong

    biết vẽ circle

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

Đã gửi 28 November 2011 - 08:45 PM

mình làm bên thiết kế vì vẽ tường toàn dùng lệnh Xline và lệnh oset đối tượng

mình có thể nói rõ thế này

ví dụ mình có đường tim,có tường dầy 200 thay vì oset 2 lần 100 thì mình chỉ cần oset 1 lần sang 2 bên cách tim 100 (nếu mà nó thay thế được được Xline thì càng tốt) và có thể oset theo trục chéo .......

lisp mình tìm được này chỉ oset được đường line mình vẽ chứ kg làm được đường xline và kg oset được theo trục chéo,chỉ theo mỗi trục x và y.... >_<


;;OFFSET VE 2 BEN CUA 1 DOI TUONG ( )
(defun c:oo(/ data_m)
(defun import_data(/ i)
(setq data_m (ssget))
(if (= nil distan_m) (setq distan_m 110.0))
(princ "Khoang cach line cach deu sang hai ben (")
(princ distan_m)
(princ "):")
(setq i (getreal ))
(if (not (= nil i)) (setq distan_m i))
)
(defun process(/ ent check)
(defun p_check()
(setq check 0)
(if (= "LINE" (cdr (assoc 0 ent))) (setq check 1))
(princ)
)
(defun p_d_offset(/ p1 p2 p3 p4)
(defun makeline(/ e2 e5)
; (princ ent)
; (setq e5 nil)
; (setq e5 (cdr (assoc 5 ent)))
; (princ e5)
; (if (= nil e5) (setq e5 ))
(setq la (list (cons 0 "LINE")
(cons 5 (cdr (assoc 5 ent)) )
(cons 8 (cdr (assoc 8 ent)) )
(cons 10 p3)
(cons 11 p4)
))
; (princ la)
(entmake la)
(princ)
)
(setq p1 (cdr (assoc 10 ent)) p2 (cdr (assoc 11 ent)) )
(if (not (= p1 p2)) (progn
(if (< (abs (- (nth 0 p1) (nth 0 p2))) 0.000001) (progn
(setq p3 (list (+ (nth 0 p1) distan_m) (nth 1 p1) (nth 2 p1) ) )
(setq p4 (list (+ (nth 0 p2) distan_m) (nth 1 p2) (nth 2 p2) ) )
(makeline)
(setq p3 (list (- (nth 0 p1) distan_m) (nth 1 p1) (nth 2 p1) ) )
(setq p4 (list (- (nth 0 p2) distan_m) (nth 1 p2) (nth 2 p2) ) )
(makeline)
))
(if (< (abs (- (nth 1 p1) (nth 1 p2))) 0.000001) (progn
(setq p3 (list (nth 0 p1) (+ (nth 1 p1) distan_m) (nth 2 p1) ) )
(setq p4 (list (nth 0 p2) (+ (nth 1 p2) distan_m) (nth 2 p2) ) )
(makeline)
(setq p3 (list (nth 0 p1) (- (nth 1 p1) distan_m) (nth 2 p1) ) )
(setq p4 (list (nth 0 p2) (- (nth 1 p2) distan_m) (nth 2 p2) ) )
(makeline)
))
))
(princ)
)
(if (not (= nil data_m)) (progn
(setq i 0)
(while (< i (sslength data_m)) (progn
(setq ent (entget (ssname data_m i)))
(p_check)
(if (= 1 check) (p_d_offset))
(setq i (+ i 1))
))
))
(princ)
)
(import_data)
(ai_undo_push)
(process)
(ai_undo_pop)
(princ)
)
(SETVAR "osmode" 16383)
(setvar "pickbox" 6)
(setvar "aperture" 6)
(setvar "orthomode" 1)


nhờ các bạn sửa lại dùm! để có thể oset theo trục chéo và dùng đc xline thay cho đường line mình vẽ

thank các bạn rất nhiều :D
  • 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 28 November 2011 - 09:09 PM

Trên diễn đàn đã có lisp offset 2 phía, bạn hãy tìm kiếm + GG xem sao
  • 0

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 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1360 (rất tốt)

Đã gửi 29 November 2011 - 07:37 AM

mình làm bên thiết kế vì vẽ tường toàn dùng lệnh Xline và lệnh oset đối tượng

mình có thể nói rõ thế này

ví dụ mình có đường tim,có tường dầy 200 thay vì oset 2 lần 100 thì mình chỉ cần oset 1 lần sang 2 bên cách tim 100 (nếu mà nó thay thế được được Xline thì càng tốt) và có thể oset theo trục chéo .......

lisp mình tìm được này chỉ oset được đường line mình vẽ chứ kg làm được đường xline và kg oset được theo trục chéo,chỉ theo mỗi trục x và y.... >_<

nhờ các bạn sửa lại dùm! để có thể oset theo trục chéo và dùng đc xline thay cho đường line mình vẽ

thank các bạn rất nhiều :D

THử cái này xem (mình chưa thử với xline nhưng arc, circle, plinespline thì đc)
 
(Defun c:o2 ()
(vl-load-com)
(command "undo" "be")

(if (= droff nil)
(setq droff1 2.00)
(setq droff1 droff)
)
(setq
droff (GETREAL (strcat "\nNhap do rong offset: <" (rtos droff1 2 2) ">"))
)
(if (= droff nil)
(setq droff droff1)
)



(setq SS (ssget (list (cons 0 "ellipse,lwpolyline,spline,line,circle"))))
(setq i 0)
(setq N (sslength ss))
(while (< i N)
(setq TEXTENT (ssname SS i))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)

(setq diemchuan (vlax-curve-getPointAtDist TEXTENT 0))
(setq diemdinhhuong (vlax-curve-getPointAtDist TEXTENT 0.01))
(setq goc (angle diemchuan diemdinhhuong))
(setq diembentrai (polar diemchuan (- goc (/ pi 2)) droff))
(setq diembenphai (polar diemchuan (+ goc (/ pi 2)) droff))

(command ".offset" droff textent diembentrai textent diembenphai "")

(setq i (1+ i))
(setvar "osmode" luubatdiem)
)

(command "undo" "end")
(princ)
)

  • 0

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#4 Detailing

Detailing

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 667 Bài viết
Điểm đánh giá: 278 (khá)

Đã gửi 29 November 2011 - 08:19 AM

mình làm bên thiết kế vì vẽ tường toàn dùng lệnh Xline và lệnh oset đối tượng

mình có thể nói rõ thế này

ví dụ mình có đường tim,có tường dầy 200 thay vì oset 2 lần 100 thì mình chỉ cần oset 1 lần sang 2 bên cách tim 100 (nếu mà nó thay thế được được Xline thì càng tốt) và có thể oset theo trục chéo .......

lisp mình tìm được này chỉ oset được đường line mình vẽ chứ kg làm được đường xline và kg oset được theo trục chéo,chỉ theo mỗi trục x và y.... >_<

nhờ các bạn sửa lại dùm! để có thể oset theo trục chéo và dùng đc xline thay cho đường line mình vẽ

thank các bạn rất nhiều :D

Sao ko dùng MLINE nhỉ, khỏi offset. :D
  • 0

Ideas don't matter, execution does!

1908412_308002392716743_8165279281236341


#5 nhatphong

nhatphong

    biết vẽ circle

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

Đã gửi 29 November 2011 - 10:24 AM

THử cái này xem (mình chưa thử với xline nhưng arc, circle, plinespline thì đc)


(Defun c:o2 ()
(vl-load-com)
(command "undo" "be")

(if (= droff nil)
(setq droff1 2.00)
(setq droff1 droff)
)
(setq
droff (GETREAL (strcat "\nNhap do rong offset: <" (rtos droff1 2 2) ">"))
)
(if (= droff nil)
(setq droff droff1)
)



(setq SS (ssget (list (cons 0 "ellipse,lwpolyline,spline,line,circle"))))
(setq i 0)
(setq N (sslength ss))
(while (< i N)
(setq TEXTENT (ssname SS i))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)

(setq diemchuan (vlax-curve-getPointAtDist TEXTENT 0))
(setq diemdinhhuong (vlax-curve-getPointAtDist TEXTENT 0.01))
(setq goc (angle diemchuan diemdinhhuong))
(setq diembentrai (polar diemchuan (- goc (/ pi 2)) droff))
(setq diembenphai (polar diemchuan (+ goc (/ pi 2)) droff))

(command ".offset" droff textent diembentrai textent diembenphai "")

(setq i (1+ i))
(setvar "osmode" luubatdiem)
)

(command "undo" "end")
(princ)
)

sửa cái code
(setq SS (ssget (list (cons 0 "ellipse,lwpolyline,spline,line,circle"))))
thêm cái xline là được

(setq SS (ssget (list (cons 0 "ellipse,lwpolyline,spline,line,xline,circle"))))


thank bạn nhé :D
  • 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 29 November 2011 - 10:34 AM

Quick code :

(defun c:test()
(vl-load-com)
(or #d (setq #d 1))
(setq #d (cond ((getdist (strcat "\nKhoang cach Offset < " (vl-princ-to-string #d) " > :")))(#d)))
(princ "\n Chon doi tuong :")
(if (setq ss (ssget (list (cons 0 "Ellipse,Lwpolyline,Spline,Line,Circle,Arc,Pline"))))
(foreach item (mapcar 'vlax-ename->vla-object (acet-ss-to-list ss))
(vla-offset item #d)
(vla-offset item (- #d))
)
))

  • 2

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


#7 nhatphong

nhatphong

    biết vẽ circle

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

Đã gửi 29 November 2011 - 11:18 AM

Quick code :


(defun c:test()
(vl-load-com)
(or #d (setq #d 1))
(setq #d (cond ((getdist (strcat "\nKhoang cach Offset < " (vl-princ-to-string #d) " > :")))(#d)))
(princ "\n Chon doi tuong :")
(if (setq ss (ssget (list (cons 0 "Ellipse,Lwpolyline,Spline,Line,Circle,Arc,Pline"))))
(foreach item (mapcar 'vlax-ename->vla-object (acet-ss-to-list ss))
(vla-offset item #d)
(vla-offset item (- #d))
)
))

thank bạn lisp này thêm tham số Xline cũng được như cái kia :D
  • 0

#8 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 29 November 2011 - 11:47 AM

À quê nk cho Xline :) Lisp này ngắn hơn cái kia + ghi nhớ dis chứ hè ?
  • 0

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


#9 nhatphong

nhatphong

    biết vẽ circle

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

Đã gửi 29 November 2011 - 12:39 PM

À quê nk cho Xline :) Lisp này ngắn hơn cái kia + ghi nhớ dis chứ hè ?


Chuẩn :D dù sao cũng thank bạn nha....nếu về tiện dụng thì cái lisp này tốt hơn lisp kia

thử về đường bao kín nếu mà offset thì cái lisp của bạn duy782006 thì nó chỉ có 1 đường

còn của bạn ketxu thì nó vẫn cho 2 đường nhưng kg bị trùng đối tượng....khá hay :D
  • 0

#10 ad.pham234

ad.pham234

    biết zoom

  • Members
  • Pip
  • 10 Bài viết
Điểm đánh giá: -4 (bình thường)

Đã gửi 14 July 2015 - 08:19 AM

Bác ketxu ơi bác giúp em sửa cái líp này với, khi opset sang 2 bên thì đối tượng mới chuyển thành màu khác ko trùng với màu đối tượng gốc được ko bác cảm ơn bác nhiều lắm.

 

 

 

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.c...-lisp-ve-tuong/
 (Defun c:oo ()
(vl-load-com)
(command "undo" "be")
 
(if (= droff nil)
(setq droff1 2.00)
(setq droff1 droff)
)
(setq
droff (GETREAL (strcat "\nNhap do rong offset: <" (rtos droff1 2 2) ">"))
)
(if (= droff nil)
(setq droff droff1)
)
 
 
 
(setq SS (ssget (list (cons 0 "ellipse,lwpolyline,spline,line,xline,circle"))))
(setq i 0)
(setq N (sslength ss))
(while (< i N)
(setq TEXTENT (ssname SS i))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
 
(setq diemchuan (vlax-curve-getPointAtDist TEXTENT 0))
(setq diemdinhhuong (vlax-curve-getPointAtDist TEXTENT 0.01))
(setq goc (angle diemchuan diemdinhhuong))
(setq diembentrai (polar diemchuan (- goc (/ pi 2)) droff))
(setq diembenphai (polar diemchuan (+ goc (/ pi 2)) droff))
 
(command ".offset" droff textent diembentrai textent diembenphai "")
 
(setq i (1+ i))
(setvar "osmode" luubatdiem)
)
 
(command "undo" "end")
(princ)
)  

  • -1