Hello,大家好，baguiming的第一个博文（AutoCad lisp插件 ）
哈哈，在腿受伤期间边边写了一个lisp插件，分享一下，有兴趣的可以一起学。
;----------------------------------------------------------
; 函数名：hang （可用于cad命令）
;----------------------------------------------------------
; 说明： 1、绘制一个矩形巷道断面
; 2、打设锚杆、锚索的支护方式
; 用户交互输入： 宽度，高度，支护厚度，锚杆间距，比例尺
;----------------------------------------------------------
(defun c:hang ( / kuan gao zhihu_hou bili bili_ x0 y0 p01 p02 p03 p04 p01_ p02_ p03_ p04_ )
(setq kuan (getreal "请输入巷道宽度"))
(setq gao (getreal "请输入巷道高度"))
(setq zhihu_hou (getreal "请输入支护厚度（默认50mm）"))
(setq maogan_juanju (getreal "请输入锚杆间距，默认800mm（单位：mm）"))
(setq bili (getint "请输入比例尺（1:?)默认1：100"))
;确认输入比例尺 是否有效
(if (= bili nil)
(progn
(setq bili 10)
)
(progn
(setq bili (/ 1000 bili))
)
)
;确认输入支护厚度 是否有效
(if (= zhihu_hou nil)
(progn
(setq zhihu_hou 0.050)
)
(progn
(setq zhihu_hou (/ zhihu_hou 1000))
)
)
;(setq gao (* bili gao) kuan (* bili kuan) zhihu_hou (* bili zhihu_hou))
(setq p01 (getpoint "请输入巷道插入点（左下角）"))
;确认插入点 数据 是否有效
(if (= p01 nil)
(progn
(setq p01 (list 0 0 0))
)
)
(if (or (= maogan_juanju 0) (= maogan_juanju nil))
(setq maogan_juanju 0.8)
(setq maogan_juanju (/ maogan_juanju 1000 ))
)
(setq x0 (car p01) y0 (cadr p01))
(setq p02 (list x0 (+ y0 gao) 0))
(setq p03 (list (+ kuan x0) (+ y0 gao) 0))
(setq p04 (list (+ kuan x0) y0 0 ))
(command "PLINE" p01 "w" 0.0 0.0 p02 p03 p04 "c") ;绘制巷道 净断面 轮廓
(command "OSNAP" "non")
(setq p01_ (list (- x0 zhihu_hou ) y0 0))
(setq p02_ (list (- x0 zhihu_hou ) (+ y0 zhihu_hou gao) 0))
(setq p03_ (list (+ zhihu_hou kuan x0) (+ y0 gao zhihu_hou) 0))
(setq p04_ (list (+ zhihu_hou kuan x0) y0 0 ))
(command "PLINE" p01_ "w" 0 0 p02_ p03_ p04_ "c") ;绘制巷道 掘进断面 轮廓
(setq bili_ (/ 1000 bili))
(command "STYLE" "hanzi3.5" "gbcbig" (/ 3.5 bili) 1 0 "" "" "" )
(command "text" "m" (list (+ x0 (/ kuan 2)) (+ y0 (/ gao 2)) ) 0 (strcat "比例尺1:" (rtos bili_) ) )
;以下代码 打帮部锚杆
(setq N (+ 1 (quzheng (/ gao maogan_juanju ))))
(setq qmj (/ (- gao (* n maogan_juanju)) 2))
(if (<= qmj 0)
(progn
(setq qmj (+ maogan_juanju qmj))
(setq N (- N 1))
)
)
(setq count 0)
(repeat N
;左帮锚杆
(setq mao_L01 (list x0 (+ y0 qmj (* count maogan_juanju) ) 0) )
(maogan mao_L01 180 )
;右帮锚杆
(setq mao_L01 (list (+ kuan x0) (+ y0 qmj (* count maogan_juanju) ) 0) )
(maogan mao_L01 0 )
(setq count (+ 1 count))
)
;以下代码 打顶部锚杆
(setq N (+ 1 (quzheng (/ kuan maogan_juanju ))))
(setq qmj (/ (- kuan (* n maogan_juanju)) 2))
(if (<= qmj 0)
(progn
(setq qmj (+ maogan_juanju qmj))
(setq N (- N 1))
)
)
(setq count 0)
(repeat N
(setq mao_L01 (list (+ x0 qmj (* count maogan_juanju)) (+ gao y0 ) 0 ) )
(maogan mao_L01 90 )
(setq count (+ 1 count))
)
(setvar "DIMSCALE" 0.1)
(command "DIMLINEAR" p01 p04 "h" "@0,-0.5")
(setq dimcols (list (entlast)))
;(setdim (entlast) 2 2 (/ 1000 bili))
(command "DIMLINEAR" p04 p03 "v" "@0.8,0")
(setq dimcols (append dimcols (list (entlast))))
;(setdim (entlast) 2 2 (/ 1000 bili))
;以下代码 按照bili 比例缩放
(setq scale_p0 (list (- x0 (* 3 kuan)) (- y0 (* 3 gao) ) 0) )
(setq scale_p1 (list (+ x0 (* 3 kuan) ) (+ y0 (* 3 gao) ) 0))
(command "SCALE" "w" scale_p0 scale_p1 "" p01 bili )
(setvar "DIMSCALE" 1)
;集中修改标注
(foreach dims dimcols
(setdim dims 2 2 (/ 1000 bili))
)
)
;------------------------END-------------------------------
;----------------------------------------------------------
; 函数名：maogan （不用于cad命令）
;----------------------------------------------------------
; 说明： 1.在指定位置打设锚杆
; 参数： 1. pt----点 list 类型
; 2. jiaodu----角度 real类型
; 返回类型： 无返回值
;----------------------------------------------------------
(DEFUN maogan(pt jiaodu / x0 y0 p0 ) ;pt插入点 jiaodu 方向角度 ；bili比例尺
;(setq pt '(10 0 0))
;(setq jiaodu 90)
;(setq bili 50)
;
;(if (or (= bili 0) (= bili nil))
; (setq bili 20)
; (setq bili (/ 1000 bili))
;)
;
(setq x0 (car pt) )
(setq y0 (cadr pt))
(setq p0 pt)
(setq p1 (list (- x0 1) y0 ))
(setq p2 (list (- x0 1) (- y0 0.05) ))
(setq p3 (list (- x0 1.08) (+ y0 0.05) ))
(setq p4 (list (- x0 1.08) y0 ))
(setq p5 (list (- x0 2.08) y0 ))
(command "OSNAP" "non")
(command "PLINE" p0 "w" 0 0 p1 p2 p3 p4 p5 "")
(setq pl01(entlast))
(command "ROTATE" pl01 "" pt (- jiaodu 180) "")
;(command "SCALE" pl01 "" pt bili )
)
;------------------------END-------------------------------
;----------------------------------------------------------
; 函数名：quzheng （不用于cad命令）
;----------------------------------------------------------
; 说明： 1、对给定实数取整数值
; 参数： x-----------实数
; 返回类型： int-------- 整数
;
;----------------------------------------------------------
(defun quzheng(x)
(read (rtos x 2 0 ))
)
(defun setdim(tuyuan zigao jiantou_size dim_bili)
;(setq dim01 (entlast))
;(setq dim01ax (vlax-ename->vla-object dim01))
;(vlax-dump-object dim01ax )
(setq dim01ax (vlax-ename->vla-object tuyuan))
(vlax-dump-object dim01ax )
(vlax-put-property dim01ax 'ArrowheadSize jiantou_size)
(vlax-put-property dim01ax 'TextHeight zigao)
(vlax-put-property dim01ax 'LinearScaleFactor dim_bili)
(vlax-put-property dim01ax 'ScaleFactor 1)
)
(defun c:zifulianjie( / ent)
(prompt "请选择要连接的文本")
(setq ent (car (entsel)))
;(setq type_ent (cdr (assoc 0 (entget ent))))
(setq type_ent (get_ent_type ent ))
(while ( and (/= type_ent "MTEXT") (/= type_ent "TEXT"))
(prompt "请选择文本")
(setq ent (car (entsel)))
(setq type_ent (get_ent_type ent ))
)
(setq text_start ent) ;选择文本串作为 连接的首个文本
(setq str_start (get_text_string text_start))
(setq text_start_ax (vlax-ename->vla-object text_start))
;(vlax-dump-object text_start_ax)
;(entget text_star)
;(get_text_string text_star)
(setq ent (car (entsel)))
(while (/= ent nil )
(setq type_ent (get_ent_type ent ))
(if ( or (= type_ent "MTEXT") (= type_ent "TEXT"))
(progn
(setq text_mid ent )
(setq str_mid (get_text_string text_mid))
(setq str_start (strcat str_start str_mid))
(vlax-put-property text_start_ax 'TextString str_start )
(command "ERASE" ent)
)
)
(setq ent (car (entsel)))
)
)
;----------------------------------------------------------
; 函数名：get_ent_type （不用于cad命令）
;----------------------------------------------------------
; 说明： 1、返回ent图元的类型
; 参数： ent----------图元名
; 返回类型： string-------图元实体类型 如:Icadline
;
;----------------------------------------------------------
(defun get_ent_type(ent) ;自建函数 用于获取图元的 类型名
(cdr (assoc 0 (entget ent)))
)
;----------------------------------------------------------
; 函数名：get_text_string （不用于cad命令）
;----------------------------------------------------------
; 说明： 1、返回TEXT 或 MTEXT图元的textstring字串内容
; 参数： ent----------图元名
; 返回类型： string-------图元实体textstring 字串内容
;
;----------------------------------------------------------
(defun get_text_string(ent) ;自建函数 获取文本图元的 字串
(if( or (= type_ent "MTEXT") (= type_ent "TEXT"))
(cdr (assoc 1 (entget ent)))
)
)
;----------------------------------------------------------
; 练习实验语句
;----------------------------------------------------------
(defun lianxi()
(load_dialog "C:\\Users\\bagege\\Desktop\\aa.dcl")
(new_dialog "sample" 7)
(unload_dialog 7)
(start_dialog )
(term_dialog)
(exit)
(osnap (getpoint) "nod" )
(command "line" pause "@100,100" "" "CIRCLE" pause 10)
)
;----------------------------------------------------------
; 练习实验语句
;----------------------------------------------------------
;通过系统变量，获取图元参数
(defun mianji()
; area 获取面积
; perimeter 获取周长 dist lengthen area
; distance 存储 dist 命令计算的距离
; lastpoint 存储上一次输入的点
; limmax 存储当前空间的右上方图形界限，用世界坐标系坐标表示。
; limmin 存储当前空间的左下方图形界限，用世界坐标系坐标表示。
(command "area" "e" (car (entsel)))
(getvar "area")
(getvar "PERIMETER")
(setvar "CMDECHO" 0)
(getvar "LASTPOINT")
(getvar "limmax")
(getvar "DISTANCE")
(setq en (ssget (list '(0 . "spline,arc,line,ellipse,LWPOLYLINE")))) ;对选择集 要选择的图元 进行筛选
(setq AcadObject (vlax-get-acad-object)
AcadDocument (vla-get-ActiveDocument Acadobject)
mSpace (vla-get-ModelSpace Acaddocument)
)
(setq i 0)
(ssname en i)
(setq ent (entget (entlast)))
(command "ERASE" (cdr (assoc -1 ent)) ) ;command 命令中的被操作是图元名，而不是图元list
(command "break" pause "f" pause "@")
(setq ffn (getfiled "写出文件" "" "xls" 1))
(setq ff (open ffn "w"))
(princ "123456" ff)
(close ff)
)
;----------------------------------------------------------
; 改变图元的颜色
;----------------------------------------------------------
(defun c:c1()
(ssget)
(command "chprop" "p" "" "c" "1" "") (princ)
(command "chprop" "p" "" "lw" "0.5" "") (princ)
(command "copy" "p" "" (getpoint) (getpoint)) (princ)
)
(entget (entlast))
(setq
circle_list (list (cons 0 "CIRCLE")
(cons 10 (list 10 10 0))
(cons 40 15 )
)
)
; (list
; (cons 10 (list 10 0 0))
; (cons 11 (list 20 0 0))
; (cons 0 "LINE")
; (cons 1 "36")
; )
;;
; dimrot.TextHeight = dimrot.TextHeight * bili
; dimrot.ArrowheadSize = dimrot.ArrowheadSize * bili
; dimrot.LinearScaleFactor = dimrot.LinearScaleFactor * bili
; dimrot.ExtensionLineExtend = dimrot.ExtensionLineExtend * bili
; dimrot.ExtensionLineOffset = dimrot.ExtensionLineOffset * bili
; dimrot.TextGap = dimrot.TextGap * bili
(defun c:suofang( / sel scale i ent ent_ax th_old )
(setq sel (ssget))
(setq scale (getreal "请输入缩放比例"))
(command "scale" sel "" (getpoint) scale ) ;把选择集作为参数，应用command命令，这是一大创新
(setq i 0)
(repeat (sslength sel)
(setq ent (ssname sel i) )
(setq ent_ax (vlax-ename->vla-object ent) )
(if (= (get_ent_type ent ) "DIMENSION")
(progn
(setq th_old (vlax-get-property ent_ax 'TextHeight ))
(vlax-put-property ent_ax 'TextHeight (* th_old scale))
(setq th_old (vlax-get-property ent_ax 'ArrowheadSize ))
(vlax-put-property ent_ax 'ArrowheadSize (* th_old scale))
(setq th_old (vlax-get-property ent_ax 'LinearScaleFactor ))
(vlax-put-property ent_ax 'LinearScaleFactor (/ th_old scale))
(setq th_old (vlax-get-property ent_ax 'ExtensionLineExtend ))
(vlax-put-property ent_ax 'ExtensionLineExtend (* th_old scale))
(setq th_old (vlax-get-property ent_ax 'ExtensionLineOffset ))
(vlax-put-property ent_ax 'ExtensionLineOffset (* th_old scale))
(setq th_old (vlax-get-property ent_ax 'TextGap ))
(vlax-put-property ent_ax 'TextGap (* th_old scale))
)
)
(setq i (+ 1 i))
)
)
(defun get-ent->ax-property (ent sym / ent_ax ) ;获取图元ent--->activex对象的属性
(setq ent_ax (vlax-ename->vla-object ent))
(vlax-get-property ent_ax sym )
; (vlax-put-property ent_ax 'TextHeight (* th_old scale))
)
(defun put-ent->ax-property (ent sym value / ent_ax ) ;获取图元ent--->activex对象的属性
(setq ent_ax (vlax-ename->vla-object ent))
(vlax-put-property ent_ax sym value)
; (vlax-put-property ent_ax 'TextHeight (* th_old scale))
)
(defun dump-ent-ax-prop(ent / ent_ax)
(setq ent_ax (vlax-ename->vla-object ent))
(vlax-dump-object ent_ax t)
)
( defun test()
(dump-ent-ax-prop (entlast)) ;先查看有哪些属性
(dump-ent-ax-prop (car (entsel))) ;先查看有哪些属性
(setq aa (get-ent->ax-property (entlast) 'Area) ) ;在获取相关的属性 Thickness
(setq aa (get-ent->ax-property (car (entsel)) 'TrueColor) )
(put-ent->ax-property (entlast) 'Height 1000 ) ;修改ent--> ax对象属性值
(setq var (get-ent->ax-property (entlast) 'StartPoint) )
(get-variant-array-list var)
(put-ent->ax-property (entlast) 'StartPoint (vlax-3D-point 0 0) ) ; variant 变量也没有什么特殊之处，跟普通
(getvar "area")
(getvar "PERIMETER")
;给属性为变体数据的复制，参考以下模板
(setq pt_array (vlax-make-safearray vlax-vbDouble '( 0 . 2))) ;定义数据结构
(vlax-safearray-fill pt_array '(100 100 0)) ;定义数据结构
(setq pt_vari (vlax-make-variant pt_array )) ;包装为变体
(put-ent->ax-property (entlast) 'StartPoint pt_vari ) ;给对象属性赋值
(setq ss (ssget))
(type ss)
(get-variant-array-list (vlax-3D-point '(100 0 0)) )
(setq vb_str (vlax-make-variant 20 vlax-vbString))
(variant-value vb_str)
)
(defun get-variant-array-list(var / var_array ) ;获取图元 数组类型变体 数据
(setq var_array (variant-value var)) ;variant-value 显示variant变量的值，variant的真身
(vlax-safearray->list var_array) ;vlax-safearray->list 列出安全数组的值，得到list列表
)
(defun c:zifudizeng()
(prompt "请选择数字开头的文本")
(setq ent (car (entsel)))
;(setq type_ent (cdr (assoc 0 (entget ent))))
(setq type_ent (get_ent_type ent ))
(while ( and (/= type_ent "MTEXT") (/= type_ent "TEXT") ) ;(= 0 ascii(get_text_string(ent)))
(prompt "请选择数字开头的文本")
(setq ent (car (entsel)))
(setq type_ent (get_ent_type ent ))
)
(setq zengliang (getint "请输入递增值"))
(setq first_value (atoi ( cdr (assoc 1 (entget ent)) ) ))
(command "copy" ent "" (setq pt1(getpoint)) (setq pt2 (getpoint)))
(setq next_text (entlast))
(while (and (/= pt1 nil) (/= pt2 nil)) ;循环复制--修改值
(setq first_value ( + first_value zengliang))
(put-ent->ax-property next_text 'TextString (itoa first_value )) ;修改字串内容，实现递增
(command "copy" ent "" pt1 (setq pt2 (getpoint)) ) ;复制
(setq next_text (entlast))
)
)
(defun c:zifusum ( / text_01)
(setq prom "")
(setq text_01 (get_text))
(setq first_value (atoi ( cdr (assoc 1 (entget text_01)) ) ))
(setq text_02 (get_text))
(setq mid_value (atoi ( cdr (assoc 1 (entget text_02)) ) ))
(setq prom (strcat (cdr (assoc 1 (entget text_01))) "+" (cdr (assoc 1 (entget text_02))) ) ) ;
(while (and (/= text_01 nil) (/= text_02 nil))
(setq first_value (+ first_value mid_value))
(prompt (strcat prom "=" (itoa first_value)))
(setq text_02 (get_text))
(if (/= text_02 nil)
(progn
(setq mid_value (atoi ( cdr (assoc 1 (entget text_02)) ) ))
(setq prom (strcat prom "+" (cdr (assoc 1 (entget text_02)))) )
)
)
)
)
(defun get_text ( )
(prompt "请选择要求和的数字文本")
(setq ent (car (entsel)))
(if (= ent nil)
(setq type_ent "MTEXT")
(setq type_ent (get_ent_type ent ))
)
;(setq type_ent (cdr (assoc 0 (entget ent))))
(while ( and (/= type_ent "MTEXT") (/= type_ent "TEXT") ) ;(= 0 ascii(get_text_string(ent)))
(prompt "请选择数字开头的文本")
(setq ent (car (entsel)))
(if (= ent nil)
(setq type_ent "MTEXT")
(setq type_ent (get_ent_type ent ))
)
)
(setq ent ent)
)
(defun c:zuobiao( / pt0 x0 y0 )
(setq pt0 (getpoint "拾取坐标点"))
(setq x0 (car pt0) y0 (cadr pt0) )
(prompt (strcat (rtos x0) "," (rtos y0) ))
(setvar "cmdecho" 0)
(command "UNITS" 2 3 1 3 0 "n" )
(command "OSNAP" "non")
(command "line" pt0 (polar pt0 (* (/ 60.0 180.0) 3.14159) 10 ) "@20,0" "" )
(setvar "TEXTSIZE" 2)
(command "MTEXT" (polar pt0 (jiao2hu 75) 18 ) "@10,-2.5" (strcat "X=" (rtos x0) "\n" "Y=" (rtos y0) ) "" )
)
(defun jiao2hu(jiaodu)
(* (/ jiaodu 180.0) 3.141592)
)
(defun c:biaogao( / txt txt_str v01 v02 dist jiaodu tan biaogao )
(setq txt (get_text ))
(setq txt_str (cdr (assoc 1 (entget txt ))))
(setq v01 (zifuchazhao "Z=[0-9]*[.]?[0-9]*" txt_str))
( if (/= nil v01) (setq v02 (zifuchazhao "[0-9]*[\.][0-9]*" v01)))
(setq v02 (atof v02))
(setq dist (getdist "请输入距离或点击选择距离"))
(setq jiaodu (getreal "请输入角度如:(±10°)" ))
(setq tan (/ (sin (jiao2hu jiaodu)) (cos (jiao2hu jiaodu)) ))
(setq biaogao (+ v02 (* dist tan )) )
)
(defun c:podu( / txt01 txt02 txt01_str txt02_str v01 v02 dist atg )
(setq txt01 (get_text ))
(setq txt01_str (cdr (assoc 1 (entget txt01 ))))
(setq txt02 (get_text ))
(setq txt02_str (cdr (assoc 1 (entget txt02 ))))
(setq v01 (zifuchazhao "Z=[0-9]*[.]?[0-9]*" txt01_str))
( if (/= nil v01) (setq v01 (zifuchazhao "[0-9]*[\.][0-9]*" v01)))
(setq v02 (zifuchazhao "Z=[0-9]*[.]?[0-9]*" txt02_str))
( if (/= nil v02) (setq v02 (zifuchazhao "[0-9]*[\.][0-9]*" v02)))
(setq v01 (atof v01))
(setq v02 (atof v02))
(setq dist (getdist "请输入距离或点击选择距离"))
(if (/= dist 0)(setq tg (/ (- v02 v01) dist )))
(setq atg ( atan tg ) atg(* (/ atg 3.141592) 180.0 ) )
(print (strcat "两点间距离为" (rtos dist) ",高差为:" (rtos (- v02 v01)) ",坡度为" (rtos atg) ))
(princ)
)
(defun zifuchazhao (parttern string / regex s macth count )
;(setq parttern "[0-9]*[\.][0-9]*") (setq string "Z=303-303")
(setq regex (vlax-create-object "Vbscript.RegExp")) ;引用正则表达式控件,正则表达式 案例分析
;(vlax-dump-object regex t)
(vlax-put-property regex "IgnoreCase" 0) ;不忽略大小写
(vlax-put-property regex "Global" 1) ;匹配方式，全文字匹配
(vlax-put-property regex "Pattern" parttern)
(setq s (vlax-invoke-method regex "Execute" string ))
(setq count (vlax-get-property s 'Count))
(if (>= count 1)
(progn
;(vlax-dump-object s t)
(if (/= s nil) (setq macth (vlax-get-property s 'Item 0 )))
;(vlax-dump-object macth t)
(if (/= macth nil)(vlax-get-property macth 'Value ))
)
)
)
;----------------------------------------------------------
; 函数名：zhongdian
;----------------------------------------------------------
; 说明：
; 1、在拾取的两点之间绘制一条直线
; 2、在拾取的两点之间绘制一个圆圈
;----------------------------------------------------------
(defun c:zhongdian( / pt1 pt2 pt12 x1 x2 y1 y2)
(setq pt1 (getpoint "第一个点") )
(setq pt2 (getpoint "第二个点") )
(setq x1 (car pt1) y1 (cadr pt1) )
(setq x2 (car pt2) y2 (cadr pt2) )
(command "line" pt1 pt2 "")
(setq pt12 (list (/ (+ x1 x2) 2) (/ (+ y1 y2) 2) 0 ))
(command "CIRCLE" "mid" pt12 1)
)
;------------------------END-------------------------------
(defun c:caijian()
(prompt "请绘制要裁剪的矩形框")
(command "OSNAP" "non")
(command "RECTANG" (setq pt1 (getpoint)) (setq pt2 (getpoint)) )
(command "ERASE" (entlast) "")
(setq x1 (car pt1) y1 (cadr pt1))
(setq x2 (car pt2) y2 (cadr pt2))
(if (> x1 x2 )
(progn
(setq tmp x1)
(setq x1 x2 )
(setq x2 tmp)
)
)
(if (> y1 y2 )
(progn
(setq tmp y1)
(setq y1 y2 )
(setq y2 tmp)
)
)
(setq delta_x (- x2 x1))
(setq delta_y (- y2 y1))
;左边
(command "DELAY" 200)
(command "OSNAP" "non")
(command "line" (list x1 y1) ( list x1 y2) "" )
(setq rec (entlast))
(setq p001 (strcat (rtos (- x1 0.1)) "," ( rtos (- y1 delta_y))))
(command "DELAY" 200)
(setq p003 (strcat (rtos (- x1 0.1 delta_x)) "," (rtos (+ y2 delta_y ))) )
(command "trim" rec "" "c" p001 p003 "" "" )
;右边
(command "DELAY" 200)
(command "OSNAP" "non")
(command "line" (list x2 y1) (list x2 y2) "" )
(setq rec (entlast))
(setq p001 (strcat (rtos (+ x2 0.1 delta_x)) "," (rtos (- y1 delta_y))))
(setq p003(strcat (rtos (+ x2 0.1) ) ","(rtos (+ y2 delta_y))) )
(command "DELAY" 200)
(command "trim" rec "" "c" p001 p003 "" "")
;上边
(command "DELAY" 200)
(command "OSNAP" "non")
(command "line" (list x1 y2) ( list x2 y2) "" )
(setq rec (entlast))
(setq p001 (strcat (rtos (+ x2 delta_x)) "," ( rtos (+ y2 0.1))))
(setq p003 (strcat (rtos (- x1 delta_x)) "," (rtos (+ y2 delta_y ))) )
(command "DELAY" 200)
(command "trim" rec "" "c" p001 p003 "" "" )
;下边
(command "DELAY" 200)
(command "OSNAP" "non")
(command "line" (list x1 y1) (list x2 y1) "" )
(setq rec (entlast))
(setq p001 (strcat (rtos (+ x2 0.01 delta_x)) "," (rtos (- y1 delta_y))))
(setq p003(strcat (rtos (- x1 0.01 delta_x) ) ","(rtos (- y2 0.1))) )
(command "DELAY" 200)
(command "trim" rec "" "c" p001 p003 "" "")
(setq ss (ssget "w" (list (+ x2 0.5) (- y1 0.5)) (list (- x1 0.5) (+ y2 0.5))))
(command "OSNAP" "non")
(command "copy" ss "" (getpoint) (getpoint) )
)
(defun c:caijian2() / x1 y1 x2 y2 x00 y00 tmp ss i count coll xx yy
(prompt "请绘制要裁剪的矩形框")
(command "OSNAP" "non")
(setq rec nil)
(command "RECTANG" (setq pt1 (getpoint)) (setq pt2 (getpoint)) )
(setq rec (entlast))
(setq x1 (car pt1) y1 (cadr pt1))
(setq x2 (car pt2) y2 (cadr pt2))
(if (> x1 x2 )
(progn
(setq tmp x1)
(setq x1 x2 )
(setq x2 tmp)
)
)
(if (> y1 y2 )
(progn
(setq tmp y1)
(setq y1 y2 )
(setq y2 tmp)
)
)
(command "SELECT" "c" (list x2 y1) (list x1 y2) "" )
(setq ss (ssget "p"))
(setq count (sslength ss))
(setq i 0)
(setq coll nil)
(repeat count
(setq ent (ssname ss i))
(setq ent_table (entget ent))
(foreach xx ent_table
;(princ xx)
;(princ "\n")
(if (= (car xx) 10)
(setq coll (append coll (list (cdr xx))))
)
)
(setq i ( + 1 i))
)
(setq coll2 nil)
(foreach yy coll
(setq x00 (car yy))
(setq y00 (cadr yy))
(if (or (< (- x00 x1 -0.1) 0) (> (- x00 x2 0.1) 0) (< (- y00 y1 -0.1) 0) (> (- y00 y2 0.1) 0) )
(progn
(setq coll2 (append coll2 (list yy)))
(print (strcat (rtos (car yy)) ","(rtos (cadr yy))))
)
)
)
(setq zz nil)
(foreach zz coll2
(command "circle" zz 0.2 )
)
(command "OSNAP" "non")
(setvar "cmdecho" 0)
(command "UNITS" 2 3 1 3 0 "n" )
(setq ii 0)
(repeat (length coll2)
(setq zz ( nth ii coll2))
(princ zz)
(princ (type zz))
(polar zz (* 135 0.0174532) 0.1 )
(polar zz (* -45 0.0174532) 0.1)
(command "trim" rec "" "c" (polar zz (* -45 0.0174532) 0.1 ) (polar zz (* 135 0.0174532) 0.1 ) "" )
(setq ii (+ ii 1))
)
)
; (polar (list 0 0) 3.14 10)
; (setq delta_x (- x2 x1)) 16.4894,4.57969
; (setq delta_y (- y2 y1))
;
(setq ss (ssget "w" (list (+ x2 0.5) (- y1 0.5)) (list (- x1 0.5) (+ y2 0.5))))
(command "OSNAP" "non")
(command "copy" ss "" (getpoint) (getpoint) )
)
3.73642,3.57933
(print coll2)
(command "SELECT" )
(setq ss (ssget "p"))
(sslength ss)
(length coll2)
;(setq p1 (getpoint))
;(setq p2 (getpoint))
;(command "SELECT" p1 p2 )
;(dump-ent-ax-prop (entlast))
;(setq var (get-ent->ax-property (entlast) 'Coordinates))
;(get-variant-array-list var)
; (entget (car (entsel)))
;(setq val01 (zifuchazhao "Z=[0-9]*[.]?[0-9]*" "X=101.101,Y=202.202,Z=303.303"))
;(zifuchazhao "[0-9]*[\.][0-9]*" "Z=303.303")
; 正则表达式 对象 属性 方法
; IRegExp2: nil
;特性值:
; Global = -1
; IgnoreCase = -1
; Multiline = 0
; Pattern = ""
;支持的方法:
; Execute (1)
; Replace (2)
; Test (1)
(print "zifusum 命令/函数提供字符串数字 相加 功能")
(print "zifudizeng 命令/函数提供字符串数字 递增功能")
(print "suofang 命令/函数提供图形+标注 同步缩放 功能")
(print "zifulianjie 命令/函数提供 单行转多行 连接 功能")
(print "hang 命令/函数提供 绘制 矩形巷道断面+支护 功能")
(print "biaogao 命令/函数提供 由一个点计算另外一个点标高 功能")
(print "podu 命令/函数提供 计算两个点之间的坡度 功能")
(print "zuobiao 命令/函数提供 标注点的x，y坐标 功能")
(print "zhongdian 命令/函数提供 绘制两点的中点 功能")
(princ)
扫一扫
4797
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
