Hello,大家好，baguiming的第一个博文（AutoCad lisp插件 ）

大家好，欢迎来到IT知识分享网。

;---------------------------------------------------------- ; 函数名：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 "" 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.) ) (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.) 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.0) 0.1 ) (polar zz (* -45 0.0) 0.1) (command "trim" rec "" "c" (polar zz (* -45 0.0) 0.1 ) (polar zz (* 135 0.0) 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)