请教一个统一左上角起点的问题

本帖最后由 434939575 于 2014-5-6 14:26 编辑

请教一个问题，目标是统一变起点为左上角。批量时出乱了，感觉是图元之间表没有分离，合到一起了。
请大师帮帮忙，感谢！
(defun C:tt (/ ss ename elist ptlist ) ;多段线左上角为起始点，
(setq ss (ssget))
(setq i 0)
(repeat (sslength ss)
(setq ss0 (ssname ss i)
ss0-en (entget ss0)
i (1+ i)
)
(foreach n ss0-en
(if (= 10 (car n))
(setq ptlist
(cons
(cdr n)
ptlist
)
)
) ;if
) ;foreach
(reverse ptlist)
(setq list-y
(vl-sort ptlist
(function (lambda (e1 e2) (> (cadr e1) (cadr e2))))
)
)
;;;Y----小到大;
(setq y-1 (car list-y))
;;;Y----第一个点;
(setq y-2 (cadr list-y))
;;;Y----第二个点;
(setq list-y++ (append (list y-1) (list y-2)))
;;;Y----第一二个点组合;
(setq memb-1
(car
(vl-sort list-y++
(function (lambda (e1 e2) (< (car e1) (car e2))))
)
)
)
;;;Y--表里面重新排列取靠左边的点;
(setq lst-ab (member memb-1 ptlist))
(setq lst-cd (reverse (cdr (member memb-1 (reverse ptlist)))))
(setq list-ok (append lst-ab lst-cd))
(command "circle" memb-1 500 "");此圆用于测试起点的位置
(Make-LWPOLYLINE list-ok )
);repeat
(command "_.erase" ss "");删除原始的图元
)
;;164.31 [功能] 点表生成多段线
(defun Make-LWPOLYLINE (lst / PT )
(entmake (append (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 (length lst)) ;端点数量
'(70 . 1) ;关闭图形
)
(mapcar '(lambda (pt) (cons 10 pt)) lst)
)
)
)

请教一个问题，目标是统一变起点为左上角。批量时出乱了，感觉是图元之间表没有分离，合到一起了。 
请大师帮帮忙，感谢！ 
(defun C:tt (/ ss ename elist ptlist   )  ;多段线左上角为起始点， 
  (setq ss (ssget)) 
  (setq i 0) 
  (repeat (sslength ss) 
    (setq ss0   (ssname ss i) 
    ss0-en (entget ss0) 
    i   (1+ i) 
    ) 
    (foreach n ss0-en                     
      (if (= 10 (car n)) 
                              
   
  (setq ptlist 
         (cons    
     (cdr n) 
     ptlist 
         ) 
  ) 
      )  ;if 
    )  ;foreach 
    (reverse ptlist) 
    (setq list-y 
     (vl-sort ptlist 
        (function (lambda (e1 e2) (> (cadr e1) (cadr e2)))) 
     ) 
    ) 
;;;Y----小到大; 
    (setq y-1 (car list-y)) 
;;;Y----第一个点; 
    (setq y-2 (cadr list-y)) 
;;;Y----第二个点; 
    (setq list-y++ (append (list y-1) (list y-2))) 
;;;Y----第一二个点组合; 
    (setq memb-1 
     (car 
       (vl-sort list-y++ 
          (function (lambda (e1 e2) (< (car e1) (car e2)))) 
       ) 
     ) 
    ) 
;;;Y--表里面重新排列取靠左边的点;       
    (setq lst-ab (member memb-1 ptlist)) 
    (setq lst-cd (reverse (cdr (member memb-1 (reverse ptlist)))))          
    (setq list-ok (append lst-ab lst-cd))    
    (command "circle" memb-1 500 "");此圆用于测试起点的位置 
 
    (Make-LWPOLYLINE list-ok  ) 
  );repeat 
   (command "_.erase" ss "");删除原始的图元 
) 
;;164.31 [功能] 点表生成多段线 
(defun Make-LWPOLYLINE (lst /  PT ) 
  (entmake (append (list '(0 . "LWPOLYLINE") 
       '(100 . "AcDbEntity") 
       '(100 . "AcDbPolyline") 
       (cons 90 (length lst)) ;端点数量 
       '(70 . 1)  ;关闭图形 
       ) 
       (mapcar '(lambda (pt) (cons 10 pt)) lst) 
 
 
     ) 
  ) 
)

网友答: 每次循环，ptlist 没有重置吧

网友答: 谢谢指点，先尝试看看。

网友答: 记下，到时候可能有用

网友答: 楼主，批量改起点解决了吗，

网友答:

hbxymx 发表于 2025-7-2 07:26
楼主，批量改起点解决了吗，

这个不难，我没有弄这些了。模型界好像塌了吧。哈哈

网友答:

434939575 发表于 2025-7-31 10:26
这个不难，我没有弄这些了。模型界好像塌了吧。哈哈

我这种小型的公司，自己家房子不用出房租，各种工种我一个人都能搞，成本把控一下，还能生存，一般中等的只会做房地产模型公司现在都没有什么固定制作人了。

网友答:

hbxymx 发表于 2025-8-20 15:28
我这种小型的公司，自己家房子不用出房租，各种工种我一个人都能搞，成本把控一下，还能生存，一般中等的 ...

我们那里也有这种的，不养人，有事久叫人帮忙，模型人舍不得花钱，那时我打算nong一套雕刻按顺序走刀的程序，
后来美弄了，

网友答: 花了100，找人写了一个，批量改起点，

网友答:

hbxymx 发表于 2025-10-18 20:22
花了100，找人写了一个，批量改起点，

100倒也不贵，我那时候打算弄一个直接出雕刻文件，
像窗线直接按顺序刻，百叶不会中间鼓，没有市场，没人
花钱。

上一篇：（更新版本B）文字连线

下一篇：没有了