fengyu6913 发表于 2025-6-19 16:56:41

黄大师的画多边形，没有捕捉功能，求增加

本帖最后由 fengyu6913 于 2025-6-19 17:03 编辑

一下程序是黄大师的画多边形，没有捕捉功能，求增加
http://bbs.mjtd.com/forum.php?mo ... 257&fromuid=7327068
(出处: 明经CAD社区)


;;[功能] 画封闭多边形----------脱了裤子放屁
(defun C:w1 (/ PTS)
(cond ((setq pts (HH::getPoints)) (MakeXLWPOLYLINE pts)))
)

;;[功能] 取点函数
(defun HH::getPoints (/ CODE FLAG P0 PT PT1 X Y)
(while (and (setq code (grread T 8)) (or (= (car code) 3) (= (car code) 5)))
    (cond ((= (car code) 3) (setq pt (cons (cadr code) pt))))
    (redraw)
    (cond
      ((> (length pt) 1)
       (setq pt1 (cons (cadr code) pt))
       (setq pt1 (cons p0 pt1))
       (mapcar '(lambda (x y) (grdraw x y 1)) pt1 (cdr pt1))
      )
      ((equal (length pt) 1) (setq p0 (car pt)) (grdraw p0 (cadr code) 1))
      (T
       (cond ((not Flag) (setq Flag T) (princ "\n 点取起点")))
      )
    )
)
(redraw)
(cond ((> (length pt) 2) (reverse pt)))
)
;;http://bbs.xdcad.net/thread-673261-1-1.html
;;167.3 [功能] Entmake点表生成多段线
(defun MakeXLWPOLYLINE (lst / PT)
(entmakeX
    (append
      (list '(0 . "LWPOLYLINE")
            '(100 . "AcDbEntity")
            '(100 . "AcDbPolyline")
            (cons 90 (length lst))
            '(70 . 1)
      )
      (mapcar '(lambda (pt) (cons 10 pt)) lst)
    )
)
)

pyj643921 发表于 2025-6-19 17:22:22

哈哈，黄大师都说脱裤子放屁了，你还让别人完善
pline命令不好嘛

fengyu6913 发表于 2025-6-26 17:28:14

别的大师也可以来完善一下

xyp1964 发表于 2025-6-26 21:43:21


fengyu6913 发表于 3 天前

xyp1964 发表于 2025-6-26 21:43

院长，请把代码分享一下

guosheyang 发表于 前天 17:55

都是脱离裤子放屁   这个简单些:lol
;;通过画矢量线来获取点表
(defun c:tt (/ A DB X Y)
   (setq a (getpoint "\n 请点选两个以上的点") db (list a))
   (while(setq a (getpoint a))
         (setq db (append db (list a)))
         (mapcar '(lambda (x y) (grdraw x y 2 1)nil)
             db (cdr db)
         )
   )
   (redraw)
   db
)

qazxswk 发表于 前天 23:43

PL命令不香吗？
页: [1]
查看完整版本: 黄大师的画多边形，没有捕捉功能，求增加