多段线变多边形

masterlong · 发表于 2022-2-12 13:57:00

ml不好用
道路不止直线还有弧线段

wanhongron · 发表于 2022-2-13 16:33:36

菜卷鱼大侠的思路很好，可是运行显示错误: no function definition: CMD0，麻烦能改成批量执行并能适应任何多段线

wanhongron · 发表于 2022-2-13 16:36:57

烦问下夏大侠，偶尔执行还是会显示错误: 参数类型错误: numberp: nil，另外能否改成能批量执行

cxhhyy · 发表于 2022-2-13 20:38:51

本帖最后由 cxhhyy 于 2022-2-14 05:30 编辑

;;线变矩形
(defun c:jx (/ ss l en sz i lp h a);定义命令
  (if (not $$)
(setq $$ 1) ;设置默认数值
  )
  (if (setq l (getdist (strcat "\n执行心心命令\n线变矩形\n请量取或输入矩形宽度:当前宽度:<" (rtos $$) ">\n")))
(setq $$ l)(setq l $$))
  (princ "\n请选择对象:\n")
  (if (setq ss (ssget '((0 . "LWPOLYLINE,LINE,ARC"))))
(progn (setvar "cmdecho" 0)
         (if (= 8 (logand (getvar "undoctl") 8))
         (command-s "_.UNDO" "e")
         (command-s "_.UNDO" "be"))
         (setq i 0)
         (repeat (sslength ss)
         (setq en (ssname ss i)
               sz (ssadd)
               i  (1+ i))
         (setq lp (mapcar
                     '(lambda (y)
                        (list (vlax-curve-getStartPoint y)
                              (vlax-curve-getEndPoint y)))
                     (mapcar 'car
                              (mapcar
                              '(lambda (x)
                                 (setq o (vlax-invoke (vlax-ename->vla-object en) 'Offset x))
                                 (ssadd (entlast) sz) o)
                              (list (setq h (* 0.5 l)) (- h))))))
         (mapcar
            '(lambda (k l)
               (entmakex (list (cons 0 "LINE") (cons 10 k) (cons 11 l)))
               (ssadd (entlast) sz))
            (car lp)
            (cadr lp))(setvar 'PEDITACCEPT 1)
         (command-s "_.pedit" "m" sz "" "j" 0.0 ""))
         (if (not (setq p (getpoint "\n单击不删除源对象 <空格删除>\n")))
         (command-s "_.ERASE" ss ""))
         (if (= 8 (logand (getvar "undoctl") 8)) (command-s "_.UNDO" "e"))
         (setvar "cmdecho" 1)
         (princ "\n心心命令执行完毕\n!"))
(progn (princ "\n未选择对象!\n")))
  (princ (menucmd "M=$(edtime,$(getvar,date),YYYY.MO.DD HH:MM DDDD )"))
  (princ))
;;

wanhongron · 发表于 2022-2-14 08:37:34

CXHYY大侠的程序非常完美，功能正是我想要的，非常感谢

wanhongron · 发表于 2022-2-14 09:25:22

如果能把生成的多边形全部改为当前图层，区别原来的多段线图层就跟完美了，哪位侠能帮完美一下

cxhhyy · 发表于 2022-2-14 19:33:53

本帖最后由 cxhhyy 于 2022-2-14 19:37 编辑

;;线变矩形
(defun c:jx (/ ss l en sz i lp h a la);定义命令
  (if (not $$)
(setq $$ 1) ;设置默认数值
  )
  (if (setq l (getdist (strcat "\n执行心心命令\n线变矩形\n请量取或输入矩形宽度:当前宽度:<" (rtos $$) ">\n")))
(setq $$ l)(setq l $$))
  (princ "\n请选择对象:\n")
  (if (setq ss (ssget '((0 . "LWPOLYLINE,LINE,ARC"))))
(progn (setvar "cmdecho" 0)
         (if (= 8 (logand (getvar "undoctl") 8))
         (command-s "_.UNDO" "e")
         (command-s "_.UNDO" "be"))
         (setq i 0)
         (repeat (sslength ss)
         (setq en (ssname ss i)
               sz (ssadd)
               i  (1+ i))
         (setq lp (mapcar
                     '(lambda (y)
                        (list (vlax-curve-getStartPoint y)
                              (vlax-curve-getEndPoint y)))
                     (mapcar 'car
                              (mapcar
                              '(lambda (x)
                                 (setq o (vlax-invoke (vlax-ename->vla-object en) 'Offset x))
                                 (ssadd (entlast) sz) o)
                              (list (setq h (* 0.5 l)) (- h))))))
         (mapcar
            '(lambda (k l)
               (entmakex (list (cons 0 "LINE") (cons 10 k) (cons 11 l)))
               (ssadd (entlast) sz))
            (car lp)
            (cadr lp))(setvar 'PEDITACCEPT 1)
         (command-s "_.pedit" "m" sz "" "j" 0.0 "")(setq la (getvar "clayer"))
   (command-s "_.chprop" (entlast) "" "la" la ""))
         (if (not (setq p (getpoint "\n单击不删除源对象 <空格删除>\n")))
         (command-s "_.ERASE" ss ""))
         (if (= 8 (logand (getvar "undoctl") 8)) (command-s "_.UNDO" "e"))
         (setvar "cmdecho" 1)
         (princ "\n心心命令执行完毕\n!"))
(progn (princ "\n未选择对象!\n")))
  (princ (menucmd "M=$(edtime,$(getvar,date),YYYY.MO.DD HH:MM DDDD )"))
  (princ))
;;

wanhongron · 发表于 2022-2-15 08:26:00

非常完美，做工效率高了很多，万分感谢热心cxhhyy大侠

cxhhyy · 发表于 2022-2-15 12:39:35

本帖最后由 cxhhyy 于 2022-2-15 14:26 编辑

wanhongron 发表于 2022-2-15 08:26
非常完美，做工效率高了很多，万分感谢热心cxhhyy大侠

过奖过奖我不会写代码的  我也是在明经找的代码
上面代码遇到编组开始的时候会对操作对象不编组不能一步撤回我修改了一下

;;线变矩形
(defun c:jx (/ ss l en sz i lp h a la);定义命令
  (if (not $$)
(setq $$ 1) ;设置默认数值
  )
  (if (setq l (getdist (strcat "\n执行心心命令\n线变矩形\n请量取或输入矩形宽度:当前宽度:<" (rtos $$) ">\n")))
(setq $$ l)(setq l $$))
  (princ "\n请选择对象:\n")
  (if (setq ss (ssget '((0 . "LWPOLYLINE,LINE,ARC"))))
(progn (setvar "cmdecho" 0)
         (if (= 8 (logand (getvar "undoctl") 8))
         (progn (command-s "_.UNDO" "e") (command-s "_.UNDO" "be"))
         (command-s "_.UNDO" "be"))
         (setq i 0)
         (repeat (sslength ss)
         (setq en (ssname ss i)
               sz (ssadd)
               i  (1+ i))
         (setq lp (mapcar
                     '(lambda (y)
                        (list (vlax-curve-getStartPoint y)
                              (vlax-curve-getEndPoint y)))
                     (mapcar 'car
                              (mapcar
                              '(lambda (x)
                                 (setq o (vlax-invoke (vlax-ename->vla-object en) 'Offset x))
                                 (ssadd (entlast) sz) o)
                              (list (setq h (* 0.5 l)) (- h))))))
         (mapcar
            '(lambda (k l)
               (entmakex (list (cons 0 "LINE") (cons 10 k) (cons 11 l)))
               (ssadd (entlast) sz))
            (car lp)
            (cadr lp))(setvar 'PEDITACCEPT 1)
         (command-s "_.pedit" "m" sz "" "j" 0.0 "")(setq la (getvar "clayer"))
   (command-s "_.chprop" (entlast) "" "la" la ""))
         (if (= 8 (logand (getvar "undoctl") 8)) (command-s "_.UNDO" "e"))
         (setvar "cmdecho" 1)
   (if (not (setq p (getpoint "\n单击不删除源对象 <空格删除>\n")))
         (command-s "_.ERASE" ss ""))
         (princ "\n心心命令执行完毕\n!"))
(progn (princ "\n未选择对象!\n")))
  (princ (menucmd "M=$(edtime,$(getvar,date),YYYY.MO.DD HH:MM DDDD )"))
  (princ))
;;

账号		自动登录	找回密码
密码			注册

[提问] 多段线变多边形