社区 › AutoLISP/Visual LISP 编程技术 › 【Gu_xl】基于方位角计算的拓扑多边形自动构建快速算法

snigefqb 发表于 2017-12-30 14:28:32

chshsl 发表于 2017-8-9 11:01
经过2天的研究G大侠的代码及网盘函数库，复原了，所缺的几个函数，见大家都希望补全，现贴上。希望G大侠不 ...

error: no function definition: GXL-SEL-SS->LIST; 出错后重置,请问这个又是什么

chshsl 发表于 2018-1-10 10:55:11

;;;根据线段图元表构建二维坐标表'((首端点 末端点)...)
(defun gxl-ent->Coordinates1 (enLst)
(mapcar '(lambda (x)
   (list (list (car (setq a (vlax-curve-getStartPoint x))) (cadr a))
   (list (car (setq a (vlax-curve-getendPoint x))) (cadr a))
   ) ;_ list
   ) ;_ lambda
enlst
) ;_ mapcar
) ;_ defun

;;;gxl-Sel-EntNextAll en 返回 en 之后的所有物体选择集，无则返回 nil
(defun gxl-Sel-EntNextAll (ent / ss ent1)
(setq ss (ssadd))
(while (setq ent1 (entnext ent))
(ssadd ent1 ss)
(setq ent ent1)
)
(if (= 0 (sslength ss))
nil
ss
)
)
;;;选择集转为图元列表
(defun gxl-Sel-SS->List (ss / cs_i out)
(if (= (type ss) 'PICKSET)
(progn
(setq cs_i 0.0
out '()
)
(repeat (sslength ss)
(setq out (cons (ssname ss cs_i) out))
(setq cs_i (1+ cs_i))
)
(setq out (reverse out))
)
)
)

;;图元列表转为选择集
(defun gxl-Sel-List->SS (Lst / en ss)
(setq ss (ssadd)
kk 0)
(foreach en Lst
(ssadd en ss)
(setq kk (1+ kk))
)
ss
)

chshsl 发表于 2018-1-10 11:01:27

本帖最后由 chshsl 于 2018-1-10 11:02 编辑

;;;==================================================================
;;;(gxl-dxf ent i )取出图元索引i对应的值
;;;==================================================================
(defun gxl-dxf (ent i)
(if (= (type ent) 'ename)
(setq ent (entget ent))
)
(cdr (assoc i ent))

)
;;;==================================================================
;;;(gxl-CH_Ent ent i pt) 用新值pt更新图元ent索引i对应的值
;;;==================================================================
(defun gxl-CH_Ent (ent i pt / en)
(if (assoc i (setq en (entget ent)))
(setq en (subst (cons i pt) (assoc i en) en))
(setq en (append en (list (cons i pt))))
)
(entmod en)
)
;;删除表中第N个元素

(defun gxl-removeNth (index lst / c rtn lst1)
(if (>= index(length lst)) ;_ index 越界
    lst
(if (< index (/ (length lst) 2)) ;_ index位于前半截
    (progn
(setq c -1 lst1 lst)
(vl-some '(lambda (x) (if (equal index (setq c (1+ c))) t (progn (setq rtn (cons x rtn) lst1 (cdr lst1)) nil))) lst)
(append (reverse rtn) (cdr lst1))
)
    (progn ;_ index位于后半截
      (setq index (- (length lst) index 1) lst (reverse lst))
      (setq c -1 lst1 lst)
(vl-some '(lambda (x) (if (equal index (setq c (1+ c))) t (progn (setq rtn (cons x rtn) lst1 (cdr lst1)) nil))) lst)
(reverse (append (reverse rtn) (cdr lst1)))
      )
    )
    )
)


(defun gxl-massoc( d li /als )
      (setq ls '())
      (while (assoc d li)
                (progn
                        (setqa (assoc d li))
                        (setq ls (cons (list (cadr a) (caddr a)) ls))
                        (setq li (xdlsp_list_remove lia))
                )
      )
      (reverse ls)
)

;输出50个空格
;(gxl-Str-Space 50) "                                                "
;(gxl-Str-Space -1)
(defun gxl-Str-Space ( d/a )
    (setq a "")
      (if (>d 0)
                (repeat d
                  (setq a (strcat a " " ))
               )
      )
      a
)

;删除表中重复项
(defun gxl-ListDumpAtom( l1 /l2)
(while(setq l2(cons(car l1)l2) l1(vl-remove(car l1)(cdr l1))))
(reverse l2)
)

;; 曲线一点的切线方向的角度
;;示例(HH:PtFirstAngle (car (entsel)) (getpoint))
(defun gxl-GetCurveTangent (obj pt)
(setq param (vlax-curve-getParamAtPoint obj pt))
(angle pt (mapcar '+ pt (vlax-curve-getFirstDeriv obj param)))
)
;;常用变量
(setq
      pi2         (* pi 0.5)
      pi4         (* pi 0.25)
      2pi         (* pi 2.)
      3pi2         (* 1.5 pi)
      3pi4   (+ pi2 pi4)
      5pi4   (+ pi pi4)
      7pi4 (+ 3pi2 pi4)
      #ZJWS# 2
      *jd* 0.00001
)

这次应该是齐了，因为我这里运行已经没问题了。

qq84603709 发表于 2018-1-27 10:02:03

迟滞~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

zfcdage 发表于 2018-3-6 12:29:02

thanksgiving

一张单程票 发表于 2018-3-16 20:23:24

; 错误: no function definition: SETUNDOERR，提示这个，

bluefcc1 发表于 2018-3-20 13:06:10

值得下載學習!

zazhz123 发表于 2018-4-8 17:28:41

太厉害了，换个镂空

cn0yahoo 发表于 2018-4-18 09:56:34

这个程序好复杂啊，新手只好先保留备学

ssyfeng 发表于 2018-5-1 11:10:02

学习研究下拓扑。。

查看完整版本: 【Gu_xl】基于方位角计算的拓扑多边形自动构建快速算法