[LISP程序]：一个给圆画中心线的程序

hyx_lyn

这是一个给加圆画中心线的程序，可以同时对多个圆进行操作，设立中心线图层，在我这个程序当中心线层为“4”在使用中可以改为各位所设置的图层。

[php]
;;;-----------------------------------------------
;;;一个画圆中心线的程序
;;;中心线的长度为圆直径的1.5倍
;;;-----------------------------------------------
(defun c:zx (/            MYERROR          OLDERR OS        TC     EN     ENDATA
             ENTYPE N           SS          RR         ZD        ZX1    ZX2    ZX3
             ZX4
            )
  (defun myerror (msg)                        ;出错函数
    (setvar "osmode" os)                ;恢复捕捉
    (setvar "clayer" tc)                ;恢复原图层
    (setq *error* olderr)                ;恢复原来的出错函数
    (princ)
  )
  (setq        olderr        *error*                        ;保存旧的
        *error*        myerror                        ;设置新的
  )
  (setvar "cmdecho" 0)
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (setq tc (getvar "clayer"))
  (zx_style)
  (xqy)
  (setvar "osmode" os)                        ;恢复捕捉
  (setvar "clayer" tc)                        ;恢复原图层
  (setq *error* olderr)                        ;恢复原来的出错函数
  (prin1)
)

