明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 2253|回复: 1

有请版主改下:按间距打断

[复制链接]
发表于 2009-11-6 09:24 | 显示全部楼层 |阅读模式
本帖最后由 894560869 于 2019-4-17 23:02 编辑

拐角点及T型交叉线都为0.55,



;;;自动按间距打断
(defun c:trcc (/);;;;曲线交点处加点  
(vl-load-com)
(princ "\n请选择多段线、样条曲线、直线、圆、圆弧、椭圆:")
(setq xlr_jdlb_ss (ssget '((0 . "LWPOLYLINE,POLYLINE,LINE,SPLINE,REGION,ARC,CIRCLE,ELLIPSE"))))
(Repeat (setq xlr_jdlb_i (sslength xlr_jdlb_ss))
(foreach lwpolylineass (entget (ssname xlr_jdlb_ss (setq xlr_jdlb_i (1- xlr_jdlb_i))))
(if (= (car lwpolylineass) 10)
(command "_.CIRCLE" (cdr lwpolylineass) 0.55 5 "Change" (Entlast) "" "p" "c" "1" ""))))
(if (/= xlr_jdlb_ss nil)
(progn (setq ptnls (for_xlr_jdlb_ss xlr_jdlb_ss))
(if (/= ptnls nil)(progn (foreach trccpt ptnls
(entmake (list (cons 0 "CIRCLE") (cons 10 trccpt)(cons 40 0.275)(cons 62 4))))))
(setq
svd_err *error*
*error* ctrim_err
svd_os  (getvar "osmode")
svd_cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(setq ssnum 0)
(prompt "\n Select point(按间距打断): ")
(setq ss1 (ssget "x" '((-4 . "<and")(0 . "CIRCLE")(-4 . ">")(40 . 0.274)(-4 . "<")(40 . 0.56)(-4 . "and>"))))
(repeat (sslength ss1)
(setq ent00q (ssname ss1 ssnum))
(setq ssnum (1+ ssnum))
(if (and ent00q (=(cdr(assoc 0(entget ent00q)))"CIRCLE"))
(progn (setq f_pts(circ_pts ent00q))(command "trim" ent00q "" "f")   
(foreach xlr_jdlb_x f_pts(command xlr_jdlb_x)) (command "" "") (command "trim" ent00q "" "f")
(foreach xlr_jdlb_x f_pts(command xlr_jdlb_x)) (command "" "")
(if(setq xlr_jdlb_x (ssget "wp" f_pts))
(command "erase" xlr_jdlb_x ""))
(command "erase" ent00q ""))))))
(setvar "cmdecho" svd_cmd)
(setvar "osmode" svd_os)
(setq *error* svd_err)
(princ))
(defun for_xlr_jdlb_ss (xlr_jdlb_ss / xlr_jdlb_ipt lst xlr_jdlb_n xlr_jdlb_n1 xlr_jdlb_n2 obj1 obj2
circ_pts lst ang inc sstmp ssseg trccpt ent00q ss1 ssnum ctrim_err xlr_jdlb_x f_pts svd_os svd_cmd svd_err)
(setq xlr_jdlb_n  (sslength xlr_jdlb_ss) xlr_jdlb_n1 0)
(while (< xlr_jdlb_n1 (1- xlr_jdlb_n))
(setq obj1 (vlax-ename->vla-object (ssname xlr_jdlb_ss xlr_jdlb_n1)) xlr_jdlb_n2   (1+ xlr_jdlb_n1))
(while (< xlr_jdlb_n2 xlr_jdlb_n)(setq obj2 (vlax-ename->vla-object (ssname xlr_jdlb_ss xlr_jdlb_n2))
xlr_jdlb_ipt  (vlax-variant-value (vla-intersectwith obj1 obj2 0)))
(if (> (vlax-safearray-get-u-bound xlr_jdlb_ipt 1) 0)
(progn (setq xlr_jdlb_ipt (vlax-safearray->list xlr_jdlb_ipt))
(while (> (length xlr_jdlb_ipt) 0)
(setq lst (cons (list (car xlr_jdlb_ipt) (cadr xlr_jdlb_ipt) (caddr xlr_jdlb_ipt)) lst) xlr_jdlb_ipt (cdddr xlr_jdlb_ipt)))))
(setq xlr_jdlb_n2 (1+ xlr_jdlb_n2)))
(setq xlr_jdlb_n1 (1+ xlr_jdlb_n1)))lst)
(defun ctrim_err (ttts)
(if(/= ttts "Function cancelled")(princ(strcat "\xlr_jdlb_n\xlr_jdlb_n" ttts)))
(setvar "cmdecho" svd_cmd)
(setvar "osmode" svd_os)
(setq *error* svd_err))
(defun circ_pts (ssenm)
(setq lst    (entget ssenm)
ang    (* pi 2)
inc    (/ ang 64)
sstmp    '()
ssseg    65 )
(repeat ssseg
(setq trccpt (polar(cdr(assoc 10 lst))ang (-(cdr(assoc 40 lst))0.01)) ang (+ inc ang) )
(setq sstmp (cons trccpt sstmp))) sstmp)
;;;自动按间距打断
 楼主| 发表于 2019-4-18 07:28 | 显示全部楼层
自己顶起                                                           
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-4-19 09:47 , Processed in 0.408925 second(s), 23 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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