AutoCAD顧問
還沒有註冊嗎...即日起免費註冊,所有最完整的AutoCAD討論、教學及資源都在論壇裡喔~
AutoCAD顧問
Would you like to react to this message? Create an account in a few clicks or log in to continue.
[討論]LISP快速編號 Io15010 [討論]LISP快速編號 Easase10 [討論]LISP快速編號 Oiu15010 [討論]LISP快速編號 2020-211 [討論]LISP快速編號 Oo-2-110 [討論]LISP快速編號 BPl3tjj

[討論]LISP快速編號

向下

[討論]LISP快速編號 Empty [討論]LISP快速編號

發表 由 tjeudndey 于 2014-03-13, 22:12

此為對岸同胞製作~抓回來繁體化!
但個人覺得還要加(可選自型/連續編號←{不用每點一次都要按右鍵enter)/垂直&水平對齊)這三個功能
才能更快速工作!該如何編寫呢? 頭暈目眩 

代碼:
;參數初始化
(defun chushihua()
  ;(setvar "cmdecho" 0)
  (setq bhlx 0)
  (write-line "編號類型:0")
  (setq bh0 0)
  (write-line "編號初值:1")
  (setq bh1 64)
  (setq bh2 0)
  (setq bh3 64)
  (setq yx "Y")
  (write-line "引線:Y")
  (setq bklx "Y")
  (write-line "邊框:Y")
  (setq r 2.5)
  (setq zidong_r t)
  (write-line "邊框圓半徑:自動")
  (setq th 3.5)
  (write-line "文字高度:3.5")
  (setq ta 0)
  (write-line "文字旋轉角度:0")
  (setq jl 1)
  (write-line "編號到引線距離:1")
  (setq jiantou 2.5)
  (write-line "箭頭大小:2.5")
  (setq chang 5)
  (setq zidong_chang t)
  (write-line "水平段引線長度:自動")
  (setq qianzhui2 "")
  (write-line "自然數前綴:無")
  (setq houzhui2 "")
  (write-line "自然數後綴:無")
  (setq qianzhui3 "")
  (write-line "字母前綴:無")
  (setq houzhui3 "")
  (write-line "字母后綴:無")
  (setq pianyi 7)
  (write-line "邊框自動處理時,文字到邊框的偏移係數:7")
  
  
  
)


(chushihua)

;主函數*********************************************************************


(defun c:sb(/ o ob)
  (defun er(str)
    (setvar "osmode" dx)    
    (princ "\nSB已取消")    
  )
  (setq erod *error* *error* er)


  (if (= yx "N")
    (progn
      (initget "C Y K W H T")
      (setq ob (getpoint "\n指定編號位置[編號初值(C)/引線(Y)/邊框(K)/文字(W)/還原為默認設置(H)/退出(T)]:<編號之前請先將當前文字樣式的文字高度項設為0>"))
      (if (or (= ob "C") (= ob "Y") (= ob "T") (= ob "K") (= ob "W") (= ob "H") (= ob nil))
(progn
 (if (= ob "C") (chuzhi))           
          (if (= ob "Y") (yinxian))
 (if (= ob "K") (bkshezhi))
 (if (= ob "W") (wenzi))
 (if (= ob "H") (chushihua))
 (if (= ob nil) (gaodu0))


 (if (= ob "T") (exit))
)
        (progn
 (huitu o ob)
)
      )
    )
    (progn
      (initget "C Y K W H T")
      (setq o (getpoint "\n指定標注位置[編號初值(C)/引線(Y)/邊框(K)/文字(W)/還原為默認設置(H)/退出(T)]:<編號之前請先將當前文字樣式的文字高度項設為0>"))
      (if (or (= o "C") (= o "Y") (= o "T") (= o "K") (= o "W") (= o "H") (= o nil))
(progn
 (if (= o "C") (chuzhi))           
          (if (= o "Y") (yinxian))
 (if (= o "K") (bkshezhi))
 (if (= o "W") (wenzi))
 (if (= o "H") (chushihua))
 (if (= o nil) (gaodu0))


 (if (= o "T") (exit))
)
        (progn
          (initget 1)
 (setq ob (getpoint o "\n指定編號位置:"))  
 (huitu o ob)
)
      )
    )    
  )

)


