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

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 偏移联动----另一问题请教
返回列表 发新帖
查看: 1596|回复: 3

[已解答] 偏移联动----另一问题请教

[复制链接]
chang1622
发表于 2014-5-14 09:48:45 | 显示全部楼层 |阅读模式
偏移联动----另一问题请教
这种偏移联动能否实现？请教edata和高手们

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x

点评

xyp1964
目的不清  发表于 2014-5-14 19:43
回复

使用道具 举报

edata
发表于 2014-5-15 12:08:28 | 显示全部楼层
所有直线是同图层同颜色的好办，暂时没搞懂圆弧偏移的取舍。所以不支持圆弧。
其是就是将直线合并成PL操作。另外修复一个bug。
因为采用command 的pedit命令可能会出现版本不同，命令失效，请根据自己pedit命令自行修改。
  1. ;;;LWPOLYLINE线单边移动函数
  2. ;;;by edata @mjtd
  3. ;;;2014-5-15
  4. (defun sk_offset_single(/ ANG1 ANG2 CPT ENT ENT1 INDEXMAX INDEXMAX1+ INDEXMAX2 INDEXMIN INDEXMIN1 INDEXMIN1- IPT1 IPT1_A IPT1_B
  5.             IPT2 IPT2_A IPT2_B IS_CLOSED NEW1 NEW2 NEW3 NEW4 OBJ  OF_DIST1 P0 P1 P11 P11BULGE P11MIN- P2 P21
  6.             P21BULGE P21MAX+ PPX PX SK_COORDS VB_NEW1 VB_NEW2 VB_NEW3 VB_NEW4)
  7.   ;;;组码值提取(sk_dxf 图元名 组码)
  8. (defun sk_dxf(en code)
  9.     (if(and(=(type en) 'ENAME)(= (type code) 'INT))
  10.       (cdr(assoc code (entget en))))
  11.   )
  12. ;;;计算cp到p1 p2的垂足点
  13. (defun PerToLine  (cp p1 p2 / norm)
  14.   (setq        norm (mapcar '- p2 p1)
  15.         p1   (trans p1 0 norm)
  16.         cp   (trans cp 0 norm)
  17.         )
  18.   (trans (list (car p1) (cadr p1) (caddr cp)) norm 0)
  19.   )
  20.   (defun *error*_New (msg)
  21.   (and *error*_Old(setq *error* *error*_Old))
  22.   (if (wcmatch (strcase msg t) "*break,*cancel*,*exit*,*取消*")
  23.     (if        (= (getvar "LOCALE") "CHS")
  24.       (princ "\n用户按了<Esc>强制退出")
  25.       (princ "\nYou cancelled The operation!")
  26.     )
  27.     (princ (strcat "\n" msg))
  28.   )
  29.   (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
  30.   (setvar "cmdecho" 0)
  31.   (command "undo" "e")
  32.   (setvar "cmdecho" 1)
  33.   (princ)
  34. )
  35.   (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
  36.   (setq *error*_Old *error*)                ;保存出错处理函数
  37.   (setq *error* *error*_New)
  38.   ;;;;;主程序
  39.   (vl-load-com)
  40.   (if(setq of_dist1(getdist (strcat "\n输入偏移距离["(if of_dist (rtos of_dist) "0")"]:")))(setq of_dist of_dist1))
  41.   (while(and of_dist (/= of_dist 0)
  42.           (and(setq ent1(entsel "\n选择线:"))(or (= (sk_dxf (car ent1) 0 ) "LWPOLYLINE")
  43.                                                  (= (sk_dxf (car ent1) 0 ) "LINE")))
  44.           (car (list t(redraw (car ent1) 3)))
  45.     (setq p0(getpoint "\n指定偏移方向:")))
  46.     (if (and ent1 p0)
  47.     (progn
  48.       (if (= (sk_dxf (car ent1) 0 ) "LWPOLYLINE")(setq sk_lw_line nil)(setq sk_lw_line t))
  49.       (if sk_lw_line
  50.         (progn
  51.           (setvar "cmdecho" 0)
  52.           (setq ent1pt(cadr ent1))
  53.           (vl-cmdf "_.pedit" (car ent1) "j" "all" "" "")
  54.           (setq ent1(list (entlast) ent1pt))
  55.           )
  56.         )
  57.       (setq ent(car ent1)
  58.             px(cadr ent1)
  59.             obj(vlax-ename->vla-object (car ent1)))
  60.       (setq is_closed (sk_dxf ent 70)
  61.             sk_Coords (sk_dxf ent 90))      
  62.       (setq ppx(vlax-curve-getClosestPointTo obj px)
  63.             indexmin1(fix (vlax-curve-getParamAtPoint obj ppx))
  64.             indexmax2(1+ indexmin1)
  65.             indexmin(min indexmin1 indexmax2)
  66.             indexmax(max indexmin1 indexmax2)
  67.             )
  68.       
  69.       (if(and (= indexmin (1- sk_Coords))(= indexmax sk_Coords))
  70.         (setq indexmin1- (1- indexmin )              
  71.               indexmax 0              
  72.               indexmax1+ 1)
  73.         (if (and (= indexmin 0)(/= indexmax (1- sk_Coords)))
  74.           (setq indexmin1- (1- sk_Coords)
  75.                 indexmax1+ (1+ indexmax ))
  76.           (if (= indexmax (1- sk_Coords))
  77.             (setq indexmax1+  0 indexmin1- (1- indexmin))
  78.             (setq indexmin1- (1- indexmin)
  79.                   indexmax1+ (1+ indexmax )))))
  80.       (setq p1(vlax-safearray->list(vlax-variant-value(vla-get-Coordinate obj indexmin)))
  81.             p2(vlax-safearray->list(vlax-variant-value(vla-get-Coordinate obj indexmax)))
  82.             p11(vlax-safearray->list(vlax-variant-value(vla-get-Coordinate obj indexmin1-)))
  83.             p21(vlax-safearray->list(vlax-variant-value(vla-get-Coordinate obj indexmax1+)))
  84.             p11bulge(vla-getbulge obj indexmin1-)
  85.             p21bulge(vla-getbulge obj indexmax))
  86.       (if(not(equal p21bulge 0.0 1e-8))(setq p21max+(vlax-safearray->list(vlax-variant-value(vla-get-Coordinate obj (if (= (1- sk_Coords)indexmax1+)0 (1+ indexmax1+)))))))
  87.       (if(not(equal p11bulge 0.0 1e-8))
  88.         (progn         
  89.         (setq p11min-(vlax-safearray->list(vlax-variant-value(vla-get-Coordinate obj (if (zerop indexmin1-) (1- sk_Coords)(1- indexmin1-))))))        
  90.         )
  91.         )      
  92.       (setq cpt (PerToLine p0 p1 p2)
  93.             ang1(angle cpt p0)
  94.             ang2(angle p1 p2)
  95.             new1(polar p1 ang1 of_dist)
  96.             new2(polar p2 ang1 of_dist)
  97.             ipt1(inters new1 new2 p1 p11 nil)
  98.             ipt2(inters new1 new2 p2 p21 nil)   
  99.             )
  100.       (if(and (= is_closed 0) (= indexmin 0) )
  101.         (setq ipt1 new1))
  102.       (if(and (= is_closed 0) (= indexmax (1- sk_Coords)) )
  103.         (setq ipt2 new2))      
  104.       (if p11min- (setq ipt1_a(inters p1 p2 p11 p11min- nil)
  105.                         ipt1_b(inters new1 new2 p11 p11min- nil)
  106.                         ipt1(polar ipt1_b (angle p1 p2)(distance ipt1_a p1))
  107.                         new3(polar ipt1_b (angle p11 p11min-)(distance ipt1_a p11))                        
  108.                         vb_new3(vlax-safearray-fill(vlax-make-safearray vlax-vbdouble '(0 . 1)) (list(car new3)(cadr new3)))))
  109.       (if p21max+ (setq ipt2_a(inters p1 p2 p21 p21max+ nil)
  110.                         ipt2_b(inters new1 new2 p21 p21max+ nil)
  111.                         ipt2(polar ipt2_b (angle p2 p1)(distance ipt2_a p2))
  112.                         new4(polar ipt2_b (angle p21 p21max+)(distance ipt2_a p21))                        
  113.                         vb_new4(vlax-safearray-fill(vlax-make-safearray vlax-vbdouble '(0 . 1)) (list(car new4)(cadr new4)))))
  114.       (setq vb_new1(vlax-safearray-fill(vlax-make-safearray vlax-vbdouble '(0 . 1)) (list(car ipt1)(cadr ipt1)))            
  115.             vb_new2(vlax-safearray-fill(vlax-make-safearray vlax-vbdouble '(0 . 1)) (list(car ipt2)(cadr ipt2)))
  116.             )
  117.       (if vb_new3 (progn
  118.                     (vla-put-Coordinate obj indexmin1- vb_new3)
  119.                     (vla-put-Coordinate obj indexmin  vb_new1))
  120.         (vla-put-Coordinate obj indexmin  vb_new1)
  121.         )
  122.       (if vb_new4 (progn
  123.                     (vla-put-Coordinate obj indexmax1+ vb_new4)
  124.                     (vla-put-Coordinate obj indexmax  vb_new2))
  125.         (vla-put-Coordinate obj indexmax  vb_new2)
  126.         )
  127.       (progn
  128.         (setq p11min- nil
  129.               p21max+ nil
  130.               vb_new1 nil
  131.               vb_new2 nil
  132.               vb_new3 nil
  133.               vb_new4 nil
  134.         ))
  135.       (vla-update obj)
  136.       (if sk_lw_line (progn (vl-cmdf "_.explode" ent )  (setvar "cmdecho" 0)(setq sk_lw_line nil ent1 nil)))
  137.       )     
  138.       )   
  139.     )
  140. (if ent1 (redraw (car ent1) 4))
  141.   (and *error*_Old(setq *error* *error*_Old))
  142.   (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
  143.   (princ)
  144.   )
  145. (defun c:tt nil
  146.   (sk_offset_single)
  147.   (princ)
  148.   )
  149. (prompt "轻多段线(LWPOLYLINE)单边边偏移命令 TT")
  150. (princ)

评分

参与人数 1明经币 +1 金钱 +5 收起 理由
chang1622 + 1 + 5 很给力!

查看全部评分

回复 支持 反对

使用道具 举报

chang1622
 楼主| 发表于 2014-5-15 17:00:33 | 显示全部楼层
edata厉害！！佩服
回复 支持 反对

使用道具 举报

chang1622
 楼主| 发表于 2014-5-17 10:39:23 | 显示全部楼层
如果支持圆弧偏移就完美！
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2025-5-24 18:22 , Processed in 0.161152 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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