如何实现选取边界自动偏移并插入块
试搞了一下，搞不定请各位大神帮忙。如何实现选取矩形四边，然后自动偏移，然后标注ABCD，然后插入图示的2个块 直线偏移方向不好控制 是的，所以不好解决，大侠，有什么思路 网上到是有个内偏的，但是处理的是连续;;;******内缩偏移 程序开始*****(princ "\n★内缩偏移命令：ns ★\n")
(defun c:ns ()
(setvar "blipmode" 0)
(setvar "pickfirst" 1)
(setvar "osmode" 15359)
(setvar "cmdecho" 0)
(princ "\n★功能：批量将多段线、圆弧、圆进行内缩偏移.\n")
(command "ucs" "w")
(command "undo" "be")
(initget 6)
(setq dist (getreal "\n输入要内缩偏移的距离<0.004>："))
(if (not dist)
(setq dist 0.004)
)
(princ "\n选择要内缩偏移的对象：\n")
(setq ss (ssget '((0 . "CIRCLE,ARC,LWPOLYLINE"))))
(if (not ss)
(exit)
)
(setq num (sslength ss))
(setvar "osmode" 0)
(setq i 0
j 0
)
(command "LAYER" "M" "标记层" "C" "1" "标记层" "")
(command "LAYER" "M" "内缩" "C" "6" "内缩" "")
(vl-load-com)
(repeat num
(setq entnam (ssname ss i))
(setq obj (vlax-ename->vla-object entnam))
(setq len (vlax-curve-getdistatparam
obj
(vlax-curve-getendparam obj)
)
)
(vla-offset obj 0.00001)
(setq objlast (entlast))
(setq lenlast (vlax-curve-getdistatparam
objlast
(vlax-curve-getendparam objlast)
)
)
(entdel objlast)
(cond ((< lenlast len)
(progn
(vla-offset obj dist)
(setq en (entget (entlast)))
(entmod (subst (cons 8 "内缩") (assoc 8 en) en))
)
)
((> lenlast len)
(progn
(vla-offset obj (* -1 dist))
(setq en (entget (entlast)))
(entmod (subst (cons 8 "内缩") (assoc 8 en) en))
)
)
((= lenlast len)
(progn
(setq en (entget entnam))
(entmod (subst (cons 8 "标记层") (assoc 8 en) en))
(setq j (+ 1 j))
)
)
)
(setq i (1+ i))
)
(command "undo" "e")
(princ "\n★将选取对象进行内缩偏移成功.\n")
(if (> j 0) (princ (strcat "★提示：有" (itoa j) "个对象因无法判定偏移方向，未进行内缩偏移，已将其置于“标记层”。\n")))
(setvar "osmode" 15359)
(princ)
)
;;;******内缩偏移 程序结束******的单条的线 ；；这个是处理块的(defun c:dj ()
(setq i 0)
(setq pline (car (entsel)))
(setq ent (entget pline))
(setq pts nil)
(repeat (length ent)
(if (= (car (nth i ent)) 10)
;(setq pts (append pts (list (cdr (nth i ent)))))
(setq p0 (cdr (nth i ent)))
(ins)
)
(setq i (1+ i))
)
(entdel pline)
(princ)
)
(defun ins ()
;(setq p1 (getpoint "\n梁内边左下端点为起点: "))
(COMMAND "-insert" "点筋" p0 "1" "1" "0" )
(princ)
) (defun c:zm1 (/ mycopy mymove SstoEs sign ss p1 p2)
(defun SstoEs(ss / a en lst)
(if ss(progn(setq a -1)(while(setq en(ssname ss(setq a(1+ a))))(setq lst (cons en lst)))))
lst)
(defun sign (nn) (if (< nn 0) -1 (if (> nn 0) 1 0)))
(defun mycopy(ss p p1 / ty q q1 s1 s2);;参照by-xyp1964的xyp-ScaleEntity
(setq ty(type ss)i -1
s2(ssadd)
q1(vlax-3D-point(trans p1 0 0))
q(vlax-3D-point(trans p 0 0)))
(cond((= ty 'ENAME)(vla-move(vla-copy(vlax-ename->vla-object ss))q q1)(setq s2(ssadd(entlast)s2)))
((= ty 'PICKSET)
(setq i -1)
(while (setq s1 (ssname ss (setq i (1+ i))))
(mycopy s1 p p1)(setq s2(ssadd(entlast)s2))))
((= ty 'LIST)(foreach x ss(mycopy x p p1)(setq s2(ssadd(entlast)s2))))
)s2)
(defun mymove(ss p p1 / ty q q1 s1);;参照by-xyp1964的xyp-ScaleEntity
(setq ty(type ss)i -1
q1(vlax-3D-point(trans p1 0 0))
q(vlax-3D-point(trans p 0 0)))
(cond((= ty 'ENAME)(vla-move(vlax-ename->vla-object ss)q q1))
((= ty 'PICKSET)
(setq i -1)
(while (setq s1 (ssname ss (setq i (1+ i))))
(mymove s1 p p1)))
((= ty 'LIST)(foreach x ss(mymove x p p1))))
)
(setq ind (getint "\n输入增减量<1> :")
ind (sign ind))
(prompt"\n选择要进行递增复制的文字、属性")
(setq ss(SstoEs(ssget'((0 . "*TEXT,ATTDEF")))))
(setq p1(getpoint"复制基点"))
(setq p2(getpoint p1"复制到"))
(mycopy (setq ss(vl-remove'nil(mapcar'(lambda(x)(setq e(entget x))
(if(assoc 1 e)
(progn(setq tx(vl-string->list (cdr(assoc 1 e))))
(if(OR(<(IF(> ind 0)65 66)(last tx)(IF(> ind 0)89 90))
(<(IF(> ind 0)97 98)(last tx)(IF(> ind 0)121 122)))x))))ss)))p1 p1)
(mymove ss p1 p2)
(mapcar'(lambda(x)(entmod(setq e(entget x)
tx(vl-string->list (cdr(assoc 1 e)))
e(subst(cons 1 (vl-list->string(reverse(cons((IF(> ind 0)1+ 1-)(last tx))(cdr(reverse tx))))))(assoc 1 e)e)))
nil)ss)
(princ)
)
;;这个是字母递增复制，貌似ABCD直接写入也行 本帖最后由 q3_2006 于 2013-12-10 19:19 编辑
图块做得标准，这个很简单，但你的块也太随意了，还要计算插入点。。。另外，如果全部是矩形，只要做个动态块就搞定了。。不用写程序的。。。 q3_2006 发表于 2013-12-10 18:54 static/image/common/back.gif
图块做得标准，这个很简单，但你的块也太随意了，还要计算插入点。。。另外，如果全部是矩形，只要做个动态 ...
是啊，难就难在图形不是矩形而是四条线，大神有解么 另外，插入点可以是直线的中点，计算中点应该难度会有所减小吧 (defun c:tt (/ make-extline area d e npts pts tf tf1 an)
(defun make-extline (pts / ln ptl)
(setq ln(apply 'xdrx_line_make pts) ;创建LINE实体
ptl (xdrx_curve_getinters (ssname ln 0) (car e) 1) ;两个AcDbCurve(曲线)实体的交点
)
(xdrx_setpropertyvalue;设置对象的属性值
(ssname ln 0)
"startpoint"
(car ptl)
"endpoint"
(cadr ptl)
)
)
(while
(and (setq e (xdrx_entsel "\nPick Pline: " '((0 . "*polyline")))) ;单选符合过滤表条件的实体
(progn
(initget "A")
(setq d (getdist (cadr e) "\nOffeset Dist : "))
(if (= d "A")
(setq d(getdist (cadr e) "\nOffeset Dist: ")
tf t
)
d
)
)
)
(setq pts (xdrx_entity_getstretchpoint (car e)) ;获取实体的stretch点点表（WCS）
area (apply 'xdrx_points_area pts) ;获得点表组成的多边形的面积
tf1 (xdrx_curve_isclosed (car e));判断两曲线是否共面
)
(if (minusp area)
(progn (xdrx_curve_reverse (car e)) ;判断两曲线是否共面
(if tf1
(xdrx_curve_setclosed (car e)) ;封闭曲线
)
)
)
(if tf
(progn
(setq npts (xdrx_curve_offset (car e) (- d)));OFFSET给定距离后的，曲线点表
(mapcar '(lambda (x y / ln) (make-extline (list x y))) npts (cdr npts))
)
(progn
(setq npts
(xdrx_polyline_getlinesegat;获得一个直线段顶点的直线段数据 (起点 终点)
(car e)
(fix (vlax-curve-getParamAtPoint (car e) (vlax-curve-getClosestPointTo (car e) (cadr e))))
)
an (+ (* pi 0.5) (apply 'angle npts))
npts (mapcar '(lambda (x) (polar x an d)) npts)
;;(apply 'xdrx_points_offset (cons (- d) npts));_ Bug
)
(make-extline npts)
)
)
)
(princ)
)