AutoCAD顧問
還沒有註冊嗎...即日起免費註冊，所有最完整的AutoCAD討論、教學及資源都在論壇裡喔~

Join the forum, it's quick and easy

AutoCAD顧問
還沒有註冊嗎...即日起免費註冊，所有最完整的AutoCAD討論、教學及資源都在論壇裡喔~
AutoCAD顧問
Would you like to react to this message? Create an account in a few clicks or log in to continue.
AutoCAD顧問

專屬AutoCAD線上個人顧問，是您學習路上最佳的良師益友，也是職場中最即時的支援後盾！

[討論]分享繪製投影矩形lisp Ioaoe110[討論]分享繪製投影矩形lisp 2020-310[討論]分享繪製投影矩形lisp Oiu15010[討論]分享繪製投影矩形lisp 2020-211[討論]分享繪製投影矩形lisp Ia15010[討論]分享繪製投影矩形lisp Aizyao10[討論]分享繪製投影矩形lisp Uos15010[討論]分享繪製投影矩形lisp BPl3tjj[討論]分享繪製投影矩形lisp Ziao1510
[討論]分享繪製投影矩形lisp Oo-2-110[討論]分享繪製投影矩形lisp Zuoiy_10[討論]分享繪製投影矩形lisp Aizyao11[討論]分享繪製投影矩形lisp Iyb_1510[討論]分享繪製投影矩形lisp Aoe1-111[討論]分享繪製投影矩形lisp Uos15011[討論]分享繪製投影矩形lisp Aoe2da10[討論]分享繪製投影矩形lisp Aoe2da11[討論]分享繪製投影矩形lisp Aoe10

[討論]分享繪製投影矩形lisp

2 posters

AutoCAD顧問 :: 技術(發言等級:一般會員) ::   :: 進階討論

向下

[討論]分享繪製投影矩形lisp Empty [討論]分享繪製投影矩形lisp

發表 由 stephen-peng 2016-06-03, 11:45

分享工作上實用的小程序
選取物件投影畫矩形

代碼:

;;;     ****************************************************************
;;;     *By stephen-peng************************************************
;;;     *版權沒有,歡迎取用**********************************************
;;;     ****************************************************************
(defun c:pe_exe (/     ssblock1   en col   lay   os   tt dly
 dlx   dl    pt_list pt1   pt2   pt3   pt4 pt5
 pt6   pt7
 )
  (princ "by stephen_peng")
  (setvar "blipmode" 0)
  (princ "\n->選擇製作投影矩形物件 <退出>:")
  (setq ssblock1 (ssget)) ;選取物件
  (if (= ssblock1 nil) ;判斷空選集退出
    (*error*)
    (progn
      (setq col (cdr (assoc 62 (entget (ssname ssblock1 0)))))
      (if (= col nil)
 (setq col "bylayer")
      )
      (setq lay (cdr (assoc 8 (entget (ssname ssblock1 0)))))
    )
  ) ;END if
  (command "ucs" "")
  (setq os (getvar "osmode"))
  (setvar "orthomode" 1)
  (setvar "cmdecho" 0)
  (command "undo" "be")
  (setq pt_list '()
 pt1 'nil
 pt2 'nil
 pt3 'nil
  )
  (command "ucs" "w")
  (setq n -1)
  (repeat (sslength ssblock1)
    (setq en (ssname ssblock1 (setq n (1+ n))))
    (vla-getboundingbox (vlax-ename->vla-object en) 'pt1 'pt2)
    (setq pt_list (cons (vlax-safearray->list pt1) pt_list))
    (setq pt_list (cons (vlax-safearray->list pt2) pt_list))
  )
  (setq pt1 (apply 'mapcar (cons 'min pt_list))) ;計算圖形左下角點
  (setq pt2 (apply 'mapcar (cons 'max pt_list))) ;右上角點
  (initget (+ 2 4))
  (setq tt (getdist "\n->輸入投影厚度<20>:")) ;輸入投影厚度
  (if (= tt nil) ;判斷輸入預設值20
    (setq tt 20)
  ) ;END if
  (setq pt7 (getpoint pt1 "\n指定視圖放置點:")) ;指定投影方向
  (setq dly (- (car pt1) (car pt7)))
  (setq dlx (- (cadr pt1) (cadr pt7)))
  (setvar "osmode" 16823)
 ;畫上投影
  (if (and (= dly 0) (< dlx 0)) ;判斷投影方向
    (progn
      (setq dl (abs dlx))
      (setq pt3 (list (car pt1) (+ (cadr pt1) dl)))
      (setq pt4 (list (car pt2) (+ (cadr pt1) dl tt)))
      (command "rectangle" "c" "0" "0" pt3 pt4)
      (command "change" "l" "" "p" "la" lay "c" col "")
      (command "explode" "l")
    )
  ) ;END if
 ;畫下投影
  (if (and (= dly 0) (> dlx 0)) ;判斷投影方向
    (progn
      (setq pt3 (list (car pt1) (- (cadr pt1) dlx)))
      (setq pt4 (list (car pt2) (- (cadr pt1) dlx tt)))
      (command "rectangle" "c" "0" "0" pt3 pt4)
      (command "change" "l" "" "p" "la" lay "c" col "")
      (command "explode" "l")
    )
  ) ;END if
 ;畫左投影
  (if (and (= dlx 0) (> dly 0)) ;判斷投影方向
    (progn
      (setq dl (+ (abs dly) (- (cadr pt2) (cadr pt1))))
      (setq pt5 (list (- (car pt2) dl) (cadr pt2)))
      (setq pt6 (list (- (car pt2) tt dl) (cadr pt1)))
      (command "rectangle" "c" "0" "0" pt5 pt6)
      (command "move"
       "l"
       ""
       pt6
       (list (- (car pt7) tt) (cadr pt7))
      )
      (command "change" "l" "" "p" "la" lay "c" col "")
      (command "explode" "l")
    )
  ) ;END if
 ;畫右投影
  (if (and (= dlx 0) (< dly 0)) ;判斷投影方向
    (progn
      (setq dl (- (abs dly) (- (cadr pt2) (cadr pt1))))
      (setq pt5 (list (- (car pt2) dl) (cadr pt2)))
      (setq pt6 (list (- (car pt2) tt dl) (cadr pt1)))
      (command "rectangle" "c" "0" "0" pt5 pt6)
      (command "move" "l" "" pt6 pt7)
      (command "change" "l" "" "p" "la" lay "c" col "")
      (command "explode" "l")
    )
  ) ;END if
  (setvar "osmode" os)
  (command "undo" "e")
  (setvar "cmdecho" 1)
  (princ)
)
竊喜
附件
[討論]分享繪製投影矩形lisp Attachment
pe_exe.zip 您無權下載這里的附件。(2 Kb) 下載 40 次
stephen-peng
stephen-peng
一般會員
一般會員