;繪製過程*********************************************************************************

(defun huitu(o ob / dian1 dian2 dianx diany jiantou0 chang0)
  (graphscr)

  (setq jiantou0 jiantou)
  (command "text" '(0 0) th ta "編號速寫" "erase" (entlast) "")
  

  
  
  ;編號升序
  ;0 (1 2 3...) 1 (a b c.../A B C...) 2 (a1 a2.../B1 B2...) 3 (aa ab ac.../Ma Mb Mc...)
  (if (= bhlx 0)
    (progn
      (setq bh0 (+ bh0 1))
      (setq bh (itoa bh0))
    )
  )
  (if (= bhlx 1)
    (progn
      (setq bh1 (+ 1 bh1))
      (if (> bh1 122) (setq bh1 97))
      (if (and (> bh1 90) (< bh1 97)) (setq bh1 65))
      (if (< bh1 65) (setq bh1 65))
      (if (and (< bh1 97) (> bh1 90)) (setq bh1 97))
      (setq bh (chr bh1))
    )
  )

  (if (= bhlx 2)
    (setq bh (strcat qianzhui2 (itoa (setq  bh2 (+ 1 bh2))) houzhui2))
  )

  (if (= bhlx 3)
    (progn
      (setq bh3 (+ 1 bh3))
      (if (> bh3 122) (setq bh3 97))
      (if (and (> bh3 90) (< bh3 97)) (setq bh3 65))
      (if (< bh3 65) (setq bh3 65))
      (if (and (< bh3 97) (> bh3 90)) (setq bh3 97))
      (setq bh (strcat qianzhui3 (chr bh3) houzhui3))
    )
  
  )

  (if (= bklx "Y")       ;邊框半徑是否自動處理及r0值
    (progn
      (if (= zidong_r t)
(setq r0 (/ (tdaxiao 3) 2))
(setq r0 r)
      )
    )
    (setq r0 (/ (tdaxiao 2) 2))
  )
  (if (= bklx "J")       ;邊框為矩形時r0值
    (if (= zidong_j t)
      (setq r0 (/ (tdaxiao 2) 2))
      (setq r0 (/ jgao 2))
    )
  )
  
  (if (= zidong_chang t) ;引線長度是否自動處理及chang0值
    (progn
      (if (= bklx "Y")
(setq chang0 (* r0 2))
(progn
          (if (= bklx "J")
   (if (= zidong_j t)
     (setq chang0 (tdaxiao 1))
     (setq chang0 jkuan)   
   )
   (if (= bklx "W")
     (setq chang0 (tdaxiao 1))
   )
 )


      )
    )
    (setq chang0 chang) 
  )

  ;對象捕捉
  (setq dx (getvar "osmode"))
  (setvar "osmode" 0)  


  
  
  (biankuangy r0 ob bh)
  (if (and (/= yx "N") (/= yx "n"))
    (progn
      (if (>= (car o) (car ob))
        (progn 
          (setq dian1 (list(+ (car ob) (/ chang0 2)) (- (cadr ob) r0 jl)))
          (setq dian2 (list(- (car ob) (/ chang0 2)) (- (cadr ob) r0 jl)))
          (if (> jiantou0 (distance o dian1)) (setq jiantou0 0))
 (setq dianx (+ (car o) (* (/ jiantou0 (distance o dian1)) (- (car dian1) (car o)))))
 (setq diany (+ (cadr o) (* (/ jiantou0 (distance o dian1)) (- (cadr dian1) (cadr o)))))
 (command "pline" o "w" 0 (/ jiantou0 3) (list dianx diany) "w" 0 0 dian1 dian2 "")

 
        )
(progn
          (setq dian1 (list(- (car ob) (/ chang0 2)) (- (cadr ob) r0 jl)))
 (setq dian2 (list(+ (car ob) (/ chang0 2)) (- (cadr ob) r0 jl)))
 (if (> jiantou0 (distance o dian1)) (setq jiantou0 0))
          (setq dianx (+ (car o) (* (/ jiantou0 (distance o dian1)) (- (car dian1) (car o)))))
 (setq diany (+ (cadr o) (* (/ jiantou0 (distance o dian1)) (- (cadr dian1) (cadr o)))))
 (command "pline" o "w" 0 (/ jiantou0 3) (list dianx diany) "w" 0 0 dian1 dian2 "")

 
        )
      )
    )
  )
  ;對象捕捉
  (setvar "osmode" dx)
  (setq *error* erod erod nil)

(eval bh)
  
)



;參數設置********************************************************************************

;初值設置
(defun chuzhi(/ qianzhui20 houzhui20 qianzhui30 houzhui30)
      
      
      (initget 1 "0 1 2 3")
      (setq bhlx (atoi (getkword "選擇一種編號類型:\n<0>  自然數序列(1 2 3...)  <1>  字母序列(a b c.../A B C...)  <2>  帶前/後綴自然數序列(a1 a2.../B1 B2.../(1)...)  <3>  帶前/後綴字母序列(aa ab ac.../Ma Mb Mc.../(a)...)  選擇其中一種0/1/2/3:")))
      (if (= bhlx 0)
        (progn
          (setq bh0 (getint "\n輸入起始數值:<1>"))
 (if (= bh0 nil) (setq bh0 1))
 (setq bh0 (1- bh0))
)
      )
      (if (= bhlx 1)
        (progn  
 (setq bh1 (1- (ascii (getstring "\n輸入起始字母:<A>"))))
)
      )
      (if (= bhlx 2)
        (progn
 (setq qianzhui20 (getstring (strcat "輸入前綴:<" qianzhui2 ">")))
 (if (/= qianzhui20 "") (setq qianzhui2 qianzhui20))
 (setq bh2 (getint "\n輸入起始數值:<1>"))
 (if (= bh2 nil) (setq bh2 1))
 (setq bh2 (1- bh2))
 (setq houzhui20 (getstring (strcat "輸入後綴:<" houzhui2 ">")))
 (if (/= houzhui20 "") (setq houzhui2 houzhui20))
)
      )
      (if (= bhlx 3)
        (progn
 (setq qianzhui30 (getstring (strcat "輸入前綴:<" qianzhui3 ">")))
 (if (/= qianzhui30 "") (setq qianzhui3 qianzhui30))
 (setq bh3 (1- (ascii (getstring "\n輸入起始字母:<A>"))))
 (setq houzhui30 (getstring (strcat "輸入後綴:<" houzhui3 ">")))
 (if (/= houzhui30 "") (setq houzhui3 houzhui30))
)
      )

    

  (c:sb)
)

;引線設置
(defun yinxian(/ yx0 yxf jl0 chang0 jiantou0)
  (initget "Y N")
  (if (= yx "Y") (setq yxf "N") (setq yxf "Y"))
  (setq yx0 (getkword (strcat "\n" "編號是否帶引線?<Y>/<N>:<" yxf ">")))
  (if (= yx0 nil) (setq yx yxf) (setq yx yx0))
  (if (= yx "Y")
    (progn
      (setq jl0 (getdist (strcat "輸入編號到引線的距離:<" (rtos jl) ">")))
      (if (/= jl0 nil) (setq jl jl0))
      (setq chang0 (getdist "輸入水平段引線的長度:<自動>"))
      (if (/= chang0 nil) (setq chang chang0 zidong_chang nil) (setq zidong_chang t))
      (setq jiantou0 (getdist (strcat "輸入箭頭大小:<" (rtos jiantou) ">")))
      (if (/= jiantou0 nil) (setq jiantou jiantou0))


      
    )
  )
  (c:sb)
)

;邊框設置
(defun bkshezhi(/ r0)
  (initget 1 "Y W J")
  (setq bklx (getkword "\n選擇邊框類型[圓(Y)/矩形(J)/無(W)]:"))
  
  (if (= bklx "Y")
    (progn
      
      (setq r0 (getdist (strcat "輸入圓半徑:<" "自動" ">")))
      (if (/= r0 nil) (setq r r0 zidong_r nil) (setq zidong_r t))
    )
  )
  (if (= bklx "J")
    (progn
      (setq jkuan (getdist "\n輸入矩形寬:<自動>"))
      (if (= jkuan nil)
(setq zidong_j t)
(progn
 (setq zidong_j nil)
 (setq jgao (getdist "\n輸入矩形高度:"))
        ) 
      )
    )
  )
  

  
  
  
  

(c:sb)
)
;文字設置
(defun wenzi(/ th0 ta0)
(setq th0 (getdist (strcat "輸入文字高度:<" (rtos th) ">")))
  (if (/= th0 nil)
    (progn
      (setq th th0)
      
    )
    
  )
      
  
  (setq ta0 (getangle (strcat "輸入文字角度:<" (rtos ta) ">")))
  (if (/= ta0 nil)
    (progn
      (setq ta ta0)
      (setq ta (* (/ ta pi) 180))
    )
  )

(c:sb)
)  

;繪邊框  
(defun biankuangy(banjing yuanxin bianhao)
  (if (= bklx "Y")
    (command "circle" yuanxin banjing)
  )
  (if (= bklx "J")
    (progn
      (if (= zidong_j t)
(setq jkuan0 (tdaxiao 1) jgao0 (tdaxiao 2))
(setq jkuan0 jkuan jgao0 jgao)
      )
      (command "pline")
      (command (list (- (car yuanxin) (/ jkuan0 2)) (- (cadr yuanxin) (/ jgao0 2))))
      (command "w" 0 0)
      (command (list (+ (car yuanxin) (/ jkuan0 2)) (- (cadr yuanxin) (/ jgao0 2))))
      (command (list (+ (car yuanxin) (/ jkuan0 2)) (+ (cadr yuanxin) (/ jgao0 2))))
      (command (list (- (car yuanxin) (/ jkuan0 2)) (+ (cadr yuanxin) (/ jgao0 2))))
      (command "c")
    )
  )



  
  (command "text" "J" "MC" yuanxin th ta bianhao)

)  
;將當前文字樣式的文字高度項設置為0
(defun gaodu0() 
  (command "style" "" "" 0 "" "" "" "" "")
  (c:sb)
)


;編號文字寬與高
(defun tdaxiao(x / a b c)  ;x=t則b=寬.x=nil則b=高
  (setq a (textbox (list (cons 1 bh))))
  (setq c (/ (- (cadar a) (cadadr a)) pianyi))
  (if (= x 1)
    (setq b (- (caadr a) (caar a) c))
    (if (= x 2)
      (setq b (- (cadadr a) (cadar a) c))
      (setq b (- (distance (car a) (cadr a)) c))
    )
  )
  (eval b)
)
tjeudndey
tjeudndey
一般會員
一般會員

文章總數 : 35
年齡 : 34
來自 : 新竹
職業 : 營造
愛好 : 攝影
個性 : 熱愛自由
使用年資 : 新手初學
使用版本 : 2014公司 2012家理
經驗值 : 2519
威望值 : 24
注冊日期 : 2014-02-22
藍鵲651號
男 射手座 牛

回頂端 向下

[討論]LISP快速編號 Empty 回復: [討論]LISP快速編號

發表 由 tjeudndey 于 2014-03-15, 08:47

另外我發現-在公司的圖檔裡會發生錯誤
如1.2  正確因該為3.4←在開新cad預設的檔案又顯示正常
1
[討論]LISP快速編號 Iz8adl
2
[討論]LISP快速編號 2itisgp
3
[討論]LISP快速編號 24vms2g
4
[討論]LISP快速編號 2hwmk5v
求解
tjeudndey
tjeudndey
一般會員
一般會員

文章總數 : 35
年齡 : 34
來自 : 新竹
職業 : 營造
愛好 : 攝影
個性 : 熱愛自由
使用年資 : 新手初學
使用版本 : 2014公司 2012家理
經驗值 : 2519
威望值 : 24
注冊日期 : 2014-02-22
藍鵲651號
男 射手座 牛

回頂端 向下

回頂端


 
這個論壇的權限:
無法 在這個版面回復文章
[討論]LISP快速編號 Uos15010 [討論]LISP快速編號 BPl3tjj [討論]LISP快速編號 Ziao1510 [討論]LISP快速編號 Oo-2-110 [討論]LISP快速編號 Oooo-110 [討論]LISP快速編號 2020-211