SS:MAP & ModEnt

Free-Lancer · 发表于 2013-5-26 13:49:04

taner 发表于 2013-5-26 13:34

这个的 TYLST 格式和ModEnt 参数格式的不一样
ModEnt 是仿 XDRXAPI -〉 '(1 "string" 10 '(100. 200. 0.) ...) 一个表，要一一对应
TYLST 要子表组合的List -〉 '((1 . "string") (10 100. 200. 0.) ....) 和 dxf 中 assoc 出来的一样
用哪种，对Lisper看习惯了

taner · 发表于 2013-5-26 15:32:40

;;;改LEEMAC的http://www.theswamp.org/index.php?topic=32743.0
(defun _offset (ss pt dis / l obj)
((lambda ()
(cond
((not (and
(eq 'PICKSET (type ss))
(numberp dis)
(vl-consp pt)
)
)
)
((SSMAP2 (LAMBDA (Ent)
(if (vlax-method-applicable-p (setq obj
(vlax-ename->vla-object ent)
)
'Offset
)
(mapcar
(function vla-delete)
(car (setq l (append
(vl-sort (mapcar
(function (lambda
(x)
(vlax-invoke obj 'Offset x)
)
)
(list dis (- dis))
) (function (lambda
(a b)
(>
(distance pt
(vlax-curve-getClosestPointto
(car a) pt
)
)
(distance pt
(vlax-curve-getClosestPointto
(car b) pt
)
)
)
)
)
)
(cdr l)
)
)
)
)
)
) SS
)
)
)
)
)
(apply
(function append)
(cdr l)
)
)

;;;改LEEMAC的http://www.theswamp.org/index.php?topic=32743.0 
(defun _offset (ss pt dis / l obj) 
  ((lambda () 
     (cond 
       ((not (and 
               (eq 'PICKSET (type ss)) 
               (numberp dis) 
               (vl-consp pt) 
             ) 
        ) 
       ) 
       ((SSMAP2 (LAMBDA (Ent) 
                    (if (vlax-method-applicable-p (setq obj 
                                                        (vlax-ename->vla-object ent) 
                                                  ) 
                                                  'Offset 
                        ) 
                      (mapcar 
                        (function vla-delete) 
                        (car (setq l (append 
                                       (vl-sort (mapcar 
                                                  (function (lambda 
                                                              (x) 
                                                              (vlax-invoke obj 'Offset x) 
                                                            ) 
                                                  ) 
                                                  (list dis (- dis)) 
                                                ) (function (lambda 
                                                              (a b) 
                                                              (> 
                                                                 (distance pt 
                                                                           (vlax-curve-getClosestPointto 
                                                                                                         (car a) pt 
                                                                           ) 
                                                                 ) 
                                                                 (distance pt 
                                                                           (vlax-curve-getClosestPointto 
                                                                                                         (car b) pt 
                                                                           ) 
                                                                 ) 
                                                              ) 
                                                            ) 
                                                  ) 
                                       ) 
                                       (cdr l) 
                                     ) 
                             ) 
                        ) 
                      ) 
                    ) 
                  ) SS 
        ) 
       ) 
     ) 
   ) 
  ) 
  (apply 
    (function append) 
    (cdr l) 
  ) 
)

fn2398 · 发表于 2018-8-24 00:45:29

高手就是智慧，受教了

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

[他山之石] SS:MAP & ModEnt

点评

评分