iCAx开思网

标题: 【原创】画圆中心线的程序 [打印本页]

作者: cy_sun 时间: 2003-1-22 12:59
标题: 【原创】画圆中心线的程序
不知道谁有能画圆中心线的lsp，请贴一个上来看看，谢谢了！

作者: a7web 时间: 2003-1-22 13:51
;程序名：画中心线程序
;程序者：向志奇
;建立时间：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 时间: 2003-1-22 13:53
这笑脸烦人。再贴一个

作者: cy_sun 时间: 2003-1-22 17:59

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

谢谢！

作者: Jacky Wang 时间: 2003-1-23 21:56
好東東！

作者: shenhung 时间: 2003-2-19 19:44
可以同時處理同心圓..我台自台灣..從是模具設計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)))
)

作者: 模头 时间: 2003-2-19 20:33

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

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

作者: shenhung 时间: 2003-2-19 20:55
这笑脸烦人。再贴一个

作者: Jacky Wang 时间: 2003-2-19 20:56

模头 wrote:

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

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

::y

作者: 模头 时间: 2003-2-19 21:07

Jacky Wang wrote:

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

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

作者: QianFD 时间: 2003-2-22 13:47
为什么是先画圆，再画中心线的呀！？

欢迎光临 iCAx开思网 (https://www.icax.org/)