土木在线论坛 \ 建筑设计 \ CAD下载及教程 \ 请会LISP的帮我修正以下的程序

请会LISP的帮我修正以下的程序

发布于:2008-02-27 11:28:27 来自:建筑设计/CAD下载及教程 [复制转发]
(defun dyq-get-jiaoji (xz1 xz2) ;两个选择集的交集
(command "select" xz1 "r" xz2 "")
(command "select" xz1 "r" (ssget "p") "")
(ssget "p")
)


(defun c:ttt()
(setvar "cmdecho" 0)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(command "style" "hztxt" "txt,hztxt" "0" "0.7" "0" "" "" "")
(setq pt1 (getpoint "\n左上角: "))
(setq ww (getdist pt1 "\n宽度 <40>: "))
(if (null ww) (setq ww 40.0))
(setq hh (getdist pt1 "\n每格高度 <8>: "))
(if (null hh) (setq hh 8.0))
(setq pt2 (polar pt1 0 ww))
(setq pt3 (polar pt2 (* pi 1.5) hh))
(setq pt4 (polar pt1 (* pi 1.5) hh))
(command "pline" pt1 pt2 pt3 pt4 "c")
(setq pt5 (polar pt1 0 (/ ww 2)))
(setq pt6 (polar pt5 (* pi 1.5) hh))
(command "line" pt5 pt6 "")
(command "text" "m" (inters pt1 pt6 pt4 pt5) (/ hh 2) 0 "图块名称")
(command "text" "m" (inters pt5 pt3 pt2 pt6) (/ hh 2) 0 "数量")
(setq ss1 (ssget ’((0 . "INSERT"))))
(setq blk (tblnext "block" t))
(while blk

(setq blkn (assoc 2 blk))
(setq ss2 (ssget "x" (list (assoc 2 blk))))
(setq ss (dyq-get-jiaoji ss1 ss2))
(setq entname (ssname ss i))
(setq entlist (entget entname)) ;属性列表
(setq blknn (cdr (assoc 2 entlist))) ;块名
(setq blk_key (substr blknn 1 1))
(if (/= blk_key "*")(progn
(setq ssn (if (null ss) 0 (sslength ss)))
(setq blknn (cdr blkn))
(setq pt1 pt4 pt5 pt6 pt2 pt3)
(setq pt4 (polar pt1 (* pi 1.5) hh))
(setq pt6 (polar pt5 (* pi 1.5) hh))
(setq pt3 (polar pt2 (* pi 1.5) hh))
(command "pline" pt2 pt3 pt4 pt1 "")
(command "line" pt5 pt6 "")
(command "text" "m" (inters pt1 pt6 pt4 pt5) (/ hh 2) 0 blknn)
(command "insert" blknn (inters pt1 pt6 pt4 pt5) 1 1 0)
(command "text" "m" (inters pt5 pt3 pt2 pt6) (/ hh 2) 0 (itoa ssn))
))
(setq blk (tblnext "block"))
)
(setvar "osmode" os)
(prin1)
)
这个家伙什么也没有留下。。。

CAD下载及教程

返回版块

52.08 万条内容 · 682 人订阅

猜你喜欢

阅读下一篇

请会LISP的帮我修正以下的程序

(defun dyq-get-jiaoji (xz1 xz2) ;两个选择集的交集 (command "select" xz1 "r" xz2 "") (command "select" xz1 "r" (ssget "p") "") (ssget "p"))(defun c:ttt() (setvar "cmdecho" 0) (setq os (getvar "osmode"))

回帖成功

经验值 +10