aggdqty 发表于 2023-3-21 23:08:20

单线变双线,保留原线为中心线

本帖最后由 aggdqty 于 2023-3-24 17:10 编辑

附件是论坛一位大神写的单线变双线的程序，麻烦帮修改一下，将原线变成中心线，线形为cnter,颜色为1，谢谢。

[*](defun c:Sx (/ getds0 obj)
[*](if (null vlax-dump-object) (vl-load-com) )
[*](SETVAR "CMDECHO" 0)
[*](or *getds* (setq *getds* 90))
[*](setq getds0 (getdist (strcat"\n输入宽度<"(rtos *getds* 2 3)">：")))
[*](if getds0 (setq *getds* getds0))
[*](while (setq obj (entsel))
[*]    (setq obj (vlax-ename->vla-object(car obj)))
[*]    (vla-offset obj (* 0.5 *getds*))
[*]    (vla-offset obj (* 0.5 *getds* -1))
[*])
[*](SETVAR "CMDECHO" 1)
[*](princ)
[*])




已调好，感谢各位

liuhe 发表于 2023-3-22 08:50:31

(defun c:Sx (/ ACADOBJECT ACADDOCUMENT FOUND LINETYPESEL GETDS0 OBJ)
(setq        AcadObject       (vlax-get-acad-object)
        　　AcadDocument (vla-get-ActiveDocument Acadobject)
)
(setq found :vlax-false)
(setq LinetypeSel (vla-get-Linetypes AcadDocument))　
(VLAX-FOR entry LinetypeSel　
    (IF        (= (VLA-GET-NAME ENTRY) "CENTER")
      　　
      (SETQ FOUND :VLAX-TRUE)
    )
)
(IF (= FOUND :VLAX-FALSE)　　
    (VLA-LOAD LINETYPESEL "CENTER" "ACAD.LIN")
)
(if (null vlax-dump-object)
    (vl-load-com)
)
(SETVAR "CMDECHO" 0)
(or *getds* (setq *getds* 90))
(setq
    getds0 (getdist (strcat "\n输入宽度<" (rtos *getds* 2 3) ">："))
)
(if getds0
    (setq *getds* getds0)
)
(while (setq obj (entsel))
    (setq obj (vlax-ename->vla-object (car obj)))
    (vla-offset obj (* 0.5 *getds*))
    (vla-offset obj (* 0.5 *getds* -1))
    (vla-put-color obj 1)
    (vla-put-Linetype Obj "CENTER")
)
(SETVAR "CMDECHO" 1)
(princ)
)

wzg356 发表于 2023-3-22 22:02:46

本帖最后由 wzg356 于 2023-3-22 22:05 编辑

(defun c:sx ( / e ps p)
(if(setq e(ssget ":E:S" '((0 . "*line"))))(progn
      (setq e(ssname e 0))
      (setq ps(outcurvept e))
      (setq d(if(setq d(getdist "\n输入偏移宽度<20>"))d 20))
      (setvar "cmdecho" 0)
      (vl-cmdf "mline" "j" "z" "ST" "STANDARD" "S" d)
      (foreach p ps (vl-cmdf "non" p))
      (vl-cmdf "")
      (vl-cmdf"change" e "" "p" "lt" "CENTER" "c" "1" "")
      (setvar "cmdecho" 1)
))(princ)
)

函数outcurvept在http://bbs.mjtd.com/thread-182691-1-1.html

aggdqty 发表于 2023-3-24 13:23:05

wzg356 发表于 2023-3-22 22:02
(defun c:sx ( / e ps p)
(if(setq e(ssget ":E:S" '((0 . "*line"))))(progn
      (setq e(ssname e...

谢谢            

vitalgg 发表于 2023-3-22 09:16:33

本帖最后由 vitalgg 于 2023-3-22 09:20 编辑

https://www.bilibili.com/video/BV1Jv4y157X3/



源码：
https://gitee.com/atlisp/packages/blob/main/at-curve/at-curve.lsp
最底下那个函数。

aggdqty 发表于 2023-3-22 09:22:51

liuhe 发表于 2023-3-22 08:50


谢谢。如果改变中心线的图层怎么设置

aggdqty 发表于 2023-3-22 09:26:36

vitalgg 发表于 2023-3-22 09:16
https://www.bilibili.com/video/BV1Jv4y157X3/




谢谢，                                 

Klein 发表于 2023-3-22 14:48:27

liuhe 发表于 2023-3-22 08:50


16-18行的加载扩展库放在第二行是不是好一点啊，前面已经用到了vlax函数了，如果没加载可能会报错的吧

liuhe 发表于 2023-3-22 15:08:09

Klein 发表于 2023-3-22 14:48
16-18行的加载扩展库放在第二行是不是好一点啊，前面已经用到了vlax函数了，如果没加载可能会报错的吧

我就随便复制了组合代码，没思考这么多

aggdqty 发表于 2023-3-22 15:39:28

liuhe 发表于 2023-3-22 08:50


报语法错误

p-3-ianlcc 发表于 2023-3-22 15:51:32

奇怪，我运行是正常的～没有报错误～

广易精通 发表于 2023-3-22 20:12:52

aggdqty 发表于 2023-3-22 09:22
谢谢。如果改变中心线的图层怎么设置

(vla-put-layer obj "DOTE")
页: [1] 2
查看完整版本: 单线变双线,保留原线为中心线