文章總數 : 9
年齡 : 52
來自 : 板橋區
職業 : 工程師
愛好 : 電腦維修
個性 : 內向
使用年資 : 20年
使用版本 : 2014
經驗值 : 3047
威望值 : 30
注冊日期 : 2016-03-15
男 處女座 豬

回頂端 向下

[討論]分享繪製投影矩形lisp Empty 回復： [討論]分享繪製投影矩形lisp

發表 由 poiuyy 2016-06-11, 13:45

感謝大大分享
測試看看

____________________________________________________________________________________
[討論]分享繪製投影矩形lisp Ioaoe110 [討論]分享繪製投影矩形lisp Zuoiy_10 [討論]分享繪製投影矩形lisp 2020-211 [討論]分享繪製投影矩形lisp Aizyao11 [討論]分享繪製投影矩形lisp Iyb_1510
[討論]分享繪製投影矩形lisp Aizyao10 [討論]分享繪製投影矩形lisp BPl3tjj.png [討論]分享繪製投影矩形lisp Ziao1510 [討論]分享繪製投影矩形lisp Oo-2-110 [討論]分享繪製投影矩形lisp Oooa_110
poiuyy
poiuyy
初級會員
初級會員

文章總數 : 226
年齡 : 49
來自 : 台中
職業 : 小監
愛好 : 電影
個性 : 中庸
使用年資 : 5
使用版本 : 2010
積分 : 2
經驗值 : 4564
威望值 : 84
注冊日期 : 2014-06-24
藍鵲656號
男 天秤座 虎

回頂端 向下

回頂端

AutoCAD顧問 :: 技術(發言等級:一般會員) ::   :: 進階討論

 
這個論壇的權限：
您 無法 在這個版面回復文章
[討論]分享繪製投影矩形lisp Ioaoe110[討論]分享繪製投影矩形lisp 2020-310[討論]分享繪製投影矩形lisp Oiu15010[討論]分享繪製投影矩形lisp 2020-211[討論]分享繪製投影矩形lisp Ia15010[討論]分享繪製投影矩形lisp Aizyao10[討論]分享繪製投影矩形lisp Uos15010[討論]分享繪製投影矩形lisp BPl3tjj[討論]分享繪製投影矩形lisp Ziao1510
[討論]分享繪製投影矩形lisp Oo-2-110[討論]分享繪製投影矩形lisp Zuoiy_10[討論]分享繪製投影矩形lisp Aizyao11[討論]分享繪製投影矩形lisp Iyb_1510[討論]分享繪製投影矩形lisp Aoe1-111[討論]分享繪製投影矩形lisp Uos15011[討論]分享繪製投影矩形lisp Aoe2da10[討論]分享繪製投影矩形lisp Aoe2da11[討論]分享繪製投影矩形lisp Aoe10