[求助]：请高手帮忙看一下如何写这个程序

tc405003

思路：
1选取指定图层中的圆和矩形并建先择集
2依次求得图形的形心，
3读取系统字高
3在形心上画PL线，PL线与字高有关系线的形状是先45度再0度
4在线上标按输入的前缀标文字
我是个初学者，要想实现这个功能要很多时间！因为时间紧，只好求救于各位大哥

eachy

CAD没有矩形实体，只有Line、Pline实体

贴图说明

snoopychen

很久以前写的一个关于对柱子形心插入基础的程序，大概修改一下，你看看是不是大概这个意思
里面选择的是多义线，不止是矩形，专门的矩形还要加几句判断，比如对边相等对角线相等的话
肯定离你的具体想法还有一些距离：）你改改看能用否
不过用了stdlib函数，所以你得先加载附件中的stdlib.lsp才行，可以在r14下用
一时找不到stdlib的下载地址，只好在附件中浪费空间，不好意思了
[php]

(defun C:jc ()
  (setq lleng (getreal "\n45度的线长：<1000>"))
  (if (= lleng nil)
    (setq lleng 1000)
  )
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (command "undo" "be")
  (setq sset (ssget '((-4 . "<OR") (0 . "LWPOLYLINE")
                     (0 . "CIRCLE")
                     (-4 . "OR>")
                    )
             )
  )
  (setq itm 0
        num (sslength sset)
  )
  (if sset
    (progn
      (setq itm 0
            num (sslength sset)
      )
      (while (< itm num)
        (setq hnd (ssname sset itm))
        (setq ent (entget hnd))
        (setq obj (cdr (assoc 0 ent)))
        (setq lay (cdr (assoc 8 ent)))
        (setq pcen nil)
        (setvar "clayer" lay)
        (cond
          ((= obj "LWPOLYLINE")
            (w_pl_lst ent)
            (setq pcen (std-centroid-2d pl_list))
          )
          ((= obj "CIRCLE")
            (setq pcen (cdr (assoc 10 ENT)))
          )
          (t
            nil
          )
        )

        (if pcen
          (progn
            (setq p1 (polar pcen (/ pi 4) lleng))
            (setq p2 (polar p1 0 lleng))
            (setq p3 (polar p2 (/ pi 2) (/ lleng 10)))
            (command "pline" pcen p1 p2 "")
            (command "text" "j" "r" p3 "" "" "123" "")
          )
        )
        (setq itm (1+ itm))
      )
      (command "undo" "e")
      (setvar "osmode" os)
    )
  )
)

;;;写多义线的端点到表pl_list
(defun w_pl_lst (ent)
  (setq pl_list nil)
  (foreach rec ent
    (if (= (car rec) 10)
      (progn
        (setq pnt (cdr rec))
        (setq pnt1 (list pnt))
        (setq pl_list (append
                        pnt1
                        pl_list
                      )
        )
      )
    )
  )
)
[/php]

tc405003

下载出问题！请问是什么原因能否发到我的邮箱；tangchao405003@163.com

snoopychen

现在应该可以下载的