【原创】画圆中心线的程序

不知道谁有能画圆中心线的lsp，请贴一个上来看看，谢谢了！

;程序名：画中心线程序
;程序者：向志奇
;建立时间：1998-04-16
;最后修改时间：1999-03-5
;附带文件：
  
(defun c:zxx(/ la lt cl p1 e ed sel sel1 cen rad pt1 pt2 pt3 pt4 aper os)
(setq la (getvar "clayer"))
(setq lt (getvar "celtype"))
(setq cl (getvar "cecolor"))
(setq aper (getvar "aperture")    )
(setq os (getvar "osmode") )
  
(setq temperr *error*)
(setq *error* trap)
(command "undo" "be")
  
(princ "\n画中心线程序")
(setq p1 (entsel "\n请选取圆或圆弧:"))
(if (not p1)
    (progn  
      (princ "\n没有选到实体！")
      (exit)
      )
  )
(setq ed (entget (setq e (nth 0 p1))))
(setq sel (cdr (assoc 0 ed)))
(while
(or (= sel "CIRCLE") (= sel "ARC"))
(setq cen (cdr (assoc 10 ed)))
(setq rad (cdr (assoc 40 ed)))
(setq pt1 (list (- (nth 0 cen) (+ rad 1)) (nth 1 cen)))
(setq pt2 (list (+ (nth 0 cen) (+ rad 1)) (nth 1 cen)))
(setq pt3 (list (nth 0 cen) (- (nth 1 cen) (+ rad 1))))
(setq pt4 (list (nth 0 cen) (+ (nth 1 cen) (+ rad 1))))
(setvar "clayer" "YHCENTER")
(setvar "celtype" "BYLAYER")
(setvar "cecolor" "BYLAYER")
(setvar "aperture" 1)
(setvar "osmode" 0 )
(command "line" pt1 pt2 "")
(command "line" pt3 pt4 "")
(setvar "osmode" os )
(setvar "aperture" aper)
(setvar "clayer" la)
(setvar "celtype" lt)
(setvar "cecolor" cl)
(setq sel1 sel)
(setq sel nil)
)
(if (not (or (= sel1 "CIRCLE") (= sel1 "ARC")))
(princ"\n选取的不是圆或圆弧!"))
(command "undo" "e")
(princ)
)

这笑脸烦人。再贴一个

a7web wrote:
这笑脸烦人。再贴一个

  
谢谢！

好東東！

可以同時處理同心圓..我台自台灣..從是模具設計and 模具二次軟件開發
請多指教
  
