设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 行业篇 › AutoCAD与GIS测绘 › CASS宗地四至属性批量填入扩展属性
返回列表 发新帖
查看: 3115|回复: 5

CASS宗地四至属性批量填入扩展属性

[复制链接]
树櫴希德
发表于 2016-9-29 22:49:21 | 显示全部楼层 |阅读模式
  2. ;|;;===========================================================================
  3.       通用函数                                                                ;
  4. 功能：求两个线条对象的交点                                                    ;
  5.       适用对象: Line、Circle、Arc、Ellipse、Polyline、                        ;
  6.       LWPolyline、3dPolyline、Spline                                          ;
  7. 参数：OBJ1   ----对象1                                                        ;
  8.       OBJ2   ----对象2                                                        ;
  9.       Extend ----延伸选项                                                     ;
  10.                  0  acExtendNone                                              ;
  11.                  1  acExtendThisEntity                                        ;
  12.                  2  acExtendOtherEntity                                       ;
  13.                  3  acExtendBoth                                              ;
  14.       ZZZ    ----输出选项                                                     ;
  15.                  "=0"  Z值取0                                                 ;
  16.                  "F1"  取第一个对象上的点                                     ;
  17.                  "F2"  取第二个对象上的点                                     ;
  18.                  "MAX" 取Z值大者                                              ;
  19.                  "MIN" 取Z值小者                                              ;
  20.       Fuzz   ----允许偏差值                                                   ;
  21. 返回：若成功，返回点位表；否则返回nil
  22. 日期：zml84 于2007-11-05
  23. ;;|;
  24. (vl-load-com)
  25. (defun ZL-GETINTERS (OBJ1   OBJ2   EXTEND ZZZ  FUZZ /      ENT1
  26.        ENT2   PT10   PT11   PT20  PT21 OBJ11  OBJ22
  27.        ARRAY  LST    LST_PT I  PT PT1    PT2
  28.        Z1     Z2
  29.       )
  30.     ;;0、对参数的格式化处理
  31.     (if (and (= (type EXTEND) 'INT)
  32.       (<= 0 EXTEND 3)
  33. )
  34. ()
  35. (setq EXTEND 0)
  36.     )
  37.     (setq ZZZ (strcase ZZZ))
  38.     ;;======================
  39.     ;;1、获取交点集合>>>>>>>
  40.     (if (and (= (vla-get-objectname OBJ1) "AcDbLine")
  41.       (= (vla-get-objectname OBJ2) "AcDbLine")
  42. )
  43. ;;对直线对象(line) 特别处理
  44. (progn
  45.      (setq ENT1 (entget (vlax-vla-object->ename OBJ1))
  46.     ENT2 (entget (vlax-vla-object->ename OBJ2))
  47.      )
  48.      (setq PT10 (assoc 10 ENT1)
  49.     PT11 (assoc 11 ENT1)
  50.     PT20 (assoc 10 ENT2)
  51.     PT21 (assoc 11 ENT2)
  52.      )
  53.      ;;去除Z坐标
  54.      (setq PT10 (list (cadr PT10) (caddr PT10))
  55.     PT11 (list (cadr PT11) (caddr PT11))
  56.     PT20 (list (cadr PT20) (caddr PT20))
  57.     PT21 (list (cadr PT21) (caddr PT21))
  58.      )
  59.      (setq LST (inters PT10 PT11 PT20 PT21 t))
  60.      (if LST
  61.   (setq LST (append LST '(0)))
  62.      )
  63. )
  64. (progn
  65.      ;;=====================
  66.      ;;复制实体
  67.      (setq OBJ11 (vla-copy OBJ1)
  68.     OBJ22 (vla-copy OBJ2)
  69.      )
  70.      ;;向xy平面投影，将Z坐标改为0
  71.      (TOXY OBJ11)
  72.      (TOXY OBJ22)
  73.      ;;获取交点集合
  74.      (setq ARRAY (vla-intersectwith OBJ11 OBJ22 EXTEND))
  75.      ;;删除复制后的对象
  76.      (vla-delete OBJ11)
  77.      (vla-delete OBJ22)
  78.      ;;由数组转换为表
  79.      (if (and ARRAY
  80.        (> (vlax-safearray-get-u-bound
  81.        (vlax-variant-value ARRAY)
  82.        1
  83.    )
  84.    1
  85.        )
  86.   )
  87.   (progn
  88.       (setq LST (vlax-safearray->list
  89.       (vlax-variant-value ARRAY)
  90.          )
  91.       )
  92.   )
  93.      )
  94. )
  95.     )
  96.     ;;======================
  97.     ;;2、分析整理>>>>>>>
  98.     (setq LST_PT '())
  99.     (if LST
  100. (progn
  101.      (setq I 0)
  102.      (repeat (/ (length LST) 3)
  103.   ;;2.1 获取当前点位
  104.   (setq PT (list (nth I LST)
  105.           (nth (+ 1 I) LST)
  106.           (nth (+ 2 I) LST)
  107.     )
  108.   )
  109.   ;;2.2 获取对象上对应点位
  110.   (setq PT1 (vlax-curve-getclosestpointtoprojection
  111.          OBJ1
  112.          PT
  113.          '(0 0 1)
  114.      )
  115.         PT2 (vlax-curve-getclosestpointtoprojection
  116.          OBJ2
  117.          PT
  118.          '(0 0 1)
  119.      )
  120.   )
  121.   (setq Z1 (caddr PT1)
  122.         Z2 (caddr PT2)
  123.   )

  125.   ;;2.3 效验偏差值
  126.   ;;就是说：过滤:参数中有偏差值选项，却不满足要求的点位
  127.   (if (and FUZZ
  128.     (or (= (type FUZZ) 'REAL)
  129.         (= (type FUZZ) 'INT)
  130.     )
  131.     (not (equal Z1 Z2 FUZZ))
  132.       )
  133.       ;; 空处理
  134.       ()
  135.       ;;2.4 对输出选项的处理
  136.       (progn
  137.    (cond
  138.        ((= ZZZ "F1")
  139.         (setq PT PT1)
  140.        )
  141.        ((= ZZZ "F2")
  142.         (setq PT PT2)
  143.        )
  144.        ((= ZZZ "MAX")
  145.         (if (> Z1 Z2)
  146.      (setq PT PT1)
  147.      (setq PT PT2)
  148.         )
  149.        )
  150.        ((= ZZZ "MIN")
  151.         (if (< Z1 Z2)
  152.      (setq PT PT1)
  153.      (setq PT PT2)
  154.         )
  155.        )
  156.        (t
  157.         (setq PT PT)
  158.        )
  159.    ) ;_结束cond
  160.    (if (member PT LST_PT)
  161.        ()
  162.        (setq LST_PT (cons PT LST_PT))
  163.    )
  164.       ) ;_结束progn
  165.   ) ;_结束if
  166.   (setq I (+ I 3))
  167.      ) ;_结束repeat
  168. ) ;_结束progn
  169.     ) ;_结束if
  170.     ;;3、返回结果>>>>>
  171.     LST_PT
  172. ) ;_结束defun
  173. ;;;============================================================
  174. ;;;功能：曲线实体上每个控制点的z坐标值置为0.0                  
  175. (defun TOXY (OBJ / NAME PT1 TP2)
  176.     ;;取得实体的类型名称
  177.     (setq NAME (vla-get-objectname OBJ))
  178.     (cond
  179. ;;类型1
  180. ;;直线(line)
  181. ((= NAME "AcDbLine")
  182.   ;;取得直线的起终点坐标
  183.   (setq PT1 (vlax-variant-value (vla-get-startpoint OBJ))
  184.         PT2 (vlax-variant-value (vla-get-endpoint OBJ))
  185.   )
  186.   ;;改变z值为0.0
  187.   (vlax-safearray-put-element PT1 2 0.0)
  188.   (vlax-safearray-put-element PT2 2 0.0)
  189.   (vla-put-startpoint OBJ PT1)
  190.   (vla-put-endpoint OBJ PT2)
  191. )
  192. ;;类型2
  193. ;;圆(circle)
  194. ;;圆弧(arc)
  195. ;;椭圆及椭圆弧(ellipse)
  196. ((or (= NAME "AcDbCircle")
  197.       (= NAME "AcDbArc")
  198.       (= NAME "AcDbEllipse")
  199.   )
  200.   ;;取得中心点座标
  201.   (setq PT1 (vlax-variant-value (vla-get-center OBJ)))
  202.   ;;改变中心点座标z值为0.0
  203.   (vlax-safearray-put-element PT1 2 0.0)
  204.   (vla-put-center OBJ PT1)
  205. )
  206. ;;类型3
  207. ;;多段线(polyline、lwpolyline)
  208. ;;拟合的2维多段线(polyline、lwpolyline)
  209. ((or (= NAME "AcDbPolyline")
  210.       (= NAME "AcDb2dPolyline")
  211.   )
  212.   ;;改变标高值为0.0
  213.   (vla-put-elevation OBJ 0.0)
  214. )
  215. ;;类型4
  216. ;;三维多段线(3dpolyline)  
  217. ((= NAME "AcDb3dPolyline")
  218.   ;;取得3维多段线的控制点
  219.   (setq PT1 (vlax-variant-value (vla-get-coordinates OBJ))
  220.         I   0
  221.   )
  222.   (repeat (/ (length (vlax-safearray->list PT1)) 3)
  223.       (vlax-safearray-put-element PT1 (+ I 2) 0.0)
  224.       (setq I (+ I 3))
  225.   )
  226.   (vla-put-coordinates OBJ PT1)
  227. )
  228. ;;类型5
  229. ;;样条曲线(Spline)
  230. ((= NAME "AcDbSpline")
  231.   ;;取得样条曲线的拟合点
  232.   ;;改变每个拟合点的z值为0.0
  233.   (setq PT1 (vlax-variant-value (vla-get-fitpoints OBJ))
  234.         I   0
  235.   )
  236.   (repeat (vla-get-numberoffitpoints OBJ)
  237.       (vlax-safearray-put-element PT1 (+ I 2) 0.0)
  238.       (setq I (+ I 3))
  239.   )
  240.   (vla-put-fitpoints OBJ PT1)
  241.   ;;取得样条曲线的控制点
  242.   ;;改变每个控制点的z值为0.0  
  243.   (setq
  244.       PT2 (vlax-variant-value (vla-get-controlpoints OBJ))
  245.       I  0
  246.   )
  247.   (repeat (vla-get-numberofcontrolpoints OBJ)
  248.       (vlax-safearray-put-element PT2 (+ I 2) 0.0)
  249.       (setq I (+ I 3))
  250.   )
  251.   (vla-put-controlpoints OBJ PT2)
  252. )
  253. (t NIL)
  254.     )
  255. ) ;_结束defun
  256. ;(setq ppzzxx (ZL-GETINTERS (vlax-ename->vla-object(car (entsel) ) ) (vlax-ename->vla-object(car (entsel) ) ) 0 "f2" nil)   )

  258. (defun plinexy(e / p i);;支持lwpolyline和polyline
  259.   (setq i -1)
  260.   (mapcar(function(lambda(x)(list(car x)(cadr x))))
  261.    (repeat(fix(1+(vlax-curve-getEndParam e)))
  262.        (setq i(1+ i)p(cons(vlax-curve-getPointAtParam e i)p))))
  263.   (reverse(if(equal(car p)(last p))(cdr p)p)))
  264. (defun poinpl(pt p)(equal(abs(apply'+(mapcar'(lambda(x y)(rem(-(angle x p)(angle y p))pi))pt(cons(last pt)pt))))pi 1e-8))
  265. (defun cenpl(e / p o a b c d l)
  266.   (setq pl(plinexy e)
  267.         p(mapcar'(lambda(x)(/(apply'+(mapcar x pl))(length pl)))'(car cadr))
  268.   o(vlax-curve-getClosestPointTo e p)
  269.   a(poinpl pl p)d(distance p o)b(if a(angle o p)(angle p o))
  270.   q(polar(if a p o)b d))
  271.   (while(equal(vlax-curve-getClosestPointTo e q)o 1e-5)
  272.     (setq q(polar q b d)))
  273.   (mapcar'*'(0.5 0.5)(mapcar'+(vlax-curve-getClosestPointTo e q)o)))

  275. ;(entmake (list '(0 . "point") (cons 10 (cenpl (car(entsel)))) ) )
  276. ;多边形相对中心

  278. ;;;;;;;;;;;;
  279. (defun qlr (e / )
  280.   (cdr(nth 3(car(cdr(assoc  -3 (entget e '("*")))))))
  281.       )
  282. ;;;;;;;;;;;;;;;;;;;
  283. (defun mid (p1 p2 /  )
  284.   (mapcar  '(lambda (x y )(* 0.5 (+ x y))) p1 p2 )
  285.   )
  286. ;;;;;;;;;;;;;;;;;;;
  287. ;选择集与对象名表互转
  288. (defun cx-ss2en
  289.   (ss / enlst)
  290.   (cond
  291.     ((= (type ss) 'PICKSET)
  292.       (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))
  293.     )
  294.     ((= (type ss) 'LIST)
  295.       (setq enlst (ssadd))
  296.       (last (mapcar '(lambda (x) (ssadd x enlst)) ss))
  297.     )
  298.     ((='ename(type ss))
  299.       (ssadd ss)
  300.     )
  301.   )
  302. )
  303. ;;;;;;;;;;;;;;;;;;;;;;;;







  311. (defun c:sizhi ( / pp i lst lsta ent  ppp pppp ang)
  312. (regapp "DONGZHI")
  313.   (regapp "XIZHI")
  314.   (regapp "NANZHI")
  315.   (regapp "BEIZHI")
  316. (setq i 0)
  317.   (setq lst (ssget "x"'( (0 . "*line") (8 . "jzd")) ) )
  318. (repeat (sslength lst)
  319.   (setq ent (ssname lst i))
  320.   (setq lsta (ssget "x"'( (0 . "*line")(8 . "jzd") ) ) )
  321.   (foreach x (cx-ss2en lsta)
  322.   ;;;;;
  323.    
  324. (if (and  (/= (equal ent x) t)
  325.       (setq pp(ZL-GETINTERS (vlax-ename->vla-object ent ) (vlax-ename->vla-object x ) 0 "f2" nil))
  326.     (>= (length pp) 2)
  327.     (setq ppp(cenpl ent))  (setq pppp(cenpl x))  (setq ang (angle ppp pppp))
  328.       )
  329.   (progn  (cond  ( (or(and (>= ang (* 1.75 pi)) (<= ang (* 2.00 pi)) ) (and (>= ang (* 0 pi)) (<= ang (* 0.25 pi)) ))   (entmod(subst (append (assoc  -3 (entget ent '("*")) ) (list (list "DONGZHI" (cons 1000 (qlr x)))) ) (assoc  -3 (entget ent '("*")) )  (entget ent '("*"))  ) )  )

  331.      

  333.      ( (and (>= ang (* 1.25 pi)) (<= ang (* 1.75 pi)) ) (entmod(subst (append (assoc  -3 (entget ent '("*")) ) (list (list "NANZHI" (cons 1000 (qlr x)))) ) (assoc  -3 (entget ent '("*")) )  (entget ent '("*"))  ) )  )

  335.      ((and (>= ang (* 0.75 pi)) (<= ang (* 1.25 pi)) )  (entmod(subst (append (assoc  -3 (entget ent '("*")) ) (list (list "XIZHI" (cons 1000 (qlr x)))) ) (assoc  -3 (entget ent '("*")) )  (entget ent '("*"))  ) )  )

  337.      ((and (>= ang (* 0.25 pi)) (<= ang (* 0.75 pi)) ) (entmod(subst (append (assoc  -3 (entget ent '("*")) ) (list (list "BEIZHI" (cons 1000 (qlr x)))) ) (assoc  -3 (entget ent '("*")) )  (entget ent '("*"))  ) )  )
  338.      )
  339.     )
  340.   )
  341.     ;;;;;;;;((* 0.75 pi)<=(angle ppp pppp)<=(* 1.25 pi) )
  342. )
  343.   
  344. (setq i (+ i 1))
  345.   )



  349.       )


通用

相关帖子
回复

使用道具 举报

树櫴希德
 楼主| 发表于 2016-10-1 10:46:43 | 显示全部楼层
本帖最后由 树櫴希德 于 2016-10-1 16:50 编辑
  2. <div class="blockcode"><blockquote>(defun offsetpt(pt d flag / m n pi2 d1 p1 p0 p q0 q2 q22 q1 q pt1 pt2);|falg 0闭合点表，1不闭合它;d<0向内>0向外(假定它有内外)
  3. pt内少于2个点坐标时不处理，直接返回原表，两个点时会根据D的正负而偏移方向不同|;
  4.   (defun PlDir(p / n m p1 p2 p3 o a a1 a2)
  5.     (defun PoInPl(pt p / n i va ang);;该过程由 StEf  44604813提供，本人只是把输出由原来的t,nil改为了-1,0,1
  6.       (setq n(length pt)
  7.       pt(append pt(list(car pt)))i 0 ang 0)
  8.       (while(< i n)
  9.   (setq va(-(angle p(nth i pt))(angle p(nth(1+ i)pt))))
  10.   (if (<(abs(-(abs va)pi))0.000001)(setq ang 2 i n)
  11.     (progn(cond((> va pi)(setq va (- va pi)))
  12.          ((< va (* -1 pi))(setq va (+ va pi))))
  13.       (setq ang(+ ang va)i(1+ i)))))
  14.       (if(= ang 2)0
  15.   (if(<(abs(-(abs ang) pi))0.000001)1 -1))
  16.       );defun
  17.     (setq n(length p)pi2(* pi 2)m 2 p1(nth 0 p)p2(nth 1 p))
  18.     (while(< m n)
  19.       (setq p3(nth m p)
  20.       o(list(/(+(+(car p1)(car p2))(car p3))3)(/(+(+(cadr p1)(cadr p2))(cadr p3))3))
  21.       m(if(<(PoInPl p o)1)n(1+ m))))
  22.     (setq a(angle o p1) a1(-(angle o p2)a)
  23.     a1(if(< a1 0)(+ a1 pi2)a1)
  24.     a2(-(angle o p3)a)
  25.     a2(if(< a2 0)(+ a2 pi2)a2)
  26.     m(if(> a1 a2)t))
  27.     );defun
  28.   (setq m(length pt)
  29.   fx(if(> m 2)(PlDir pt)t) pt2(if fx (reverse pt)pt) n
  30.    flag d1(abs d)
  31.   pi15(*(if(> d 0)1 -1)(* pi 1.5)))
  32.   (while(< n(- m flag))
  33.     (cond((< m 2)(setq pt1 pt2))
  34.    ((>= m 2)(setq p(nth n pt2)
  35.       p0(if(<(1- n)0)(last pt2)(nth(1- n)pt2))
  36.       p1(if(=(1+ n)m)(car pt2)(nth(1+ n)pt2))
  37.       n(1+ n)
  38.       ang1(+(angle p0 p)pi15)
  39.       ang2(+(angle p p1)pi15))
  40.     (setq q0(polar p0 ang1 d1)
  41.     q2(polar p ang1 d1)
  42.     q22(polar p ang2 d1)
  43.     q1(polar p1 ang2 d1)
  44.     q(inters q0 q2 q22 q1 nil))))
  45.     (if(= m 2)(setq pt1(list q0 q2))
  46.       (progn (if(=(* flag n)2) (setq pt1(append pt1(list q0))))
  47.   (setq pt1(append pt1(list q)))
  48.   (if(=(* flag n)(- m flag))
  49.     (setq pt1(append pt1(list q1)))))
  50.       )
  51.     )
  52.   (if fx(reverse pt1)pt1)
  53.   )
  54. ;(setq ppzzxx (ZL-GETINTERS (vlax-ename->vla-object(car (entsel) ) ) (vlax-ename->vla-object(car (entsel) ) ) 0 "f2" nil)   )

  56. (defun plinexy(e / a q m p);;;LWPolyline,POLYLINE顶点,去掉完全重合点
  57.     (setq a(vlax-ename->vla-object e)
  58.   q(vlax-safearray->list(vlax-variant-value(vla-get-Coordinates a)))
  59.     m(vla-get-objectname a)a 0
  60.     m(if(= m"AcDb3dPolyline")3 2))
  61.     (repeat(/(length q)m)
  62.       (cond((= m 2)(setq p1(list(nth a q)(nth(+ a 1)q))))
  63.      ((= m 3)(setq p1(list(nth a q)(nth(+ a 1)q)(nth(+ a 2)q)))))
  64.       (setq p(if (member p1 p)p (append p(list p1)))
  65.       a(+ a m)))
  66.     p)
  67. (defun poinpla(pt p)(equal(abs(apply'+(mapcar'(lambda(x y)(rem(-(angle x p)(angle y p))pi))pt(cons(last pt)pt))))pi 1e-8))
  68. (defun cenpl(e / p o a b c d l)
  69.   (setq pl(plinexy e)
  70.         p(mapcar'(lambda(x)(/(apply'+(mapcar x pl))(length pl)))'(car cadr))
  71.   o(vlax-curve-getClosestPointTo e p)
  72.   a(poinpla pl p)d(distance p o)b(if a(angle o p)(angle p o))
  73.   q(polar(if a p o)b d))
  74.   (while(equal(vlax-curve-getClosestPointTo e q)o 1e-5)
  75.     (setq q(polar q b d)))
  76.   (mapcar'*'(0.5 0.5)(mapcar'+(vlax-curve-getClosestPointTo e q)o)))

  78. ;(entmake (list '(0 . "point") (cons 10 (cenpl (car(entsel)))) ) )
  79. ;多边形相对中心

  81. ;;;;;;;;;;;;
  82. (defun qlr (e / )
  83.   (cdr(nth 3(car(cdr(assoc  -3 (entget e '("*")))))))
  84.       )
  85. ;;;;;;;;;;;;;;;;;;;
  86. (defun mid (p1 p2 /  )
  87.   (mapcar  '(lambda (x y )(* 0.5 (+ x y))) p1 p2 )
  88.   )
  89. ;;;;;;;;;;;;;;;;;;;
  90. ;选择集与对象名表互转
  91. (defun cx-ss2en
  92.   (ss / enlst)
  93.   (cond
  94.     ((= (type ss) 'PICKSET)
  95.       (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))
  96.     )
  97.     ((= (type ss) 'LIST)
  98.       (setq enlst (ssadd))
  99.       (last (mapcar '(lambda (x) (ssadd x enlst)) ss))
  100.     )
  101.     ((='ename(type ss))
  102.       (ssadd ss)
  103.     )
  104.   )
  105. )
  106. ;;;;;;;;;;;;;;;;;;;;;;;;




  111. ;(reverse lst)


  114. (defun c:sizhi ( / pp i lst lsta ent  ppp pppp ang d pt11)
  115. (regapp "DONGZHI")
  116.   (regapp "XIZHI")
  117.   (regapp "NANZHI")
  118.   (regapp "BEIZHI")
  119.   (setq d(getreal"\n查找偏移距离<0向内,>0向外:"))
  120. (setq i 0)
  121.   (setq lst (ssget "x"'( (0 . "lwpolyline") (8 . "jzd")) ) )
  122. (repeat (sslength lst)
  123.   (setq ent (ssname lst i))
  124.   (setq pt1(offsetpt (plinexy ent) d 0))
  125.   (setq lsta (ssget "cp" pt1 '( (0 . "lwpolyline")(8 . "jzd") ) ) )
  126.   (if (= lsta nil)   (progn (setq pt1(offsetpt (reverse(plinexy ent)) d 0)) (setq lsta (ssget "cp" pt1 '( (0 . "lwpolyline")(8 . "jzd") ) ) ) ) )
  127.   (foreach x (cx-ss2en lsta)
  128.   ;;;;;
  129.    
  130. (if (and  (/= (equal ent x) t)
  131.       ;(setq pp(ZL-GETINTERS (vlax-ename->vla-object ent ) (vlax-ename->vla-object x ) 0 "f2" nil))
  132.     ;(>= (length pp) 2)
  133.     (setq ppp(cenpl ent))  (setq pppp(cenpl x))  (setq ang (angle ppp pppp))
  134.       )
  135.   (progn  (cond  ( (or(and (>= ang (* 1.75 pi)) (<= ang (* 2.00 pi)) ) (and (>= ang (* 0 pi)) (<= ang (* 0.25 pi)) ))   (entmod(subst (append (assoc  -3 (entget ent '("*")) ) (list (list "DONGZHI" (cons 1000 (qlr x)))) ) (assoc  -3 (entget ent '("*")) )  (entget ent '("*"))  ) )  )

  137.      

  139.      ( (and (>= ang (* 1.25 pi)) (<= ang (* 1.75 pi)) ) (entmod(subst (append (assoc  -3 (entget ent '("*")) ) (list (list "NANZHI" (cons 1000 (qlr x)))) ) (assoc  -3 (entget ent '("*")) )  (entget ent '("*"))  ) )  )

  141.      ((and (>= ang (* 0.75 pi)) (<= ang (* 1.25 pi)) )  (entmod(subst (append (assoc  -3 (entget ent '("*")) ) (list (list "XIZHI" (cons 1000 (qlr x)))) ) (assoc  -3 (entget ent '("*")) )  (entget ent '("*"))  ) )  )

  143.      ((and (>= ang (* 0.25 pi)) (<= ang (* 0.75 pi)) ) (entmod(subst (append (assoc  -3 (entget ent '("*")) ) (list (list "BEIZHI" (cons 1000 (qlr x)))) ) (assoc  -3 (entget ent '("*")) )  (entget ent '("*"))  ) )  )
  144.      )
  145.     )
  146.   )
  147.     ;;;;;;;;((* 0.75 pi)<=(angle ppp pppp)<=(* 1.25 pi) )
  148. )
  149.   
  150. (setq i (+ i 1))
  151.   )



  155.       )

回复 支持 反对

使用道具 举报

树櫴希德
 楼主| 发表于 2016-10-1 16:58:11 | 显示全部楼层
  2. (vl-load-com)
  3. (initget 2)
  4.   ;(setq getds (getdist "\n输入偏移距离<可直接量取>:"))
  5.   (setq d(getreal"\n查找偏移距离<0向内,>0向外:"))
  6. (setq i 0)
  7.   (setq lst (ssget "x"'( (0 . "lwpolyline") (8 . "jzd")) ) )
  8. (repeat (sslength lst)
  9.   (setq ent (ssname lst i))
  10.   (vla-offset (vlax-ename->vla-object ent) d)
  11. (setq lsta (ssget "cp" (plinexy (entlast)) '( (0 . "lwpolyline") (8 . "jzd")) ) )
  12.   (if (= lsta nil)(progn (entdel (entlast)) (vla-offset (vlax-ename->vla-object ent) (* -1 d))
  13. (setq lsta (ssget "cp" (plinexy (entlast)) '( (0 . "lwpolyline") (8 . "jzd")) ) ) ))
  14. (entdel (entlast))
回复 支持 反对

使用道具 举报

wkq004
发表于 2016-10-4 21:46:17 | 显示全部楼层
没注释的程序看着累..我的也没注释,过段时间自己都看不懂.
回复 支持 反对

使用道具 举报

jxy308
发表于 2016-10-30 21:51:01 来自手机 | 显示全部楼层
同意楼上的说法
回复 支持 反对

使用道具 举报

yuan4399
发表于 2018-9-18 22:40:51 | 显示全部楼层

一点都看不懂
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2024-11-6 03:31 , Processed in 0.174440 second(s), 29 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表