请教点击两个块（基本为同名块） 中间定数等分

xj6019

行吧，那就选点吧，上面我贴的那个代码，能不只是水平吗，可以改成任意方向不，还有你的代码为什么加载会错误啊，能更新一下吗，两个都能用了最好，我试用一下，哪个顺手最后用哪个吧

start4444

如果你的图块是标准没乱搞的肯定是等分那个好用，我加载没错，不知道你什么原因

(defun c:tt5  (/ ang en pt1 pt2 ptx sl xfx zljl)
(setvar 'cmdecho 0)
(setq en (car(entsel "\n选择对象:")))
(setq pt1 (getpoint "\n指定第一点:"))
(setq pt2 (getpoint pt1 "\n指定第二点:") ang (angle pt1 pt2))
(setq sl (getint "输入间隔数<2>:") )
(if (not sl) (setq sl 2))
(setq zljl (/ (distance pt1 pt2) sl))       
(repeat (1- sl) (command "COPY" en "" "non" pt1 "non" (setq ptx (polar pt1 ang zljl)))
(setq pt1 ptx en (entlast)))       
(setvar 'cmdecho 1)
(princ)
)

xj6019

start4444 发表于 2020-3-12 15:54
如果你的图块是标准没乱搞的肯定是等分那个好用，我加载没错，不知道你什么原因

(defun c:tt5  (/ ang e ...

你的代码知道什么原因了，普通块是没问题的，我试过了，但是我需要等分的都是动态块，可否代码稍微变动一下，支持一下动态块啊

xj6019

说错了，是动态块不行，上面图片是我自己制作的几个自己比较常用的三个动态块。

顺便试了一下属性块，好像也不行。求帮助，主要用于上面三个形状，每天都用，属性块基本用不到吧

xj6019

start4444 发表于 2020-3-11 22:11
出错应该是块名匿名了，动态块就还是用复制吧，有多种形态不好判断，只要你两个块一样就没啥问题。
(def ...

试过了，同名的已经全部没有问题了，如果两端不重名就没法捕捉中点，位置和期望的不同，因此换个思路试试，以下代码是论坛里面你的代码，在此基础上略微变一下好吗，选取一根直线，两端固定缩短各50，中间部分等分，运行的话，选线，输入间隔数，回车完成！插入的块代码里面临时起名aabb  我自己改就行，这样应该更好用一点，如果能判断两端是否有重叠的只保留一个，多余的删掉，能做到最好，今天有耽误你不少时间，谢谢了！

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=179362&highlight=%CB%F5%B6%CC

(defun c:tt5 ()
        (vl-load-com)
        (setq dd (getdist "\n输入头尾缩短距离：") dd2 (getdist "\n输入最大间隔距离：") bname (cdr (assoc 2 (entget (car (entsel "\n请选取图块："))))))
        (setq en (car (entsel "\n请选取多段线：")) ent (entget en) plist (vertexs en) p1 (car plist) plast (last plist) p2 (cadr plist))
        (setq obj (vlax-ename->vla-object  en))
        (setq zd (abs (- (vlax-curve-getDistAtPoint obj p1) (vlax-curve-getDistAtPoint obj plast))) zdnew (- zd (* dd 2)))
        (setq i 1)
  (while (> (/ zdnew i) dd2 (setq i (1+ i))))
        (setq med (/ zdnew i))
        (entmake (list '(0 . "CIRCLE") (cons 10 p1) (cons 40 dd) (cons 62 8))) (setq cr1 (entlast))
  (entmake (list '(0 . "CIRCLE") (cons 10 plast) (cons 40 dd) (cons 62 8))) (setq crlast (entlast))
        (command "copy" en "" "non" (list 0 0) "non" (list 0 0) "TRIM" cr1 crlast "" (list en p1)  (list en plast) "" )
        (command "MEASURE" en "B" bname "Y" med "INSERT" bname "non" (cdr (assoc 10 (entget en))) "" "" "non" p2 "ERASE" en cr1 crlast "")
        (princ)
)
;;多段线顶点表
(defun vertexs (ename / plist pp n)
  (setq obj (vlax-ename->vla-object ename))
  (setq plist (vlax-safearray->list
                                                                (vlax-variant-value
                                                                        (vla-get-coordinates obj))))
  (setq n 0)
  (repeat (/ (length plist) 2)
    (setq pp (append pp (list (list (nth n plist)(nth (1+ n) plist)))))
    (setq n (+ n 2))
  )
  pp
)

bai2000

不知道什么原因，好多程序只支持多义线，不支持单条直线？

start4444

xj6019 发表于 2020-3-12 17:50
试过了，同名的已经全部没有问题了，如果两端不重名就没法捕捉中点，位置和期望的不同，因此换个思路试试 ...

根据昨天那几段代码完全就能搞出来了：根据直线两端点算出缩短的两头点，再套两点那段代码进去就成了

999999

谢谢各位大神的讨论，以及楼主的想法，，想法越多，工作起来就越轻松