装修用动态剖切索引号，自己动手完成了
本帖最后由 無恒的地盘 于 2013-5-12 19:13 编辑;;;剖切符号
(defun sy_begin ()
(setq oderr *error*);;;保存原来的*error*
(setq *error* sy_err);;将*error*用自己的错误处理函数替代
(setq odltp (getvar "celtype"));;;记录当前线型设置
(setq odclr (getvar "cecolor"));;;记录当前颜色设置
(setq odosm (getvar "osmode"));;;记录当前捕捉方式
(setq odlay (getvar "clayer"));;;记录当前层
(setq odsty (getvar "textstyle"));;;记录当前文本样式;;;(setq odtsz (getvar "textsize"));;;记录当前文本高度
(setq odbpm (getvar "blipmode"));;;记录当前控制点标记是否可见
(setq odcmd (getvar "cmdecho"));;;记录命令行回显方式
(setq odORT (getvar "ORTHOMODE"))
(setvar "celtype" "bylayer");;;设置线形随层
(setvar "cecolor" "bylayer")
(setvar "cecolor" "6");;;设置颜色随层
(setvar "cmdecho" 0);;;设置命令行不回显
(setvar "ORTHOMODE" 1)
(setvar "blipmode" 0);;;不显示控制点标记
(setvar "osmode" 0);;;关闭对象捕捉方式)
)
;;;BZ_end
;;;功 能：程序结束，恢复程序开始前的设置。
;;;恢复BZ_begin设置的系统变量表中的数值。
;;;说 明：和函数BZ_begin配对使用。
(defun sy_end ()
(setvar "celtype" odltp)
(setvar "cecolor" odclr)
(setvar "osmode" odosm)
(setvar "ORTHOMODE" odort)
(setvar "textstyle" odsty)
(setvar "blipmode" odbpm)
;;;(setvar "textsize" odtsz)
;;;(setvar "dimzin" odzin);;;恢复主单位值消零处理方式
(command "layer" "s" odlay "")
(setvar "cmdecho" odcmd)
(setq *error* oderr);;;恢复原来的*error*
(princ)
)
;;;BZ_err
;;;功 能：错误处理函数
(defun sy_err (msg)
(princ (strcat "\n错误:" msg "\n")) ;;打印错误原因
(sy_end) ;;调用函数BZ_end恢复程序开始前的设置
(setq *error* oderr) ;;恢复原来的*error*
(princ)
)
;;;上面部分为网上搜集
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun sw_sett ()
(if (null *scalesy)
(setq *scalesy 10)
)
(setq scalesy (getint (strcat "\n请输入比例<" (itoa *scalesy) ">：")))
(if scalesy
(setq *scalesy scalesy)
(setq scalesy *scalesy)
)
(c:sw_pp)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:sw_pp ()
(sy_begin);;;设置系统变量
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(IF (= (TBLSEARCH "BLOCK" "sw_dysytb") nil);;;判断索引块是否存在，否则创建。
(PROGN
(setvar "CMDECHO" 0);;;关闭回显
(vl-cmdf "OSMODE" "0");;;关闭对象捕捉
(vl-cmdf "ORTHO" "on");;;关闭正交
(if (= nil (tblsearch "layer" "0"))(vl-cmdf "layer" "N" "0" "C" "bylayer" ""));;;设置当前图层
;;;(vl-cmdf "style" "黑体" "SIMHEI.TTF" "0" "0.8" "0" "N" "N");;;设置文字样式
;;;编组
(setq ss1 (ssadd))
(vl-cmdf "circle" "0.0,0.0,0.0" "4")
;;;绘制圆
;;;(ssadd (entlast) ss1)
(ssadd (setq sn1 (entlast)) ss1)
;;;(polar sy_pt (/ pi 2) 1.5)
;;;(vl-cmdf "-attdef" "" "A" "A" "A" "j" "c" (polar sy_pt (/ pi 2) 0.4) "2.8" "0")
(vl-cmdf "-attdef" """A""A""A""j""c" "0.0,0.4,0.0""2.8" "0")
;;;(ssadd (entlast) ss1)
(ssadd (setq sn2 (entlast)) ss1)
;;;(vl-cmdf "-attdef" "" "E-01" "E-01" "E-01" "j" "c" (polar sy_pt1 (- (/ pi 2)) 2.5) "1.6" "0")
(vl-cmdf "-attdef""" "E-01""E-01""E-01" "j""c""0.0,-2.5,0.0""1.6" "0")
;;;(ssadd (entlast) ss1)
(ssadd (setq sn3 (entlast)) ss1)
;;;(setq sy_pt7 (polar sy_pt1 (/ pi 1) 4))
;;;(setq L5 (polar sy_pt1 (/ pi 1) (- 4)))
;;;(entmake (list '(0 . "LINE") (cons 10 sy_pt7) (cons 11 L5)))
(command "line" "-4.0,0.0,0.0" "4.0,0.0,0.0" "")
;;;sw_dysytb的短横线
;;;(ssadd (entlast) ss1)
(ssadd (setq sn4 (entlast)) ss1)
(command "change" sn1 sn2 sn3 sn4 "" "P" "la" "0" "")
(command "change" sn2 sn3 "" "P" "c" "7" "")
(command "change" sn1 sn4 "" "P" "c" "6" "")
(command "-block" "sw_dysytb" "0.0,0.0,0.0" ss1 "")
;;;(setq del (entlast))
;;;(entdel del)
)
;;;end_PROGN
)
;;;end_if
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (null scalesy)
(setq scalesy 10)
)
(initget "s")
(setqsy_pt1 (getpoint (strcat "\n设置比例/当前的比例为<"(rtos scalesy)">或指定起点: ")))
(cond
((vl-consp sy_pt1) (sw_sy))
((= sy_pt1 "s") (sw_sett))
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun sw_sy ()
;;(setq sy_pt1 (getpoint "\n指定第二角点:[退出]"))
(setq sy_pt2 (getpoint sy_pt1 "\n指定第二角点:[退出]"))
;;第二点跟随鼠标同步移动,并判断短粗线的方向
(setq jd (angle sy_pt1 sy_pt2);;角度
sy_pt1d (polar sy_pt1 (+ (* 1.5 pi) jd) (* 0.8 scalesy)) ;;计算第一短粗线起点
sy_pt2d (polar sy_pt2 (+ (* 1.5 pi) jd) (* 0.8 scalesy)) ;;计算第二短粗线起点
)
(command "dist" sy_pt1 sy_pt2) ;;计算两点距离
(setq DL (getvar "distance"))
(if (<= DL (* 5 scalesy));;如果DL距离小于5倍比例值，则只画第一条短粗线,一条PL线
(progn
(setq L1d (polar sy_pt1d jd (* 5 scalesy)));;计算第一短粗线终点
(setq sy_pt2 (polar sy_pt1 jd (* 5 scalesy)))
(setvar "plinewid" (* 0.5 scalesy)) ;;设定第一短粗线线宽比例
(setq ss2 (ssadd))
(command "pline" sy_pt1d L1d "") ;;画第一短粗线
(ssadd (setq en1b (entlast)) ss2)
(setq ent1b (entget en1b))
(setvar "plinewid" 0) ;;设定PL线宽
(setq
sy_pt3 (getpoint sy_pt2 "\n指定第三角点:[退出]"))
(setq L3 (polar sy_pt3 0 (* 9 scalesy)))
(if (or (> (cadr sy_pt3) (cadr sy_pt2))
(< (cadr sy_pt3) (cadr sy_pt2))
) ;;如果pt2和pt3为垂直方向，则要L3
(progn
(command "pline" sy_pt1 sy_pt2 sy_pt3 L3 "")
(ssadd (setq en1d (entlast)) ss2)
(command "_insert" "sw_dysytb" L3 scalesy scalesy 0 "" "") ;;如果pt2和pt3为垂直方向，则块插入点为L3
)
)
(if (= (cadr sy_pt3) (cadr sy_pt2));;如果pt2和pt3为水平方向，则不要L3
(progn
(command "pline" sy_pt1 sy_pt2 sy_pt3 "")
(ssadd (setq en1d (entlast)) ss2)
(command "_insert""sw_dysytb" sy_pt3scalesy scalesy0 """")
;;如果pt2和pt3为水平方向，则块插入点为sy_pt3
)
)
(setq Z T)
(while z
(setq grr (grread t 4 0)) ;请求输入
(setq gr (car grr)
po (cadr grr)
)
(cond
((= gr 5) ;移动时
(redraw)
(setq pt (vlax-curve-getClosestPointTo en1d po T))
(setq ang (angle pt po))
(setq sy_pt1d (polar sy_pt1 ang (* 0.8 scalesy)))
(setq L1d (polar sy_pt1d jd (* 5 scalesy)))
(setq col (assoc 62 ent1b))
(if col
(setq num1 15
num2 19
)
(setq num1 14
num2 18
)
)
(setq ent1b (subst (cons 10 sy_pt1d) (nth num1 ent1b) ent1b))
(entmod ent1b)
(setq ent1b (subst (cons 10 l1d) (nth num2 ent1b) ent1b))
(entmod ent1b)
(grdraw l1d po 2)
)
((or (= gr 3) ;左击
(equal grr '(2 32)) ;空格
(equal grr '(2 13)) ;回车
(equal grr '(11 0)) ;右击
)
(setq z nil)
)
)
)
(redraw)
)
;;;end_progn
)
;;;end_if
(if (and (> DL (* 5 scalesy))
(<= DL (* 3 5 scalesy))
)
;;如果DL距离大于5倍小于等于15倍比例值，则只画第一条短粗线,一条PL线,第一短粗线长度随DL值变化
(progn
(setq L1d (polar sy_pt1djd(+ (* 5 scalesy) (/ (- DL (* 5 scalesy)) 3)))) ;;计算第一短粗线终点
(setvar "plinewid" (* 0.5 scalesy));;设定第一短粗线线宽比例
(setq ss2 (ssadd))
(command "pline" sy_pt1d L1d "");;画第一短粗线
(ssadd (setq en1b (entlast)) ss2)
(setq ent1b (entget en1b))
(setvar "plinewid" 0)
(setqsy_pt3 (getpoint sy_pt2"\n指定第三角点:[退出]" ))
(setq L3 (polar sy_pt3 0 (* 9 scalesy)))
(if (or (> (cadr sy_pt3) (cadr sy_pt2))
(< (cadr sy_pt3) (cadr sy_pt2))
) ;;如果pt2和pt3为垂直方向，则要L3
(progn
(command "pline" sy_pt1 sy_pt2 sy_pt3 L3 "")
(ssadd (setq en1d (entlast)) ss2)
(command "_insert" "sw_dysytb" L3 scalesy scalesy 0 "" "") ;;如果pt2和pt3为垂直方向，则块插入点为L3
)
)
(if (= (cadr sy_pt3) (cadr sy_pt2)) ;;如果pt2和pt3为水平方向，则不要L3
(progn
(command "pline" sy_pt1 sy_pt2 sy_pt3 "")
(ssadd (setq en1d (entlast)) ss2)
(command "_insert""sw_dysytb"sy_pt3scalesy scalesy 0"" "")
;;如果pt2和pt3为水平方向，则块插入点为sy_pt3
)
)
(setq Z T)
(while z
(setq grr (grread t 4 0)) ;请求输入
(setq gr (car grr)
po (cadr grr)
)
(cond
((= gr 5) ;移动时
(redraw)
(setq pt (vlax-curve-getClosestPointTo en1d po T))
(setq ang (angle pt po))
(setq sy_pt1d (polar sy_pt1 ang (* 0.8 scalesy)))
(setq
L1d (polar sy_pt1d
jd
(+ (* 5 scalesy) (/ (- DL (* 5 scalesy)) 3))
)
)
(setq col (assoc 62 ent1b))
(if col
(setq num1 15
num2 19
)
(setq num1 14
num2 18
)
)
(setq ent1b (subst (cons 10 sy_pt1d) (nth num1 ent1b) ent1b))
(entmod ent1b)
(setq ent1b (subst (cons 10 l1d) (nth num2 ent1b) ent1b))
(entmod ent1b)
(grdraw l1d po 2)
)
((or (= gr 3) ;左击
(equal grr '(2 32)) ;空格
(equal grr '(2 13)) ;回车
(equal grr '(11 0)) ;右击
)
(setq z nil)
)
)
)
(redraw)
)
;;;end_progn
)
;;;end_if
(if (> DL (* 3 5 scalesy))
;;如果DL距离大于15倍比例值，则画两条短粗线,一条短细线,一条PL线
(progn
(setq L1 (polar sy_pt1 jd (* 5 scalesy)))
;;计算第一短细线终点
(setq L1d (polar sy_pt1d jd (* 5 scalesy)))
;;计算第一短粗线终点
(setq L2d (polar sy_pt2d (+ jd (/ pi 1)) (* 5 scalesy)))
;;计算第二短粗线终点
(setq L2 (polar sy_pt2 jd (- (* 5 scalesy))))
;;计算PL线起点
(setq ss2 (ssadd))
(entmake (list '(0 . "LINE") (cons 10 sy_pt1) (cons 11 L1)))
;;画第一短细线
(ssadd (setq en1a (entlast)) ss2)
(setvar "plinewid" (* 0.5 scalesy))
;;设定短粗线线宽比例
(command "pline" sy_pt1d L1d "")
;;画第一短粗线
(ssadd (setq en1b (entlast)) ss2)
(setq ent1b (entget en1b))
(command "pline" sy_pt2d L2d "")
;;画第二短粗线
(ssadd (setq en1c (entlast)) ss2)
(setq ent1c (entget en1c))
(setvar "plinewid" 0)
(setq
sy_pt3 (getpoint sy_pt2
"\n指定第三角点:[退出]"
)
)
(setq L3 (polar sy_pt3 0 (* 9 scalesy)))
(if (or (> (cadr sy_pt3) (cadr sy_pt2))
(< (cadr sy_pt3) (cadr sy_pt2))
)
;;如果pt2和pt3为垂直方向，则要L3
(progn
(command "pline" L2 sy_pt2 sy_pt3 L3 "")
(ssadd (setq en1d (entlast)) ss2)
(command "_insert" "sw_dysytb" L3 scalesy scalesy 0 "" "")
;;如果pt2和pt3为垂直方向，则块插入点为L3
)
)
(if (= (cadr sy_pt3) (cadr sy_pt2))
;;如果pt2和pt3为水平方向，则不要L3
(progn
(command "pline" L2 sy_pt2 sy_pt3 "")
(ssadd (setq en1d (entlast)) ss2)
(command "_insert""sw_dysytb" sy_pt3
scalesy scalesy 0 ""
""
)
;;如果pt2和pt3为水平方向，则块插入点为sy_pt3
)
)
(setq Z T)
(while z
(setq grr (grread t 4 0)) ;请求输入
(setq gr (car grr)
po (cadr grr)
)
(cond
((= gr 5) ;移动时
(redraw)
(setq pt (vlax-curve-getClosestPointTo en1a po T))
(setq ang (angle pt po))
(setq sy_pt1d (polar sy_pt1 ang (* 0.8 scalesy))
sy_pt2d (polar sy_pt2 ang (* 0.8 scalesy))
l2d (polar sy_pt1d jd (* 5 scalesy))
l2 (polar sy_pt2d (+ jd pi) (* 5 scalesy))
)
(setq col (assoc 62 ent1b))
(if col
(setq num1 15
num2 19
)
(setq num1 14
num2 18
)
)
(setq ent1b (subst (cons 10 sy_pt1d) (nth num1 ent1b) ent1b))
(entmod ent1b)
(setq ent1b (subst (cons 10 l2d) (nth num2 ent1b) ent1b))
(entmod ent1b)
(setq ent1c (subst (cons 10 sy_pt2d) (nth num1 ent1c) ent1c))
(entmod ent1c)
(setq ent1c (subst (cons 10 l2) (nth num2 ent1c) ent1c))
(entmod ent1c)
(grdraw l2d po 2)
)
((or (= gr 3) ;左击
(equal grr '(2 32)) ;空格
(equal grr '(2 13)) ;回车
(equal grr '(11 0)) ;右击
)
(setq z nil)
)
)
)
(redraw)
)
;;;end_progn
)
;;;end_if
(command "change" ss2 "" "P" "c" "6" "")
;;修改第一短细线，第一短粗线，第二短粗线，PL线颜色为6
(command "-group" "c" "*" "" ss2 "")
;;;创建组
;(command "-group" "c" "*" "" en1 en1a en1b en1c en2 "");;;创建组
(sy_end)
;;;恢复系统变量
(princ)
)
;;end
代码很菜，动态功能有点问题，请教该如何解决，另请帮我加一个切换功能，就是按空格或TAB键切换图号方向,感激不尽！
更新动态剖切符号程序 这个在自定义坐标时会出错 想下载没有币了 那么长的代码估计吓坏蛮多人的！我也没细看了！自己慢慢调试下吧看你完成的已经差不多拉！
第二个问题，在动态结束后用initget加个getpoint啥的使程序暂停等待你空格指令镜像即可 wowan1314 发表于 2013-4-11 22:47 static/image/common/back.gif
那么长的代码估计吓坏蛮多人的！我也没细看了！自己慢慢调试下吧看你完成的已经差不多拉！
第二个问题， ...
感谢woman1314，我是想在鼠标动态的时候也可以按空格或TAB键来切换图号的方向，图号的方向只在纵向的情况下有，横向不需要。 你在grread里面加就是啦！不知键位的话可参考论坛grread函数大杀器的帖子 wowan1314 发表于 2013-4-11 23:59 static/image/common/back.gif
你在grread里面加就是啦！不知键位的话可参考论坛grread函数大杀器的帖子
请问woman1314有没有关于简单的切换例子，因为即使我知道键位估计也不会加。 还真不知道哪个适合你！
只能大概给你说说
在Grread的语句中加入如下！
当 键位为空格或tab时。 把图号作为选集利用command调用镜像命令把它镜像！ 转发微博
http://bbs.mjtd.com/xwb/images/bgimg/icon_logo.png 来自 love一之宫由贵 的新浪微博 本帖最后由 無恒的地盘 于 2013-4-12 13:00 编辑
wowan1314 发表于 2013-4-12 00:34 static/image/common/back.gif
还真不知道哪个适合你！
只能大概给你说说
在Grread的语句中加入如下！
把图号作为选集利用command调用镜像命令把它镜像,今天中午试了一下可行，但动态那个问题却不知道怎么解决了,还请woman1314指教。 微博评论 发表于 2013-4-12 02:59 static/image/common/back.gif
**** 作者被禁止或删除 内容自动屏蔽 ****
微博评论 发表于 2013-4-12 02:59
**** 作者被禁止或删除 内容自动屏蔽 ****
大哥，你的回复我看不见。
转发微博
http://bbs.mjtd.com/xwb/images/bgimg/icon_logo.png 来自 巴音德力格尔之歌 的新浪微博