明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1117|回复: 1

[提问] 如何给这个程序编号指定一个起点

[复制链接]
发表于 2014-10-15 16:04:51 | 显示全部楼层 |阅读模式
本帖最后由 tianyuan 于 2014-10-15 16:06 编辑

这个程序是在网上找到的,但是点号的起点是从东北方向顺时针开始的,我想如何把它改成指定一个起点,顺时针方向编号,不知该从哪里入手,还请高人指点!谢谢!
;;(prompt "\n\r 命令:ZDT")
(defun err(msg)
  (princ msg);"*cancel*")
  (restore)
)
(defun init()
  (command "_.undo" "be")
  (setq dimzin (getvar "dimzin"))
  (setvar "dimzin" 1)
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (setvar "cmdecho" 0)
  (setq errtmp *error*)
  (setq *error* err)
)
(defun restore()
  (setq *error* errtmp)
  (setvar "dimzin" dimzin)
  (setvar "osmode" os)
  (command "_.undo" "e")
)
;(xl-sort lst fun) = 以取代vl-sort函数,用法相同(lsp)---------------by 无痕
(defun xl-sort (lst fun / nlst)
  (foreach n lst (setq nlst (xl-isort n nlst fun))))
(defun xl-isort (item lst fun / k nlst)
  (setq k T
        nlst (apply 'append (mapcar '(lambda (x)
                                       (if (and K ((eval fun) item x)) (progn (setq k nil) (list item x)) (list x))
                                       ) lst))
  )
  (if k (append lst (list item)) nlst)
)
(defun setcolor(sname color / sinf)
  (setq sinf (entget sname))
  (if (assoc 62 sinf)
    (setq sinf (subst (cons 62 color) (assoc 62 sinf) sinf))
    (setq sinf (append sinf (list (cons 62 color))))
  )
  (entmod sinf)
)
(defun MakeText(pt Height Ang str / dxf)
  (setq dxf '((0 . "TEXT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (100 . "AcDbText")))
  (setq dxf (append dxf (list (cons 10 pt) (cons 40 height) (cons 50 Ang) (cons 1 str))))
  (setq dxf (append dxf '((41 . 0.8) (51 . 0.0) (71 . 0) (72 . 0)
                          (210 0.0 0.0 1.0) (100 . "AcDbText") (73 . 0))))
  (entmake dxf)
)
(defun MakeText2(pt Height Ang str / dxf)
  (setq dxf '((0 . "TEXT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (100 . "AcDbText")(10 0.0 0.0 0.0)))
  (setq dxf (append dxf (list (cons 11 pt) (cons 40 height) (cons 50 Ang) (cons 1 str))))
  (setq dxf (append dxf '((41 . 0.8) (51 . 0.0) (71 . 0) (72 . 1)
                          (210 0.0 0.0 1.0) (100 . "AcDbText") (73 . 2))))
  (entmake dxf)
)
(defun MakeText3(pt Height Ang str / dxf)
  (setq dxf '((0 . "TEXT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (100 . "AcDbText")(10 0.0 0.0 0.0)))
  (setq dxf (append dxf (list (cons 11 pt) (cons 40 height) (cons 50 Ang) (cons 1 (strcat "J" str)))))
  (setq dxf (append dxf '((41 . 0.8) (51 . 0.0) (71 . 0) (72 . 1)
                          (210 0.0 0.0 1.0) (100 . "AcDbText") (73 . 2))))
  (entmake dxf)
)
(defun OpPts(pts pt h scal / pti ptn ptc ang len params pts2 i)
  (setq pts_tmp nil)
  (if (equal (distance (car pts) (last pts)) 0 0.00000000001) (setq pts (cdr pts)))
  (setq pts2 (xl-sort pts '(lambda(e1 e2) (< (abs (- (angle pt e1) (/ pi 4))) (abs (- (angle pt e2) (/ pi 4)))))))
  (while (not (equal (car pts) (car pts2)))
    (setq pts (append (cdr pts) (list (car pts))))
  )
  (setq pti (car pts))
  (foreach ptn (append (cdr pts) (list (car pts)))
    (setq ptc (list (/ (+ (car ptn) (car pti)) 2.0) (/ (+ (cadr ptn) (cadr pti)) 2.0)))
    (setq ang (angle pti ptn))
    (setq len (distance ptn pti))
    (setq params (append params (list (list ang  ptc len))))
    (setq pti ptn)
  )
  (setq i 1)
  (mapcar '(lambda(e) (command "_.circle" e (* scal 0.15)) (setcolor (entlast) 1);可以在这里修改圆圈大小(* scale 0.75)
             (MakeText3 (polar e (angle pt e) h) h 0.0 (itoa i))
             (setq i (1+ i))
           ) pts)
  (mapcar '(lambda(e)
             (MakeText2 (polar (cadr e) (+ (/ pi 2) (car e)) (* 0.75 h))
               h
               (if (and (> (car e) (/ pi 2.0)) (< (car e) (* pi 1.5)))
                        (- (car e) pi)
                 (car e)
               )
               (rtos (last e) 2 2)))
          params)
)
(defun GetVer(ent / pts ents)
  (while (/= (cdr (assoc 0 (setq ents (entget (setq ent (entnext ent)))))) "SEQEND")
    (setq pts (append pts (list (cdr (assoc 10 ents)))))
  )
  pts
)
(defun GETPL (ED / ENTS PTS)
  (setq ENTS (entget ED))
  (while (setq ENTS (member (assoc 10 ENTS) ENTS))
    (setq PTS (append PTS (list (cdar ENTS))))
    (setq ENTS (CDR ENTS))
  )
  PTS
)
(defun Order(pts / n pt ang angn angi angAll pt pti)
  (setq n (length pts))
  (setq pt (list (/ (apply '+ (mapcar 'car pts)) n)
                 (/ (apply '+ (mapcar 'cadr pts)) n)))
  (setq ang (angle pt (car pts)))
  (setq angAll 0)
  (foreach pti (append (cdr pts) (list(car pts)))
    (setq angn (angle pt pti))
    (setq angi (- angn ang))
    (cond
      ((> angi pi) (setq angi (- angi (* pi 2))))
      ((< angi (- pi)) (setq angi (+ angi (* pi 2))))
    )
    (setq angAll (+ angAll angi))
    (setq ang angn)
  )
  (cond
    ((equal angAll 0 1) (list pt nil))
    ((> angAll 0) (list pt nil))
    ((< angAll 0) (list pt t))   
  )
)
(defun DoubleM(ent / ents pt pts l h x y h2)
  (setq ents (entget ent))
  (if (= (cdr (assoc 0 ents)) "TEXT")
    (progn
      (setq pt (cdr (assoc 10 ents)))
      (setq pts (textbox ents))
      (setq l (caadr pts))
      (setq h (cdr (assoc 40 ents)))
      (setq x (+ l (* h 0.4)))
      (setq y (* h 0.7))
      (setq h2 (* h 0.5))
      (MakeText (list (+ (car pt) x) (+ (cadr pt) y)) h2 0 "2")
    )
  )
)
(defun getEnter(ent h nscale scal Bname x y / ss i fenD FENS2 d2
                zl name th dh lb jz zd zdd fens
                Wname Nname Cname Rname
                Wyear Nyear Cyear Ryear
                Wmon  Nmon  Cmon  Rmon
                Wday  Nday  Cday  Rday
                date ent_f ents val)
  (defun getname(ty lst / i str name)
    (setq i 0 str "")
    (setq str (apply 'strcat (mapcar '(lambda(e) (setq i (1+ i)) (strcat (itoa i) "、" e " ") ) lst)))
    (setq str (substr str 1 (1- (strlen str))))
    (setq name (getstring (strcat ty "[" str "]:")))
    (if (and (>= (atoi name) 1) (<= (atoi name) (length lst)))
      (setq name (nth (1- (atoi name)) lst))
    )
    name
  )
  
  
  (setq wyear (substr date 1 4))
  (setq wmon (substr date 5 2))
  (setq wday (substr date 7 2))
  (setq nyear wyear cyear wyear ryear wyear)
  (setq nmon wmon cmon wmon rmon wmon)
  (setq nday wday cday wday rday wday)
  (command "_.insert" Bname (list (- (car pt) x) (- (cadr pt) y)) nscale "" "")
  (command "_.explode" (entlast))
  (setq ss (ssget "p" '((0 . "TEXT"))))
  (command "_.area" "o" ent)
  (setq ZDD (rtos (getvar "area") 2 2))
  (MakeText pt h 0 zdd)
  (MakeText2 (list (- (car pt) (* 1 h)) (+ (cadr pt) (* 1 h))) h 0 dh)
  (MakeText2 (list (- (car pt) (* 1 h)) (- (cadr pt) (* 0.25 h))) h 0 lb)
  (command "_.line" (list (- (car pt) (* 1.7 h)) (+ (cadr pt) (* 0.375 h))) (list (- (car pt) (* 0.125 h)) (+ (cadr pt) (* 0.375 h))) "")
  (setq fens (/ (atof zdd) (atof jz)))
  
  (setq i 0)
  (while (< i (sslength ss))
    (setq ent_f (ssname ss i))
    (setq ents (entget ent_f))
    (setq val (cdr (assoc 1 ents)))
    (if (not (and (or (= val "FENS2") (= val "FENS")) (= fenD "n")))
      (if (setq val (eval (read val)))
        (progn
          (if (member (cdr (assoc 1 ents)) '("ZDD" "JZ" "ZD" "FENS2")) (setq d2 t) (setq d2 nil))
          (setq ents (subst (cons 1 val) (assoc 1 ents) ents))         
          (entmod ents)
          (if d2 (doublem ent_f))
        )
      )
      (entdel ent_f)
    )   
    (setq i (1+ i))
  )
  (entupd ent_f)
  (list zl Uname th dh lb jz zd Wname Nname Cname Rname)
)
(defun c:zdt( / pts pt pti ptn ptc ang params)
  (init)
  (setq Scale (getstring "\n请输入比例尺<1:200>:"))
  (if (= Scale "")
    (progn
      (setq blc "1:200")
      (setq nScale 1)(setq h 0.45);可以在这里修改标注文字大小
    )
    (progn
      (setq nScale (/ (atof scale) 200))
      (setq blc (strcat "1:" scale))
      (setq h (* 0.45 (/ (atof scale) 200) ));可以在这里修改标注文字大小
    )
  )
  (setq ent (car (entsel "\n请选择图形...")))
  (setq pts (getpl ent))
  (if (cadr (setq pt (Order (reverse pts))))
    (setq pts (reverse pts))
  )
  (setq pt (car pt))
  (setq xc (* 0.10 nscale));可以在这里修改线粗
  (command "_.pedit" ent "w" xc "")
  (setcolor ent 1)
  (OpPts pts pt h nscale)  
  (getEnter ent h nscale scale "8kh" (* nscale 30) (* nscale 18.4))
  (princ "\n\nEnd!")
  (restore)
  (princ)
)
"觉得好,就打赏"
还没有人打赏,支持一下
 楼主| 发表于 2014-11-10 10:51:15 | 显示全部楼层
能请高人指点一下,从 哪一句开始修改吗?
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2025-5-23 21:55 , Processed in 0.265055 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表