在直线交点自动画带圆圈序号，需要修剪圈内线段的问题
因工作原因，需要在很多交点上画带圆圈的序号，找到一个程序可以实现，但是需要进一步增加标注序号后，能自动剪切圈内的线段，样例如下：(defun c:nd ()
(setvar "CMDECHO" 0)
;;;(setq sc (getdist "\nselect a point to point 从一点到另一点确定字体高度 :"))
(setq sc (getint "\nselect a point to point 输入字体高度 :"))
(setq bn (getint "\nInput begin number 输入起始序号："))
(setq sc1 (* sc 0.53))
(while (setq p1 (getpoint "\nInsert Point :"))
(command "circle" p1 "d" sc)
(command "text" "j" "m" p1 sc1 "" bn)
(setq s1 (entlast))
(setq txtn (itoa bn))
(setq bn (1+ bn))
(while (and (setq ss (ssget "X" (list '(0 . "TEXT") (cons 1 txtn))))
(= (sslength ss) 2))
(setq ss (ssdel s1 ss)
s1 (ssname ss 0)
ent (entget s1)
txtn (itoa (1+ (atoi txtn)))
ent (subst (cons 1 txtn) (assoc 1 ent) ent))
(entmod ent)
)
)
(setvar "CMDECHO" 1)
(princ)
)
请群里高人给修改完善下
;; ctrim.lspv1.1
;; Modified By Xiaxiang
(defun c:ctrim ( / circ_pts lst ang inc tmp seg pt ent ss1 num
ctrim_err x f_pts svd_os svd_cmd svd_err)
(defun ctrim_err (s)
(if(/= s "Function cancelled")
(princ(strcat "\n\n" s)) )
(setvar "cmdecho" svd_cmd)
(setvar "osmode" svd_os)
(setq *error* svd_err)
)
(defun circ_pts (enm)
(setq lst (entget enm)
ang (* pi 2)
inc (/ ang 64)
tmp '()
seg 65
)
(repeat seg
(setq pt (polar(cdr(assoc 10 lst))ang
(-(cdr(assoc 40 lst))0.01))
ang (+ inc ang)
)
(setq tmp(cons pt tmp))
)
tmp
)
;;add ssget function
(setq num 0)
(prompt "\nSelect circles: ")
(setq ss1 (ssget '((0 . "CIRCLE"))))
(setq ;ent (car(entsel "\nSelect circle: ")) ;;entsel
svd_err *error*
*error* ctrim_err
svd_os(getvar "osmode")
svd_cmd (getvar "cmdecho")
)
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(repeat (sslength ss1)
(setq ent(ssname ss1 num))
(setq num(1+ num))
(if(and ent
(=(cdr(assoc 0(entget ent)))"CIRCLE")
)
(progn
(setq f_pts(circ_pts ent))
(command "trim" ent "" "f") ;run twice in case the same
(foreach x f_pts(command x));object intersects circle twice
(command "" "")
(command "trim" ent "" "f")
(foreach x f_pts(command x))
(command "" "")
(if(setq x(ssget "wp" f_pts '((0 . "~TEXT"))))
(command "erase" x "")
)
)
)
)
(setvar "cmdecho" svd_cmd)
(setvar "osmode" svd_os)
(setq *error* svd_err)
(princ)
) 找到论坛里面可以批量修剪圆内线段，但是执行后，把圈内的文字也删除了，看了半天，这个代码好像老外写的，请高人修改，实现批量修剪圈内线段，同时保留文字，谢谢
;; ctrim.lspv1.1
;; Modified By Xiaxiang
(defun c:ctrim ( / circ_pts lst ang inc tmp seg pt ent ss1 num
ctrim_err x f_pts svd_os svd_cmd svd_err)
(defun ctrim_err (s)
(if(/= s "Function cancelled")
(princ(strcat "\n\n" s)) )
(setvar "cmdecho" svd_cmd)
(setvar "osmode" svd_os)
(setq *error* svd_err)
)
(defun circ_pts (enm)
(setq lst (entget enm)
ang (* pi 2)
inc (/ ang 64)
tmp '()
seg 65
)
(repeat seg
(setq pt (polar(cdr(assoc 10 lst))ang
(-(cdr(assoc 40 lst))0.01))
ang (+ inc ang)
)
(setq tmp(cons pt tmp))
)
tmp
)
;;add ssget function
(setq num 0)
(prompt "\nSelect circles: ")
(setq ss1 (ssget '((0 . "CIRCLE"))))
(setq ;ent (car(entsel "\nSelect circle: ")) ;;entsel
svd_err *error*
*error* ctrim_err
svd_os(getvar "osmode")
svd_cmd (getvar "cmdecho")
)
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(repeat (sslength ss1)
(setq ent(ssname ss1 num))
(setq num(1+ num))
(if(and ent
(=(cdr(assoc 0(entget ent)))"CIRCLE")
)
(progn
(setq f_pts(circ_pts ent))
(command "trim" ent "" "f") ;run twice in case the same
(foreach x f_pts(command x));object intersects circle twice
(command "" "")
(command "trim" ent "" "f")
(foreach x f_pts(command x))
(command "" "")
(if(setq x(ssget "wp" f_pts))
(command "erase" x "")
)
)
)
)
(setvar "cmdecho" svd_cmd)
(setvar "osmode" svd_os)
(setq *error* svd_err)
(princ)
)
你把文字统一放进一个层，然后冻结不就可以了吗。这样剪圆内对象的时候不就无法剪了。
至于你第一步，这个程序需要一个点一个点的选是不是效率低了一些。
yoyoho 发表于 2019-5-2 17:35
;; ctrim.lspv1.1
;; Modified By Xiaxiang
厉害，学习了。节日快乐 楼主，两个程序如果拼接呀。我电气这边也需要用到类似功能。我试着拼过，水平不够 yoyoho 发表于 2019-5-2 17:35
;; ctrim.lspv1.1
;; Modified By Xiaxiang
厉害了~
已经实现了批量修剪圈内线段并保留圆圈内的文字。
代码完美运行~ zhangrunze 发表于 2024-4-1 08:53
厉害了~
已经实现了批量修剪圈内线段并保留圆圈内的文字。
代码完美运行~
你好，可以分享一下吗 aggdqty 发表于 2024-4-10 15:21
你好，可以分享一下吗
我就是用的这个帖子的代码呀~ctrim.lspv1.1
你都试试就清楚了。我这边是没有问题呢~ 请问这个功能实现了吗
页:
[1]
2