(defun xqy ()
  (prompt "\n选取对象(圆):")
  (setq ss (ssget '((0 . "CIRCLE"))))        ;建立选择集,过滤条件为对象为圆
  (if (not ss)                                ;当选择集为空时的处理
    (progn
      (setvar "osmode" os)                ;恢复捕捉
      (setvar "clayer" tc)                ;恢复原图层
      (setq *error* olderr)                ;恢复原来的出错函数
    )
  )
  (setq n 0)
  (repeat (sslength ss)
    (setq en (ssname ss n))                ;取得对象名称
    (setq endata (entget en))                ;取得对象数据序列
    (zxx)
    (setq n (1+ n))
  )
)

(defun zxx ()                                ;画中心线子程序
  (setq rr (cdr (assoc 40 endata)))
  (setq zd (cdr (assoc 10 endata)))
  (setq zx1 (polar zd 0 (* rr 1.5)))
  (setq zx2 (polar zd (/ pi 2) (* rr 1.5)))
  (setq zx3 (polar zd pi (* rr 1.5)))
  (setq zx4 (polar zd (* pi 1.5) (* rr 1.5)))
  (command "pline" zx1 zx3 "c")
  (command "pline" zx2 zx4 "c")
)

(defun zx_style        (/ zx1)                        ;检查图层如无则建立后设为当前图层
  (setq zx1 (tblsearch "layer" "4"))
  (if (null zx1)
    (command "_layer" "m" "4" "l" "center2" "4"        "lw" "0.13" "4"        "")
  )
  (setvar "clayer" "4")
)
[/php]

xyp1964

最简单的命令：dimcenter。
如果要设中心线长可以用命令：dimcen。

hyx_lyn

楼上说的我试了一下，有一些和我的程序有所不同

一、需要多次输入

二、完成的中心线无法改变图层

三、一次不能处理多个

四、中心线长度需要设定

应该说我这个程序还是比较傻瓜一些的

梦断江南

其实我平时工作都用不到这样的功能，有次即兴写了一个，调用画中心线命令的程序。只是玩玩，也不知道合用不，：）
[php]
;;; cenline = 画圆心线标志-------------.2004.9
(defun c:cenline ( / ss i ocen e pt out2) ;; out 全局.
  (princ "\n画圆心标志，选择标注实体:")
  (vl-cmdf ".undo" "be")
  (if (not out)(setq out 100))
  (setq ss (ssget '((0 . "CIRCLE,ARC")))
        out2 (getdist (strcat "\n线出头长度" (if out (rtos out 2 2) "") ":"))
        i -1
        ocen (getvar "dimcen"))
  (if out2 (setq out out2))
  (while (setq e (ssname ss (setq i (1+ i))))
    (setvar "dimcen" (+ out (cdr (assoc 40 (entget e)))))
    (setq pt (vlax-curve-getstartpoint e))
    (vl-cmdf "dimcenter" (princ (list e pt)))
  )
  (setvar "dimcen" ocen)
  (vl-cmdf ".undo" "e")
  (princ)
)
[/php]

xyp1964

简洁得差点看不懂！
又学了“vl-cmdf”和循环语句的简洁用法。
今天收获最大。
另：(vl-cmdf "dimcenter" (princ (list e pt)))是否改为(vl-cmdf "dimcenter" (list e pt))更好，最后出现的一堆数据似乎没用。


这是个经典又经典的程序！
向斑竹致敬！
[/COLOR]

提供一个学习斑竹的思路简化后的程序，献丑了：
[php]
;;;圆心标注
(defun c:test (/ ss n e)
  (cmdla0)
  (vl-cmdf ".undo" "be")
  (mkla "圆心线" 1)
  (setq        ss (ssget '((0 . "CIRCLE,ARC"))) n -1)
  (while (setq e (ssname ss (setq n (1+ n))))
    (setvar "dimcen"(* 1.5 (dxf 40 (entget e))))
    (vl-cmdf "dimcenter" (list e (vlax-curve-getEndpoint e)))
    )
  (vl-cmdf ".undo" "e")
  (cmdla1)
)

;;;-------------------------------------------
;;;通用子程序
;;;
(defun CMDLA0 ()
  (setq cmdech (getvar "CMDECHO"))
  (setq oom (getvar "orthomode"))
  (setq osm (getvar "osmode"))
  (SETQ LA (getvar "clayer"))
  (setq rmode (getvar "regenmode"))
  (setq pw (getvar "plinewid"))
  (setvar "regenmode" 0)
  (setvar "CMDECHO" 0)
  (princ)
)

;;;
(defun CMDLA1 ()
  (setvar "CMDECHO" cmdech)
  (setvar "orthomode" oom)
  (setvar "osmode" osm)
  (setvar "clayer" LA)
  (setvar "regenmode" rmode)
  (setvar "plinewid" pw)
  (princ)
)

;;;
(Defun MKLA (a b)
  (If (= (Tblsearch "layer" a) nil)
    (Command "layer" "m" a "c" b a "")
    (Command "layer" "t" a "s" a "c" b a "")))

;;;
(defun dxf (code elist) (cdr (assoc code elist)))

[/php]

梦断江南

(vl-cmdf "dimcenter" (princ (list e pt)))
是用来执行并观察返回值的，兼两个功能，当然，princ 并不是必要的。

lsjjm

给对称图形--圆, 圆弧, 椭圆, 矩形等画中心的程序本论坛早就有, 可搜索一下.

xyp1964

“dimcenter”命令肯定不行了，只好用画线或插块的命令生成，对于任意线性封闭域都可以找到中心点。

zhuquanmao

我也贴一个 呵呵
[PHP] ;; 在多个圆上画出中心线
(defun c:center (/ scale dist ssa osm n index entity center radius pt1 pt2
                   pt3 pt4 cla
                )
  (setvar "CMDECHO" 0)
  (setq osm (getvar "osmode"))
  (setvar "osmode" 0)
  (setq cla (getvar "clayer"))
  (command "-layer" "m" "centerline" "c" "7""" "l" "center" """")
  (command "-layer" "s" "Centerline" "")
  
  ;; (command "linetype" "s" "center" "")
  (setq scale (getvar "DIMSCALE"))
  (setq dist (* 2 scale))               ;  pick all circles
  (princ "\n 选择所有要加中心线的圆:")
  (princ "\n ")
  (setq ssa (ssget '((0 . "CIRCLE"))))
  (setq n (sslength ssa))
  (setq index (- n 1))
  (repeat n
    (setq entity (ssname ssa index))
    (setq center (cdr (assoc 10 (entget entity))))
    (setq radius (cdr (assoc 40 (entget entity))))
    (setq pt1 (polar center 0.0 (+ radius dist)))
    (setq pt2 (polar center 3.141592654 (+ radius dist)))
    (setq pt3 (polar center 1.5707963 (+ radius dist)))
    (setq pt4 (polar center -1.5707963 (+ radius dist)))
    (command "line" pt1 pt2 "")
    (command "line" pt3 pt4 "")
    (setq index (1- index))
  )
  (command "linetype" "S" "BYLAYER" "")
  (setvar "clayer" cla)
  (setvar "osmode" osm)
  (setvar "cmdecho" 1)
  (command "redraw")
  (princ)
)[/PHP]

xiaoyanyan

别人的。好东西当然与大家分享！
; center.lsp
;本程序创建多个孔的中心线。

(defun C:kzx (/ COUNT_1 COUNT_2 DIST OBJECTS_X OBJECTS_Y SCALE
      CENTER CENTER_2 ENTITY_1 ENTITY_2 RADIUS RADIUS_2
      LEFT LEFT_2 RIGHT RIGHT_2 NAME
   BOTTOM BOTTOM_2 TOP TOP_2)
   ;设置所有变量
   (setvar "CMDECHO" 0)
   (command "linetype" "S" "CENTER" "")
   (setq SCALE (getvar "DIMSCALE"))
   (setq DIST (* 0.1 SCALE))
   ; 拾取所有的圆
   (princ "\n选择所有希望添加中心线的圆:")
   (princ "\n ")
   (setq OBJECTS_X (ssget '((0 . "CIRCLE"))))
   ;构造两个选择集（水平和垂直）
   (setq OBJECTS_Y (ssget "P"))
   ; 绘制水平线的主循环
   (setq COUNT_1 0)
   (while (< COUNT_1 (sslength OBJECTS_X))
      (setq ENTITY_1 (entget (ssname OBJECTS_X COUNT_1)))
      (setq CENTER (cdr (assoc 10 ENTITY_1)))
      (setq RADIUS (cdr (assoc 40 ENTITY_1)))
      (setq RIGHT (polar center 0.0 (+ RADIUS DIST)))
      (setq LEFT (polar RIGHT 3.141592654 (* 2.0 (+ RADIUS DIST))))
      (setq COUNT_2 (+ COUNT_1 1))
      (while (< COUNT_2 (sslength OBJECTS_X))
         (setq ENTITY_2 (entget (ssname OBJECTS_X COUNT_2)))
         (setq CENTER_2 (cdr (assoc 10 ENTITY_2)))
         (if (< (ABS (-  (cadr CENTER) (cadr CENTER_2))) 0.0001)
            (progn
               (setq RADIUS_2 (cdr (assoc 40 ENTITY_2)))
               (setq RIGHT_2 (polar CENTER_2 0.0 (+ RADIUS_2 DIST)))
               (setq LEFT_2 (polar RIGHT_2 3.141592654 (* 2.0 (+ RADIUS_2 DIST))))
               (if (< (car LEFT_2) (car LEFT))
                  (setq LEFT LEFT_2)
               )
               (if (> (car RIGHT_2) (car RIGHT))
                  (setq RIGHT RIGHT_2)
               )
               (setq NAME (ssname OBJECTS_X COUNT_2))
               (setq OBJECTS_X (ssdel NAME OBJECTS_X))
               (setq COUNT_2 (- COUNT_2 1))
            )
         )
         (setq COUNT_2 (+ COUNT_2 1))
      )      (command "line" LEFT RIGHT "")
      (setq COUNT_1 (+ COUNT_1 1))
   )      
   ; 绘制垂直线的主循环
   (setq COUNT_1 0)
   (while (< COUNT_1 (sslength OBJECTS_Y))
      (setq ENTITY_1 (entget (ssname OBJECTS_Y COUNT_1)))
      (setq CENTER (cdr (assoc 10 ENTITY_1)))
      (setq RADIUS (cdr (assoc 40 ENTITY_1)))
      (setq TOP (polar CENTER 1.570796327 (+ RADIUS DIST)))
      (setq BOTTOM (polar TOP 4.712388981 (* 2.0 (+ RADIUS DIST))))
      (setq COUNT_2 (+ COUNT_1 1))
      (while (< COUNT_2 (sslength OBJECTS_Y))
         (setq ENTITY_2 (entget (ssname OBJECTS_Y COUNT_2)))
         (setq CENTER_2 (cdr (assoc 10 ENTITY_2)))
         (if (< (ABS (-  (car CENTER) (car CENTER_2))) 0.0001)
            (progn
               (setq RADIUS_2 (cdr (assoc 40 ENTITY_2)))
               (setq TOP_2 (polar CENTER_2 1.570796327 (+ RADIUS_2 DIST)))
               (setq BOTTOM_2 (polar TOP_2 4.712388981 (* 2.0 (+ RADIUS_2 DIST))))
               (if (> (cadr TOP_2) (cadr TOP))
                  (setq TOP TOP_2)
               )
               (if (< (cadr BOTTOM_2) (cadr BOTTOM))
                  (setq BOTTOM BOTTOM_2)
               )
               (setq NAME (ssname OBJECTS_Y COUNT_2))
               (setq OBJECTS_Y (ssdel NAME OBJECTS_Y))
               (setq COUNT_2 (- COUNT_2 1))
            )
         )
         (setq COUNT_2 (+ COUNT_2 1))
      )
      (command "line" TOP BOTTOM "")
      (setq COUNT_1 (+ COUNT_1 1))
   )
   ; 复位所有变量并清除绘图
   (command "linetype" "S" "BYLAYER" "")
   (command "redraw")
   (setvar "cmdecho" 1)
); end center.lsp