(已解决)50元求修改代码~事成之后直接支付宝转账
本帖最后由 wuwubaibai 于 2021-1-8 00:02 编辑https://i.servimg.com/u/f66/20/27/23/87/1cs510.jpghttps://i.servimg.com/u/f66/20/27/23/87/1cs1010.jpg小弟在网络上找到一个想在圆心替换图块后炸开~炸开后的文字大小比例可以选取图框(撷取图框比例)或直接输入比例所以 acx为一变量~卡关了~~烦请各位大大帮小弟修改一下感激不尽~谢谢~以下有大大讲明不知我想要的成果因无法上传照片或档案到此~显示档案过大所以只能口述
请大大们只要一个图块框~加一个带有文字的图块~使用下面代码便知道成果了麻烦大大们~再次感谢附上我自行综合许多大大的源码修改成现用的源码
(defun ax:getboundingbox (entname / entpl entprptlist) (vla-getboundingbox (vlax-ename->vla-object entname) 'entpl 'entpr)(setqptlist (mapcar 'vlax-safearray->list (list entpl entpr)))(mapcar'(lambda (x) (trans x 0 1)) ptlist))(defun getentdxf (ent dxf)(cond ((= (typeent) 'ename) (cdr(assoc dxf (entget ent '("*")))) ) ((= (typeent) 'vla-object) (cdr(assoc dxf (entget (vlax-vla-object->ename ent) '("*")))) )))(setq *en2obj* vlax-ename->vla-object)
(defun c:M3-TP (/ ss en elist p0 rad p1 sc entdataentgrp entname n ptlist scale GET IST) (setvar"cmdecho" 0) (command"._undo" "_begin") (if (setq ss(ssget '((0 . "circle"))))(progn (setq n-1) (repeat (sslengthss) (setq en(ssname ss (setq n (1+ n)))) (setqelist (entget en)) (setq pt(cdr (assoc '10 elist))) (entdelen) (command"insert" "C:\\lisp\\\工具选项板图块\\\攻牙\\\M3.dwg"pt "" "" "");; (command"explode" "l") ;炸开插入的图块 );; repeat);;progn );; if(if (setqentname (entsel "\n请选择图框")) (if (="INSERT" (getentdxf (car entname) 0)) (progn (command "zoom" "o" (car entname) "") (setqptlist (ax:getboundingbox (car entname))) (setqentgrp (ssget "W" (car ptlist) (cadr ptlist) '((8 ."*TEXT")))) (setqscale (vla-get-XScaleFactor (*en2obj* (car entname)))) (repeat (setq n (sslength entgrp)) (setq entname (ssname entgrp (setq n (1- n)))) (cond ((wcmatch (getentdxf entname 0) "*TEXT") (vla-put-Height (*en2obj* entname) (* scale 3 (getvar"textsize") )) ) ) ) ) )) (command"._undo" "_end") (setvar"cmdecho" 1) (princ))
而自己又想增加的源码如下(defun c:M4-TP (/ ss en elist p0 rad p1 sc entdataentgrp entname n ptlist scalescaleget) (setvar"cmdecho" 0) (command"._undo" "_begin") (if (setq ss(ssget '((0 . "circle"))))(progn (setq n -1) (repeat(sslength ss) (setq en(ssname ss (setq n (1+ n)))) (setqelist (entget en)) (setq pt(cdr (assoc '10 elist))) (entdelen) (command"insert" "C:\\lisp\\\工具选项板图块\\\攻牙\\\M4.dwg"pt "" "" "");; (command"explode" "l") ;炸开插入的图块 );; repeat);;progn );; if;以下想增加一个判断与手动输入比例(if (setqentname (entsel "\n请选择图框或输入比例")) (if (=scaleget nil) (progn (setq sc acx) ) (progn (setq scentname) ) ) ;以上想增加一个判断与手动输入比例 (if (="INSERT" (getentdxf (car entname) 0)) (progn (command "zoom" "o" (car entname) "") (setqptlist (ax:getboundingbox (car entname))) (setq entgrp (ssget "W" (carptlist) (cadr ptlist) '((8 . "*TEXT")))) (setqscale (vla-get-XScaleFactor (*en2obj* (car entname)))) (repeat (setq n (sslength entgrp)) (setq entname (ssname entgrp (setq n (1- n)))) (cond ((wcmatch (getentdxf entname 0) "*TEXT") (vla-put-Height (*en2obj* entname) (* scale 3 (getvar"textsize") )) ) ) ) ) )) (command"._undo" "_end") (setvar"cmdecho" 1) (princ))
没太明白你要改什么比例，要改整个块的比例就在炸开前调整；要改文字大小的话先获取块的范围 cghdy 发表于 2021-1-5 09:11
没太明白你要改什么比例，要改整个块的比例就在炸开前调整；要改文字大小的话先获取块的范围
大大，我想做的事是想图块插入后炸开，而后开孔不变，开孔旁边注记的文字可以依图框比例或自行输入比例改变大小，如M5开孔为4.2旁边会注记M5 ，所以插入后4.2是不变的，变大的是M5这个文字，方便人阅读，目前我只能选图框方式不能输入比例，而点选图框也不尽人意，没点到图框的话就比例直接是1了，这不理想，当没点选到图框，应请重新点选，烦请大大帮忙 wuwubaibai 发表于 2021-1-5 12:36
大大，我想做的事是想图块插入后炸开，而后开孔不变，开孔旁边注记的文字可以依图框比例或自行输入比例改 ...
你最好是以dwg文件的形式呈现你的想法。隔行如隔山，没明白你描述的具体功能。 看不懂你想干嘛。。。
你直接上传个dwg文件，里面包含修改前的图，修改后的图，修改要求。这样别人才好帮助你修改程序。 看后一脸懵逼 cghdy 发表于 2021-1-6 13:52
你最好是以dwg文件的形式呈现你的想法。隔行如隔山，没明白你描述的具体功能。
大大~不是我不想上传照片及档案~是传不上论坛~用过1台笔电2台桌电..2支手机..1台ipad均无法上传成功~连照片都传不上呀 fl202 发表于 2021-1-6 14:33
看不懂你想干嘛。。。
你直接上传个dwg文件，里面包含修改前的图，修改后的图，修改要求。这样别人才好帮 ...
大大~无法上传档案及照片~都显示档案太大~就算1K也传不上..所以只好文字说明 没看明白大大要的是啥东西
页:
[1]