动态绘制闭合多边形---奇怪的现象---增加对象反应器以后，框内图元随多边形同步拉伸
本帖最后由 masterlong 于 2022-3-28 23:21 编辑正在编一个略微有点复杂的程序
远远没有完工
其中某个片段感觉还有点意思
先单独摘出来共享一下
源码放二楼
;=============================
给多边形增加了对象反应器以后
发生奇怪的事情
框内图元随对象拉伸操作同步拉伸
谁能解释下？
------------------------------------------------------------
上面的问题目前无解
怀疑是CAD的BUG
现在只有一个曲线救国的办法
框内目标图元全部复制原件删除
(defun c:tt()
(if (setq ent (car (entsel))
*ent2obj*vlax-Ename->Vla-Object
*obj2ent*vlax-vla-object->ename
*acad* (vlax-get-acad-object)
)
(setq dbpl_obj_Reactor (vlr-object-reactor (list (vlax-Ename->Vla-Object ent)) "" '((:vlr-modified . about_fw_xfs))))
)
)
;;对象反应器
(defun about_fw_xfs( theobj reactor parameter-list )
;;是否已删除
(if (*obj2ent* theobj)
;
;有个奇怪的现象，为啥框内图元会随着多边形的拉伸操作(STRETCH命令拉伸多边形的某一段)，同步执行“拉伸” ？？？？？？？？？
;
(progn
(zoomsave)
(setq theplent (*obj2ent* theobj))
(setq box (entbox theplent))
(zoomptlist box 1.5)
(setq theplptlist (massoc 10 theplent))
(setq ss (ssget "cp" theplptlist '((0 . "CIRCLE") (8 . "0") (62 . 3))))
(if ss
(princ (strcat "\n多边形内找到【 " (itoa (sslength ss)) " 】" ))
(princ "\n多边形内找到【 0 】")
)
(zoomload)
)
)
(princ)
)
;999当前视窗save
(defun zoomsave()
(setq zoom*savelist (list (getvar "ctab") (vlax-3D-Point (trans (getvar "viewctr") 1 0)) (getvar "viewsize")))
)
;999当前视窗load
(defun zoomload()
(if zoom*savelist
(progn
(setvar "ctab" (car zoom*savelist))
(vla-ZoomCenter (vlax-get-acad-object) (trans (cadr zoom*savelist) 0 1) (caddr zoom*savelist))
)
)
)
;;单个物体的最小（正交）包围框---------------------------------这个程序在遇到无法显示的图元时，还是会出错的，比如形。天正图元会不会也不支持，未测试
(defun entbox ( ent / ll ur )
(vla-getboundingbox (*ent2obj* ent) 'll 'ur)
(mapcar 'vlax-safearray->list (list ll ur))
)
;999以指定点表的包围框中心，缩放窗口——————主要用来保证后续可执行 (ssget 'CP/'WP ptlist)
(defun zoomptlist( ptlist sc / box x midpo )
(setq box (npt2box ptlist))
(setq midpo (getmidpo box))
(vla-zoomwindow *acad* (vlax-3d-point (car box)) (vlax-3d-point (cadr box)))
(vla-ZoomScaled *acad* (/ 1.0 sc) 1)
)
;999公共函数
;;求n个点的正交包围框
;;(setq npt (list p1 p2 p3 p4 ... ))
(defun npt2box( npt )
(list
(apply 'mapcar (cons 'min npt))
(apply 'mapcar (cons 'max npt))
)
)
;999公共函数
;;求点对中点
(defun getmidpo( pts / P1 P2 X Y )
(setq p1 (car pts) p2 (cadr pts))
(if (= (length p1) (length p2))
nil
(setq p1 (list (car p1) (cadr p1))
p2 (list (car p2) (cadr p2))
)
)
(mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) P1 P2)
)
本帖最后由 masterlong 于 2021-12-29 18:49 编辑
;;dbx````动态绘制一个闭合的多边形.lsp
(defun c:dbx()
(princ "dbx````动态绘制一个闭合的多边形，需要至少输入3个点....")
(setq oldosmode (getvar "osmode"))
(command "undo" "g")
(if (and
(setq p1 (getpoint "\n指定第1点 : "))
(setvar "orthomode" 0)
(setq p2 (getpoint p1 "\n指定第2点 : "))
(setq ptlist (list p2 p1))
(princ "\n")
(if dyngrco dyngrco (setq dyngrco 7))
)
(progn
(setq yn_rppt NIL)
(setvar "osmode" 0)
(setq loop T)
(while loop
(princ "\r指定下一点 : ")
(setq gr (grread T 15 2))
(setq grpt (cadr gr)
mode (cargr)
)
;;pickbox的大小```因为视窗大小在变化，所以dist的具体数值也是变化的
(setq dist (* (/ (getvar "pickbox") (cadr (getvar "screensize"))) (getvar "viewsize")))
(cond
((= mode 5) (db_dbx_5_grpt)) ;;动态多边形
((= mode 3) (db_dbx_3_putapt)) ;;左键定点
((or (= mode 11)(= mode 2)) (db_dbx_11_rightclick)) ;;右键结束
( T (setq loop NIL) (redraw)) ;;其它中止
)
)
)
)
(princ)
)
;1`1动态多边形
(defun db_dbx_5_grpt()
(redraw)
(setq grptlist (cons grpt ptlist))
;;动态多边形时，若鼠标移至ptlist某一点时，自动取代这个点【貌似ok】
(db_dbx_5_autorppt)
(grdraw_pline_co ptlist dyngrco)
(grdraw p1 grpt 6 1)
(grdraw p2 grpt 6 1)
)
;1`2左键定点
(defun db_dbx_3_putapt()
(redraw)
(setq p3 grpt)
(setq p2 p3)
(setq ptlist (cons p3 ptlist))
(grdraw_pline_co ptlist dyngrco)
(setq yn_rppt NIL) ;;每次定点，重置自动取代
)
;1`3右键结束
(defun db_dbx_11_rightclick()
(redraw)
(emkpline ptlist dyngrco)
(setq loop NIL)
)
;1`1`1动态多边形时，若鼠标移至ptlist某一点时，自动取代这个点
(defun db_dbx_5_autorppt()
;;动态坐标超过一定距离以后，自动取代功能生效
(if (>= 3 (length grptlist))
(setq yn_rppt NIL)
(if (< (* 5 dist) (distance grpt p2)) (setq yn_rppt T))
)
(if yn_rppt
(if (setq tmp (vl-some ''((pt) (< (distance grpt pt) (* 0.5 dist))) ptlist))
(progn
(setq rept (car (vl-sort ptlist ''((a b) (< (distance grpt a) (distance grpt b))))))
(setq id (vl-position rept ptlist))
(setq biao1 (listsub ptlist 0 id)
biao2 (listsub ptlist (1+ id) (length ptlist))
)
(setq ptlist (append biao2 biao1))
(setq p1 (last ptlist)
p2 (carptlist)
)
;;生效一次以后，自动取代功能失效
(setq yn_rppt NIL)
)
)
)
)
;;按指定颜色生成闭合PL线````70必须在90后面
(defun emkpline( pts co )
(entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 62 co) (cons 90 (length pts)) '(70 . 1))
(mapcar '(lambda (pt)(cons 10 pt)) pts)
)
)
)
;;一个坐标集绘制虚拟闭合线
(defun grdraw_pline_co( pts co / ucspts p1 p2 )
(setq ucspts pts)
(mapcar ''((p1 p2) (grdraw p1 p2 co 0)) (cdr ucspts) ucspts)
(grdraw (car ucspts) (last ucspts)2 1)
)
;;截取列表的一部分i=目标子元素的idlen=截取的子表个数`````待优化
(defun listsub ( biao i len / a temp one )
(if (and
(= (type i) 'INT)
(>= i 0)
)
(progn
(if (or (null len) (< len 0))
(setq len (length biao))
)
(setq a 0)
(setq temp '())
(repeat (length biao)
(setq one (car biao))
(setq biao (cdr biao))
(if (and (>= a i) (< a (+ len i)))
(setq temp (cons one temp))
)
(setq a (1+ a))
)
(setq biao '())
(repeat (length temp)
(setq one (car temp))
(setq temp (cdr temp))
(setq biao (cons one biao))
)
)
)
)
谢谢
2楼也已更新
;;截取列表的一部分i=目标子元素的idlen=截取的子表个数
(defun listsub ( biao i len / a temp one )
(if (and
(= (type i) 'INT)
(>= i 0)
)
(progn
(if (or (null len) (< len 0))
(setq len (length biao))
)
(setq a 0)
(setq temp '())
(repeat (length biao)
(setq one (car biao))
(setq biao (cdr biao))
(if (and (>= a i) (< a (+ len i)))
(setq temp (cons one temp))
)
(setq a (1+ a))
)
(setq biao '())
(repeat (length temp)
(setq one (car temp))
(setq temp (cdr temp))
(setq biao (cons one biao))
)
)
)
)
本帖最后由 masterlong 于 2021-12-28 20:01 编辑
这样做的现实意义么
跟我在编的这个程序功能有关
火灾自动报警平面设计
有一条规范
一个回路不能超过32个点
考虑预留一般限定在25~28之间
这样就经常需要测算实际绘制的点数
我的程序构想是
动态绘制多边形的同时
计算多边形框内消防点数
由于建筑平面的复杂性
多边形的绘制过程中
反复调整多边形界线的概率比较高
动态取代的功能设置
可以大大减少绘制完成后的二次调整
本帖最后由 masterlong 于 2021-12-28 19:51 编辑
二楼代码的重点
动态绘制时
若鼠标移动到已有某一点的附近时
会自动取消该点
这样比较方便多边形的即时调整
本帖最后由 masterlong 于 2021-12-28 20:06 编辑
整个程序完工以后会共享出来
先把楼占着
动态统计消防点位这个不难
麻烦的是统计数据的实时展示
只靠命令行输出有点难搞
决定上odcl的非模式对话框
同时辅以多边形变色
本帖最后由 masterlong 于 2021-12-28 20:12 编辑
绘制的动态多边形
实际上就是取得一个点集
计划在取得点集以后再增密
这样生成的多边形
便于设计过程的后期调整
同时准备再添加反应器
多边形改变顶点位置以后
自动复核框内点数
目前进度可能不到1/20
期待大作发布！！！ 很棒的一個想法和做法，可以省去很多做圖的時間 就很棒 谢谢分享
先点赞，标记
页:
[1]
2