;;向块中添加中心线

Gray-wolf

;;向块中添加中心线
(defun c:kl (/ atts blk_lst blkdef blkname l points pts pts_lst ss ss_lst ss1)
    (vl-load-com)
    (setq eh-*error*-bak *error*)
    (defun *error* (msg)
        (setq *error* eh-*error*-bak)
        (setvar "osmode" eh_os_g)
        (vla-endundomark eh_doc_g)
        (setvar "nomutt" 0)
        (setvar "cmdecho" 1)
        (print msg)
    )
   
    (setvar "cmdecho" 0)
    (if (null eh_doc_g)(setq eh_doc_g (vla-get-activedocument (vlax-get-acad-object))))
    (vla-startundomark eh_doc_g)
    (if (< (setq eh_os_g (getvar "osmode")) 16384)
        (setvar "osmode" (+ eh_os_g 16384))
    )
   
    (setq ss (ssget '((0 . "INSERT"))))
    (if (null ss)
        (quit)
    )   
    (setq ss_lst (EH-SS->List ss))
    (foreach x ss_lst
        (setq blkname (EH-Get-EntDxf x 2))   
        (setq blk_lst (cons blkname blk_lst))        
    )
    (foreach blkname blk_lst        
        (if (not
                    (VL-CATCH-ALL-ERROR-P
                        (setq
                            blkdef (VL-CATCH-ALL-APPLY 'vla-item (list
                                                                                                         (vla-get-blocks eh_doc_g)
                                                                                                         blkname
                                                                                                     )
                     )
            )
          )
        )            
            (vlax-for o blkdef                                                            
                (cond
                    ((or (= "AcDbBlockReference" (vla-get-objectname o))
                         (= "AcDbMInsertBlock" (vla-get-objectname o))
                     )                                       
                        (setq atts (vlax-invoke o 'GetAttributes))                        
                        (foreach a atts
                            (setq l (cons (vlax-vla-object->ename a) l))
                        )
                        (setq l (append (listblockent (vla-get-name o)) l))
                    )
                    (t                        
                        (setq l (cons (vlax-vla-object->ename o) l))
                    )
        )
            )
    )                           
        ;;图块内的对象不能独立加入选择集
        ;(setq ss1 (EH-List->SS l))        
        (foreach x l
            (setq pts (EH-ent-9pt x '(1 9)))
            (setq pts_lst (cons (cadr pts) pts_lst))
            (setq pts_lst (cons (car  pts) pts_lst))                        
        )
        (setq pts (EH-Pts-9pt pts_lst '(2 8)))
        (setq pts (list
                                (EH-Vector-Add (car  pts) '(0 -1000 0))
                                (EH-Vector-Add (cadr pts) '(0 1000 0))                           
                            )            
        )                        
    (setq points (vlax-make-safearray vlax-vbDouble '(0 . 3)))  
    (vlax-safearray-fill points (list
                                                                    (caar   pts)
                                                                    (cadar  pts)
                                                                    (caadr  pts)
                                                                    (cadadr pts)
                                                                )  
    )        
        (vla-AddLightweightPolyline blkdef points)
        
    )   
    (vla-Regen eh_doc_g acAllViewports)
    (setq *error* eh-*error*-bak)
    (setvar "osmode" eh_os_g)
    (vla-endundomark eh_doc_g)
    (setvar "nomutt" 0)
    (setvar "cmdecho" 1)   
    (princ)        
) ;defun_end

young-yi

学习了 谢谢分享

yoyoho

谢谢! Gray-wolf 分享学习了!!!!

yoyoho

缺少自定义函数  EH-SS->List,EH-Get-EntDxf,EH-List->SS,EH-ent-9pt,EH-Vector-Add

yoyoho

缺少自定义函数
EH-Pts-9pt

yangchao2005090

缺少自定义函数
EH-Pts-9pt

Gray-wolf

感谢大家的关注，缺少的都是比较基础的通用函数，可以自己写一个就可以了，注意参数的类型和个数以及返回值的类型一致就行了