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

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › 付费开发 › 曲线局部长度插件反向改编
12下一页
返回列表 发新帖
查看: 1434|回复: 12

曲线局部长度插件反向改编

[复制链接]
15062311027
发表于 2023-6-11 12:20:17 | 显示全部楼层 |阅读模式
100明经币
原代码是在论坛找的，感谢原作者，主要功能是点取曲线上两点，获取两点间距离，此次增加功能是对于首尾相连的曲线，有时候想获取的两点间的距离是和原插件获取的相反的部分的长度，请大声伸下援手哈，最好是直接按T键直接转换
附件: 您需要 登录 才可以下载或查看，没有账号？注册

最佳答案

yaojing38

查看完整内容

你用原来命令QJCD ,提示取反不输入不取反
回复

使用道具 举报

yaojing38
发表于 2023-6-11 12:20:18 | 显示全部楼层
本帖最后由 yaojing38 于 2023-6-11 23:14 编辑
15062311027 发表于 2023-6-11 22:33
你好 这么晚了还打扰你哈 现在提示错误: 输入的字符串有缺陷
还有我意思是比如截取两点间距离 ，发现亮 ...
  2. ;测量曲线上两点间的路程长度.
  3. (defun C:qjcd (/ entName1 Pt1 Pt2 xLen st_pt end_pt pt_tmp l_ss PD pd1 obj)
  4.     (vl-load-com)
  5.     (setq entName1 (car (entselEx  "\r请选择直线、圆弧、圆、多段线等曲线：" '((0 . "line,arc,circle,lwpolyline")))))
  6.     (setq obj (vlax-ename->vla-object entName1))  
  7.     (setq PD (< (distance (vlax-curve-getStartPoint obj) (vlax-curve-getEndPoint obj)) 0.0001))  
  8.    
  9.    
  10.     (setq pt1 (getpoint "\n指定测量起点: ")
  11.            pt2 (getpoint "\n指定测量终点: ")
  12.          
  13.     )
  14.   
  15.     (setq
  16.             st_pt (vlax-curve-getStartPoint entName1)
  17.             end_pt (vlax-curve-getEndPoint entName1)
  18.     )
  19.       (setq   entName2 entName1)
  20.   
  21.       
  22.     (if (>  (vlax-curve-getParamAtPoint entName1 pt1) (vlax-curve-getParamAtPoint entName1 pt2))
  23.           (setq pt_tmp pt2
  24.                   pt2 pt1
  25.                   pt1 pt_tmp)
  26.            )
  27.           (vl-cmdf "undo" "be")
  28.           (vl-cmdf "_break" entName1 st_pt pt1)
  29.           (vl-cmdf "_break" entName1 end_pt pt2)
  30.           (vl-cmdf ".copy" entName1 "" '(0 0) '(0 0))
  31.           (setq l_ss (entget (entlast)))
  32.           (vl-cmdf "undo" "end")
  33.           (vl-cmdf "undo" "")
  34.           (entmake l_ss)
  35.           (setq entName1 (entlast))
  36.           (vla-put-Color (vlax-ename->vla-object entName1) 1)
  37.           (redraw entName1 3)
  38.           (initget 1 "T")  
  39.           (setq pd1 (getstring "\n[取反向距离(T)]: ") )
  40.           (if (AND (or (= pd1 "t") (= pd1 "T")) PD)
  41.           (setq xLen (- (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj)) (abs (- (vlax-curve-getDistAtPoint entName1 pt1)(vlax-curve-getDistAtPoint entName1 pt2)))))
  42.           (setq xLen (abs (- (vlax-curve-getDistAtPoint entName1 pt1)(vlax-curve-getDistAtPoint entName1 pt2))))
  43.           )  
  44.           (if (AND (or (= pd1 "t") (= pd1 "T")) PD)
  45.           (progn
  46.           (vl-cmdf "_erase"  entName1 "")
  47.                 (if (>  (vlax-curve-getParamAtPoint entName2 pt1) (vlax-curve-getParamAtPoint entName2 pt2))
  48.           (setq pt_tmp pt2
  49.                   pt2 pt1
  50.                   pt1 pt_tmp)
  51.            )
  52.           (vl-cmdf "undo" "be")
  53.           (vl-cmdf "_break" entName2  PT1 pt2 )
  54.           ;(vl-cmdf "_break" entName1  end_pt  pt1)
  55.           (vl-cmdf ".copy" entName2 "" '(0 0) '(0 0))
  56.           (setq l_ss (entget (entlast)))
  57.           (vl-cmdf "undo" "end")
  58.           (vl-cmdf "undo" "")
  59.           (entmake l_ss)
  60.           (setq entName2 (entlast))
  61.           (vla-put-Color (vlax-ename->vla-object entName2) 1)
  62.           (redraw entName2 3)
  63.           (vl-cmdf "_erase"  entName2)
  64.           )
  65.           )
  66.           (vl-cmdf "_erase"  entName1)
  67.           (princ (strcat "\n测量结果:两点间曲线长度=" (rtos xLen 2 2)))
  68.           (princ "\n路径检查:查看亮显区域,右键退出")
  69. (princ)
  70. )

你用原来命令QJCD ,提示取反不输入不取反
回复

使用道具 举报

yaojing38
发表于 2023-6-11 22:11:49 | 显示全部楼层
;测量曲线上两点间的路程长度.
(defun C:T (/ entName1 Pt1 Pt2 xLen st_pt end_pt pt_tmp l_ss PD  obj)
    (vl-load-com)
    (setq entName1 (car (entselEx  "\r请选择直线、圆弧、圆、多段线等曲线：" '((0 . "line,arc,circle,lwpolyline")))))
    (setq obj (vlax-ename->vla-object entName1))       
    (setq PD (< (distance (vlax-curve-getStartPoint obj) (vlax-curve-getEndPoint obj)) 0.0001))  
   
               
    (setq pt1 (getpoint "\n指定测量起点: ")
            pt2 (getpoint "\n指定测量终点: ")
            st_pt (vlax-curve-getStartPoint entName1)
            end_pt (vlax-curve-getEndPoint entName1)
    )
                       
                (if PD
                (setq xLen (- (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj)) (abs (- (vlax-curve-getDistAtPoint entName1 pt1)(vlax-curve-getDistAtPoint entName1 pt2)))))
          (setq xLen (abs (- (vlax-curve-getDistAtPoint entName1 pt1)
            (vlax-curve-getDistAtPoint entName1 pt2))))
                )       
                       
    (if (>  (vlax-curve-getParamAtPoint entName1 pt1) (vlax-curve-getParamAtPoint entName1 pt2))
          (setq pt_tmp pt2
                  pt2 pt1
                  pt1 pt_tmp)
           )
          (vl-cmdf "undo" "be")
          (vl-cmdf "_break" entName1 st_pt pt1)
          (vl-cmdf "_break" entName1 end_pt pt2)
          (vl-cmdf ".copy" entName1 "" '(0 0) '(0 0))
          (setq l_ss (entget (entlast)))
          (vl-cmdf "undo" "end")
          (vl-cmdf "undo" "")
          (entmake l_ss)
          (setq entName1 (entlast))
          (vla-put-Color (vlax-ename->vla-object entName1) 1)
          (redraw entName1 3)
          (vl-cmdf "_erase"  entName1)
          (princ (strcat "\n测量结果:两点间曲线长度=" (rtos xLen 2 2)))
          (princ "\n路径检查:查看亮显区域,右键退出")
(princ)
)

你试下行不行

评分

参与人数 1明经币 +1 金钱 +10 收起 理由
15062311027 + 1 + 10 麻烦再看下哈

查看全部评分

回复

使用道具 举报

15062311027
 楼主| 发表于 2023-6-11 22:33:19 | 显示全部楼层
yaojing38 发表于 2023-6-11 22:11
;测量曲线上两点间的路程长度.
(defun C:T (/ entName1 Pt1 Pt2 xLen st_pt end_pt pt_tmp l_ss PD  obj)
...

你好 这么晚了还打扰你哈 现在提示错误: 输入的字符串有缺陷
还有我意思是比如截取两点间距离 ，发现亮显段就是自己需要的段落就直接右键结束，否则如果发现亮显段和实际要测的段落刚好相反 则直接按一个键T或者其他字母 就亮显反向的那段，且输出反向那段长度 麻烦再看下哈
回复

使用道具 举报

15062311027
 楼主| 发表于 2023-6-12 09:00:30 | 显示全部楼层
yaojing38 发表于 2023-6-11 12:20
你用原来命令QJCD ,提示取反不输入不取反

你好 现在基本满足了哈 还有两个小问题哈 第一个一旦按下T阿能先把曲线处理成闭合的（有时候曲线虽然首尾相连，但不是闭合的，这种情形插件不能准确识别反向测量区域） 第二个如果一开始选择的曲线段落就符合要求，看能不能改成直接按右键出结果退出
回复

使用道具 举报

yaojing38
发表于 2023-6-12 13:53:07 | 显示全部楼层
15062311027 发表于 2023-6-12 09:00
你好 现在基本满足了哈 还有两个小问题哈 第一个一旦按下T阿能先把曲线处理成闭合的（有时候曲线虽然首尾 ...

测量曲线上两点间的路程长度.
(defun C:qjcd (/ entName1 Pt1 Pt2 xLen st_pt end_pt pt_tmp l_ss PD pd1 obj)
    (vl-load-com)
    (setq entName1 (car (entselEx  "\r请选择直线、圆弧、圆、多段线等曲线：" '((0 . "line,arc,circle,lwpolyline")))))
    (setq obj (vlax-ename->vla-object entName1))  
    (setq PD (< (distance (vlax-curve-getStartPoint obj) (vlax-curve-getEndPoint obj)) 0.0001))  
   
   
    (setq pt1 (getpoint "\n指定测量起点: ")
           pt2 (getpoint "\n指定测量终点: ")
         
    )
  
    (setq
            st_pt (vlax-curve-getStartPoint entName1)
            end_pt (vlax-curve-getEndPoint entName1)
    )
      (setq   entName2 entName1)
  
      
    (if (>  (vlax-curve-getParamAtPoint entName1 pt1) (vlax-curve-getParamAtPoint entName1 pt2))
          (setq pt_tmp pt2
                  pt2 pt1
                  pt1 pt_tmp)
           )
          (vl-cmdf "undo" "be")
          (vl-cmdf "_break" entName1 st_pt pt1)
          (vl-cmdf "_break" entName1 end_pt pt2)
          (vl-cmdf ".copy" entName1 "" '(0 0) '(0 0))
          (setq l_ss (entget (entlast)))
          (vl-cmdf "undo" "end")
          (vl-cmdf "undo" "")
          (entmake l_ss)
          (setq entName1 (entlast))
          (vla-put-Color (vlax-ename->vla-object entName1) 1)
          (redraw entName1 3)
          (initget 1 "T")  
          (setq pd1 (getstring "\n[取反向距离(T)]: ") )
          (if (AND (or (= pd1 "t") (= pd1 "T")) PD)
          (setq xLen (- (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj)) (abs (- (vlax-curve-getDistAtPoint entName1 pt1)(vlax-curve-getDistAtPoint entName1 pt2)))))
          (setq xLen (abs (- (vlax-curve-getDistAtPoint entName1 pt1)(vlax-curve-getDistAtPoint entName1 pt2))))
          )  
          (if (AND (or (= pd1 "t") (= pd1 "T")) PD)
          (progn
          (vl-cmdf "_erase"  entName1 "")
                (if (>  (vlax-curve-getParamAtPoint entName2 pt1) (vlax-curve-getParamAtPoint entName2 pt2))
          (setq pt_tmp pt2
                  pt2 pt1
                  pt1 pt_tmp)
           )
          (vl-cmdf "undo" "be")
          (vl-cmdf "_break" entName2  PT1 pt2 )
          ;(vl-cmdf "_break" entName1  end_pt  pt1)
          (vl-cmdf ".copy" entName2 "" '(0 0) '(0 0))
          (setq l_ss (entget (entlast)))
          (vl-cmdf "undo" "end")
          (vl-cmdf "undo" "")
          (entmake l_ss)
          (setq entName2 (entlast))
          (vla-put-Color (vlax-ename->vla-object entName2) 1)
          (redraw entName2 3)
          (vl-cmdf "_erase"  entName2)
          )
          )
          (vl-cmdf "_erase"  entName1  "")
          (princ (strcat "\n测量结果:两点间曲线长度=" (rtos xLen 2 2)))
          ;(princ "\n路径检查:查看亮显区域,右键退出")
(princ)
)

;;功能：带提示、关键字、过滤表、选择错误时的提示并且会亮显所选对像的entsel
;;用法：(entselEx  提示信息 过滤表)
;;举例：(entselEx  "\r请选择一个圆：" '((0 . "circle")) )
(defun entselEx (msg fil / el ss)
        (while (and (setvar "errno" 0)
                                         (not (and (setq el  (entsel msg))
                                                                        (if (= (type el) 'str)
                                                                                el
                                                                                (if (setq ss (ssget (cadr el) fil))
                                                                                        ss
                                                                                        (progn (princ ermsg) (setq ss nil))
                                                                                );if
                                                                        );if
                                                                );and
                                         );not
                                         (/= (getvar "errno") 52)
                                 );and
  );while
  (if (= (type el) 'list) (redraw (car el) 3));亮显选中的对像
  el
)
这个是右键直接退出，，至于你说的线先闭合，，这个要有个多少范围距离让它自动闭合，，你主要的是什么类型的线？？圆还是多段线？？
回复

使用道具 举报

15062311027
 楼主| 发表于 2023-6-12 16:32:51 | 显示全部楼层
yaojing38 发表于 2023-6-12 13:53
测量曲线上两点间的路程长度.
(defun C:qjcd (/ entName1 Pt1 Pt2 xLen st_pt end_pt pt_tmp l_ss PD pd ...

特指看起来首尾相连，实际没有闭合的多段线，我想着这样应该处理起来比较简单/多段线特性里的闭合选择是就行了哈
回复

使用道具 举报

yaojing38
发表于 2023-6-12 17:14:53 | 显示全部楼层
15062311027 发表于 2023-6-12 16:32
特指看起来首尾相连，实际没有闭合的多段线，我想着这样应该处理起来比较简单/多段线特性里的闭合选择是 ...

;测量曲线上两点间的路程长度.
(defun C:qjcd (/ entName1 Pt1 Pt2 xLen st_pt end_pt pt_tmp l_ss PD pd1 obj)
    (vl-load-com)
    (setq entName1 (car (entselEx  "\r请选择直线、圆弧、圆、多段线等曲线：" '((0 . "line,arc,circle,lwpolyline")))))
        (if (= (assoc 0 (entget entName1) ) "LWPOLYLINE") (MakeTrueClosePL entName1))
    (setq obj (vlax-ename->vla-object entName1))  
    (setq PD (< (distance (vlax-curve-getStartPoint obj) (vlax-curve-getEndPoint obj)) 0.0001))  
   
   
    (setq pt1 (getpoint "\n指定测量起点: ")
           pt2 (getpoint "\n指定测量终点: ")
         
    )
  
    (setq
            st_pt (vlax-curve-getStartPoint entName1)
            end_pt (vlax-curve-getEndPoint entName1)
    )
      (setq   entName2 entName1)
  
      
    (if (>  (vlax-curve-getParamAtPoint entName1 pt1) (vlax-curve-getParamAtPoint entName1 pt2))
          (setq pt_tmp pt2
                  pt2 pt1
                  pt1 pt_tmp)
           )
          (vl-cmdf "undo" "be")
          (vl-cmdf "_break" entName1 st_pt pt1)
          (vl-cmdf "_break" entName1 end_pt pt2)
          (vl-cmdf ".copy" entName1 "" '(0 0) '(0 0))
          (setq l_ss (entget (entlast)))
          (vl-cmdf "undo" "end")
          (vl-cmdf "undo" "")
          (entmake l_ss)
          (setq entName1 (entlast))
          (vla-put-Color (vlax-ename->vla-object entName1) 1)
          (redraw entName1 3)
          (initget 1 "T")  
          (setq pd1 (getstring "\n[取反向距离(T)]: ") )
          (if (AND (or (= pd1 "t") (= pd1 "T")) PD)
          (setq xLen (- (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj)) (abs (- (vlax-curve-getDistAtPoint entName1 pt1)(vlax-curve-getDistAtPoint entName1 pt2)))))
          (setq xLen (abs (- (vlax-curve-getDistAtPoint entName1 pt1)(vlax-curve-getDistAtPoint entName1 pt2))))
          )  
          (if (AND (or (= pd1 "t") (= pd1 "T")) PD)
          (progn
          (vl-cmdf "_erase"  entName1 "")
                (if (>  (vlax-curve-getParamAtPoint entName2 pt1) (vlax-curve-getParamAtPoint entName2 pt2))
          (setq pt_tmp pt2
                  pt2 pt1
                  pt1 pt_tmp)
           )
          (vl-cmdf "undo" "be")
          (vl-cmdf "_break" entName2  PT1 pt2 )
          ;(vl-cmdf "_break" entName1  end_pt  pt1)
          (vl-cmdf ".copy" entName2 "" '(0 0) '(0 0))
          (setq l_ss (entget (entlast)))
          (vl-cmdf "undo" "end")
          (vl-cmdf "undo" "")
          (entmake l_ss)
          (setq entName2 (entlast))
          (vla-put-Color (vlax-ename->vla-object entName2) 1)
          (redraw entName2 3)
          (vl-cmdf "_erase"  entName2)
          )
          )
          (vl-cmdf "_erase"  entName1  "")
          (princ (strcat "\n测量结果:两点间曲线长度=" (rtos xLen 2 2)))
          ;(princ "\n路径检查:查看亮显区域,右键退出")
(princ)
)

;;功能：带提示、关键字、过滤表、选择错误时的提示并且会亮显所选对像的entsel
;;用法：(entselEx  提示信息 过滤表)
;;举例：(entselEx  "\r请选择一个圆：" '((0 . "circle")) )
(defun entselEx (msg fil / el ss)
        (while (and (setvar "errno" 0)
                                         (not (and (setq el  (entsel msg))
                                                                        (if (= (type el) 'str)
                                                                                el
                                                                                (if (setq ss (ssget (cadr el) fil))
                                                                                        ss
                                                                                        (progn (princ ermsg) (setq ss nil))
                                                                                );if
                                                                        );if
                                                                );and
                                         );not
                                         (/= (getvar "errno") 52)
                                 );and
  );while
  (if (= (type el) 'list) (redraw (car el) 3));亮显选中的对像
  el
)

;;164.56 [功能] 使多段线真闭合
;;(MakeTrueClosePL (car(entsel)))对于非输入C闭合的
(defun MakeTrueClosePL (e / EN L L1 LST X)  
  (setq en (entget e))
  (while (setq x  (car en)
               en (cdr en)
         )
    (cond
      ((and (/= (car x) 10) (or (not L) (not L1))) (setq Lst (cons x Lst)))
      ((equal (car x) 10) (setq L1 (cons L L1)) (setq L nil) (setq L (cons x L)))
      (T (setq L (cons x L)))
    )
  )
  (setq lst (reverse lst))
  (setq lst (subst '(70 . 1) (assoc 70 lst) lst))
  (setq lst (subst (cons 90 (1- (cdr (assoc 90 lst)))) (assoc 90 lst) lst))
  (setq L1 (apply 'append (reverse (mapcar 'reverse L1))))
  (entmod (append lst L1 (list x)))
)

改了下，，你再试下
回复

使用道具 举报

15062311027
 楼主| 发表于 2023-6-12 18:25:12 | 显示全部楼层
yaojing38 发表于 2023-6-12 17:14
;测量曲线上两点间的路程长度.
(defun C:qjcd (/ entName1 Pt1 Pt2 xLen st_pt end_pt pt_tmp l_ss PD p ...

你好 应该处理闭合没有成功 只要没闭合，按T时，只能选择已选择段落两侧的其中一段/另开始选择正确时，右键是右键菜单，点确认才行 不是直接右键就行的
回复

使用道具 举报

yaojing38
发表于 2023-6-14 17:46:01 | 显示全部楼层
15062311027 发表于 2023-6-12 18:25
你好 应该处理闭合没有成功 只要没闭合，按T时，只能选择已选择段落两侧的其中一段/另开始选择正确时，右 ...

右键你工具自定义右键单击，，改一下  右键为确定就行，，，闭合的要不你发个图上来我看下是怎么回事？
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-11-18 08:22 , Processed in 0.199199 second(s), 23 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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