雨的节奏 发表于 2020-3-28 20:29:42

线批量变粗功能 源码

(defun c:xk (/ SS DIS VLX ENDATA TYP PTS PTE LST)
;(if (null (setq ss (car (gsssget "请选择要改变线宽的线" "0_*E,arc")))) (exit))
(setq ss (ssget))
(setq ss (ssget->ename-list ss));自己写函数
(setq dis (getdist "\n请输入线的宽度"))
(foreach x ss
      (setq vlx (vlax-ename->vla-object x)
            endata (entget x)
            typ (cdr (assoc 0 endata))
            pts (vlax-curve-getstartpointvlx)
            pte (vlax-curve-getendpointvlx)
            lst (mapcar '(lambda (x)
                  (vlax-get-property vlx x))
                  (list'Layer 'Linetype 'LinetypeScale 'color)))
      (cond
      ((= "LINE" typ)
      (progn
          (entmake
          (list '(0 . "LWPOLYLINE")
                '(100 . "AcDbEntity")
                '(100 . "AcDbPolyline")
                (cons 90 2)
                (cons 10 pts)
                (cons 10 pte)
                )
            );end enmake
          (mapcar '(lambda (x y)
                   (vlax-put-property(vlax-ename->vla-object (entlast)) x y))
                   (list 'Layer 'Linetype 'LinetypeScale 'color) lst)
          (vlax-put-property (vlax-ename->vla-object (entlast)) 'ConstantWidthdis)
          (entdel x)
      ));end condline
      ((= "CIRCLE" typ)
         (progn
         (circle_ploy endata)
         (mapcar '(lambda (x y)
                   (vlax-put-property(vlax-ename->vla-object (entlast)) x y))
                   (list 'Layer 'Linetype 'LinetypeScale 'color) lst)
          (vlax-put-property (vlax-ename->vla-object (entlast)) 'ConstantWidthdis)
          (entdel x)
         ));end conrcircle
      ((= "LWPOLYLINE" typ)(vlax-put-property vlx 'ConstantWidthdis))
         (T
         (progn
         (setvar "PEDITACCEPT" 1)
         (vl-cmdf"._pedit" x "")
         (mapcar '(lambda (x y)
                   (vlax-put-property(vlax-ename->vla-object (entlast)) x y))
                   (list 'Layer 'Linetype 'LinetypeScale 'color) lst)
          (vlax-put-property (vlax-ename->vla-object (entlast)) 'ConstantWidthdis)
          ;(entdel x)
         ));end conrcircle
      
      );end cond
      
      
);end foreach
(princ "\n***********************完成*********GS石材自动下单软件 出品 程序订制 老蒋179174787*********")
(prin1)
)
;;圆转多段线
(defun circle_ploy (entlst / NORM CENTER R PRO_X)
    (setq norm(assoc 67 entlst) ;图形在模型空间或图纸空间
          center (assoc 10 entlst) ;圆心
          r(cdr (assoc 40 entlst)) ;半径
          pro_x(assoc 210 entlst) ;X轴拉伸方向
          ) ;_ 结束setq
    (entmake
   (list
   '(0 . "LWPOLYLINE")
   '(100 . "AcDbEntity")
   norm
   '(410 . "Model")
   '(100 . "AcDbPolyline")
   '(90 . 3)
   '(70 . 0)
   '(43 . 0.0)
   '(38 . 0.0)
   '(39 . 0.0)
   (list 10 (cadr center) (- (caddr center) r))
   '(40 . 0.0)
   '(41 . 0.0)
   '(42 . 1.0)
   '(91 . 0)
   (list 10 (cadr center) (+ r (caddr center)))
   '(40 . 0.0)
   '(41 . 0.0)
   '(42 . 1.0)
   '(91 . 0)
   (list 10 (cadr center)(- (caddr center) r))
   '(40 . 0.0)
   '(41 . 0.0)
   '(42 . 0.46903)
   '(91 . 0)
   pro_x
      ) ;_ 结束list
   );end entmake
) ;_ 结束defun
(PRIN1)

雨的节奏 发表于 2020-3-28 20:33:17




magicheno 发表于 2020-3-29 01:22:43

本帖最后由 magicheno 于 2020-3-29 01:26 编辑

感谢大神啊，很有用的~~~！！！   源码咋用不了

雨的节奏 发表于 2020-3-29 07:57:12

magicheno 发表于 2020-3-29 01:22
感谢大神啊，很有用的~~~！！！   源码咋用不了

ssget->ename-list这个函数自己写

fxlt619 发表于 2020-3-29 10:26:41

啊哦？都放出来吧。不会啊

magicheno 发表于 2020-3-29 12:24:05

雨的节奏 发表于 2020-3-29 07:57
ssget->ename-list这个函数自己写

写不来

雨的节奏 发表于 2020-3-29 13:37:00

magicheno 发表于 2020-3-29 12:24
写不来

(defun ssget->ename-list (ss / i ename lst)
    (setq i -1)
    (while (setq ename (ssname ss (setq i (1+ i))))
      (setq lst (cons ename lst))
    )
    lst
)

忙出一个未来 发表于 2020-3-29 21:51:55

PE M W.简单几个操作，不用上插件吧

菜卷鱼 发表于 2020-3-31 09:15:37

搞那么复杂，为什么不用 (command "chprop" ) ？？？
页: [1]
查看完整版本: 线批量变粗功能 源码