;;CENTER.LSP
;;draw clrcle or arc #CENMARK line
;;--------------------------
(DEFUN C:CENO() (SETQ KW@ "O") (#CENMARK)) ;;;繪中心線
(DEFUN C:CENI() (SETQ KW@ "I") (#CENMARK)) ;;;繪中心mark
;;--------------------------
(defun cEN_err(st)
   (setvar "osmode" osmode)
   (setvar "clayer" clay)
   (setq *error* old_err)
   (princ)
)
;;----------------------------------------------------
;;--------------------------
(DEFUN #CENMARK(/ cy sa eetn aa cc1 cc4  ch
       cucs sl en ena enb cp1 cp2 cp3 cp4 r rr)
(setq cy (getvar "clayer"))
(setq old_err *error* *error* cEn_err)
(setq osmode (getvar "osmode"))
(setvar "osmode" 0)
(if (null eet) (setq eet (abs (* (getvar "dimscale") (getvar "dimcen")))))
(INITGET ".")
(setq eet (ureal  0 "" "Extension length" eet))
  
(setvar "CMDECHO" 0)
(setq sa (ssget))
(setq n (sslength sa))
(setq i 0)
(setq da@ '())
(while (< i n)
    (setq ch nil)
    (setq eetn (ssname sa i))
    (setq aa (dxfa 0 eetn))
    (IF (OR (= "CIRCLE" AA) (= "ARC" AA))
       (progn
   (setq cc1 (dxfa 10 eetn))
   (setq cc4 (dxfa 40 eetn))
   (setq dda (list cc1 cc4))
   (setq sl (length da@))
   (setq w 0)
   (WHILE (and (/= ch "E") (<= w sl))
       (if (/= da@ nil)
        (progn
        (setq en (nth w da@))
        (setq ena (car en))
        (setq enb (cadr en))
        )
       )
          (cond((equal ena cc1 0.005)
            (IF (= KW@ "I")
          (if (> enb cc4)
              (setq da@ (subst dda en da@))
          )
          (if (< enb cc4)
              (setq da@ (subst dda en da@))
          )
            )
            (setq ch "E")
          )
          (T
            (if (or (and (= w sl) (not (equal ena cc1))) (= sl 0))
            (progn
              (setq da@ (cons dda da@))
              (setq ch "E")
            )
            )
          )
          );cond
        (setq w (1+ w))
   )
       )
    )
     (setq i (1+ i))
  ) ;while
;;---------------------------------------------
;;----------------draw #CENMARK line-------------
;;---------------------------------------------
  (setq !sl (length da@))
  (setq i 0)
  (COMMAND "LAYER" "S" "CENTER" "")
  (repeat !sl
      (setq ent (nth i da@))
      (setq cen (trans (car ent) 0 1))
      (setq r (cadr ent))
      (IF (= KW@ "I")
          (PROGN
          (if (null eet)
        (setq rr (* 0.3 r))
        (setq rr eet)
          )
          (setq cp1 (list (car cen) (+ (cadr cen) rr)))
          (setq cp2 (list (car cen) (- (cadr cen) rr)))
          (setq cp3 (list (- (car cen) rr) (cadr cen)))
          (setq cp4 (list (+ (car cen) rr) (cadr cen)))
          )
          (PROGN
          (if (null eet)
        (setq rr (* 0.1 r))
        (setq rr eet)
          )
          (setq cp1 (list (car cen) (+ (cadr cen) r rr)))
          (setq cp2 (list (car cen) (- (cadr cen) r rr)))
          (setq cp3 (list (- (car cen) r rr) (cadr cen)))
          (setq cp4 (list (+ (car cen) r rr) (cadr cen)))
          )
      )
      
      (command "line" cp1 cp2 "")
      (command "line" cp3 cp4 "")
      
      (setq i (1+ i))
  )
  (command "setvar" "highlight" "1")
  (setvar "CMDECHO" 0)
  (setvar "osmode" osmode)
  (command "layer" "set" cy "")
  (setq *error* old_err)
  (setvar "cmdecho" 1)
  (PRINC)
)
;;--------------------------------------------------------------------
;;----副程式----------------------------------------------------------
(defun ureal (bit kwd msg def / msg bit inp)
    (if def
      (setq msg (strcat "\n" msg " <" (rtos def 2) ">: ")
      bit (* 2 (fix (/ bit 2)))
      )
      (setq msg (strcat "\n" msg ": "))
    )
      (initget bit kwd)
      (setq inp (getreal msg))
      (if inp inp def)
)
;----------------------------------------------------------------------
(defun dxfa (code entity)
   (cdr (assoc code (entget entity)))
)

a7web wrote:
这笑脸烦人。再贴一个

  
下载后，这个东东咋用？？？？

这笑脸烦人。再贴一个

模头 wrote:
   
   
  下载后，这个东东咋用？？？？

  
下載后的文件（文件名為ZXX.lsp)放在CAD的support目錄下。
在命令行輸入：(load"zxx") 回車！
再輸入：zxx　回車！
再試試！::y

Jacky Wang wrote:
   
  
  下載后放在CAD的support目錄下。  
  在命令行輸入：(load"zxx")  
  再輸入：zxx　回車！  
  試試！::y

  
大哥，能不能贴张图演示一下，我试过了好象不行。::?::?