(已解决)50元求修改代码~事成之后直接支付宝转账

wuwubaibai

[img][/img][img][/img]

小弟在网络上找到一个想在圆心替换图块后炸开~炸开后的文字大小比例可以选取图框(撷取图框比例)或直接输入比例所以 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 scale  scaleget)

(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 sc  entname)

               )

        )

;以上想增加一个判断与手动输入比例

    (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

没太明白你要改什么比例，要改整个块的比例就在炸开前调整；要改文字大小的话先获取块的范围

wuwubaibai

cghdy 发表于 2021-1-5 09:11
没太明白你要改什么比例，要改整个块的比例就在炸开前调整；要改文字大小的话先获取块的范围

大大，我想做的事是想图块插入后炸开，而后开孔不变，开孔旁边注记的文字可以依图框比例或自行输入比例改变大小，如M5开孔为4.2旁边会注记M5 ，所以插入后4.2是不变的，变大的是M5这个文字，方便人阅读，目前我只能选图框方式不能输入比例，而点选图框也不尽人意，没点到图框的话就比例直接是1了，这不理想，当没点选到图框，应请重新点选，烦请大大帮忙

cghdy

wuwubaibai 发表于 2021-1-5 12:36
大大，我想做的事是想图块插入后炸开，而后开孔不变，开孔旁边注记的文字可以依图框比例或自行输入比例改 ...

你最好是以dwg文件的形式呈现你的想法。隔行如隔山，没明白你描述的具体功能。

fl202

看不懂你想干嘛。。。
你直接上传个dwg文件，里面包含修改前的图，修改后的图，修改要求。这样别人才好帮助你修改程序。

qmqyqj

看后一脸懵逼

wuwubaibai

cghdy 发表于 2021-1-6 13:52
你最好是以dwg文件的形式呈现你的想法。隔行如隔山，没明白你描述的具体功能。

大大~不是我不想上传照片及档案~是传不上论坛~用过1台笔电2台桌电..2支手机..1台ipad均无法上传成功~连照片都传不上呀

wuwubaibai

fl202 发表于 2021-1-6 14:33
看不懂你想干嘛。。。
你直接上传个dwg文件，里面包含修改前的图，修改后的图，修改要求。这样别人才好帮 ...

大大~无法上传档案及照片~都显示档案太大~就算1K也传不上..所以只好文字说明

love_cq

没看明白大大要的是啥东西