【源码分享】指定角度的引出线动态标示

c735023723

谢谢分享

yaokui25

才发现，这就是国外网站的源码汉化啊

rhww

yaokui25 发表于 2014-6-4 23:53
才发现，这就是国外网站的源码汉化啊

请问你有这个lsp吗，我很需要，能不能提供一下，谢谢

yaokui25

rhww 发表于 2014-6-5 20:21
请问你有这个lsp吗，我很需要，能不能提供一下，谢谢

等我明天发给你

rhww

yaokui25 发表于 2014-6-5 20:37
等我明天发给你

您好，您什么时间上线麻烦发我一下吧，非常感谢。可以发到我邮箱691151260@qq.com

rhww

yaokui25 发表于 2014-6-5 20:37
等我明天发给你

朋友您好，您还记得这个帖子吗，能不能把lsp发给我呢，我真的很需要，麻烦您了，谢谢

rhww

hao3ren 发表于 2012-5-3 10:17
下载看了下，提几个意见，文字如果换成下拉框选择文字是否方便些，另外引出角度按规范应该还有30度这种情况 ...

您好，你还有这个帖子的源码吗，能不能分享一下

yaokui25

rhww 发表于 2014-6-28 11:14
您好，你还有这个帖子的源码吗，能不能分享一下

MakeCallOut : dialog {        
        label = "Call Out Text" ;
        initial_focus="Text1";
        
        :column{key="Group_1";
                : edit_box {key="Text1";label="Text1";width=50;allow_accept = true;}
                : edit_box {key="Text2";label="Text2";width=50;allow_accept = true;}
                : edit_box {key="Text3";label="Text3";width=50;allow_accept = true;}
                : edit_box {key="Text4";label="Text4";width=50;allow_accept = true;}
        }
        
        :row{
                :boxed_radio_column{key="Group_2";label = "Pointer Size";
                        :radio_button {key="Size5";label="2.0";allow_accept = true;}
                        :radio_button {key="Size4";label="1.0";allow_accept = true;}
                        :radio_button {key="Size1";label="0.50";allow_accept = true;}
                        :radio_button {key="Size2";label="0.33";allow_accept = true;}
                        :radio_button {key="Size3";label="0.25";allow_accept = true;}
                }

                :boxed_radio_column{key="Group_3";label = "Pointer Type";
                        :radio_button {key="Type1";label="Dot";allow_accept = true;}
                        :radio_button {key="Type2";label="Double Filled";allow_accept = true;}
                        :radio_button {key="Type3";label="One Side Filled";allow_accept = true;}
                        :radio_button {key="Type4";label="One Side Open";allow_accept = true;}
                        :radio_button {key="Type5";label="No pointer";allow_accept = true;}
                }
                :column{
                :boxed_radio_column{key="Group_4";label = "Leader Angle";
                        :radio_button {key="Ang1";label="90Degree";allow_accept = true;}
                        :radio_button {key="Ang2";label="60Degree";allow_accept = true;}
                        :radio_button {key="Ang3";label="45Degree";allow_accept = true;}
                }
                :boxed_column {label="Arrow";
                        :popup_list {label="Layer";key="Lay1";allow_accept=true;}
                        :popup_list {label="Color";key="Col1";allow_accept=true;}
                        :popup_list {label="LType";key="LT1";allow_accept=true;}
                }
                }
                :column{
                :boxed_radio_column{key="Group_5";label = "Text Size";
                        :radio_button {key="TSize1";label="2.5";allow_accept = true;}
                        :radio_button {key="TSize2";label="3.0";allow_accept = true;}
                        :radio_button {key="TSize3";label="4.0";allow_accept = true;}
                }
                :boxed_column {label="Text";
                :popup_list {label="Layer";key="Lay2";allow_accept=true;}
                :popup_list {label="Color";key="Col2";allow_accept=true;}
                :popup_list {label="LType";key="LT2";allow_accept=true;}
                }
                }
        }
        : spacer {height =1;}
        :row {
        :spacer {width = 1;}
        ok_button ;
        is_default=true;
        cancel_button ;
        :spacer {width = 1;}
        }
}

MakeCallOut_J : dialog {        
        label = "引き出し線付きの文字" ;
        initial_focus="Text1";
        
        :column{key="Group_1";
                : edit_box {key="Text1";label="文字列1";width=50;allow_accept = true;}
                : edit_box {key="Text2";label="文字列2";width=50;allow_accept = true;}
                : edit_box {key="Text3";label="文字列3";width=50;allow_accept = true;}
                : edit_box {key="Text4";label="文字列4";width=50;allow_accept = true;}
        }
        
        :row{
                :boxed_radio_column{key="Group_2";label = "先端の大きさ";
                        :radio_button {key="Size5";label="2.0";allow_accept = true;}
                        :radio_button {key="Size4";label="1.0";allow_accept = true;}
                        :radio_button {key="Size1";label="0.50";allow_accept = true;}
                        :radio_button {key="Size2";label="0.33";allow_accept = true;}
                        :radio_button {key="Size3";label="0.25";allow_accept = true;}
                }

                :boxed_radio_column{key="Group_3";label = "先端の種類";
                        :radio_button {key="Type1";label="黒丸";allow_accept = true;}
                        :radio_button {key="Type2";label="両矢印（黒）";allow_accept = true;}
                        :radio_button {key="Type3";label="片矢印（黒）";allow_accept = true;}
                        :radio_button {key="Type4";label="片矢印（開）";allow_accept = true;}
                        :radio_button {key="Type5";label="なし";allow_accept = true;}
                }
                :column{
                :boxed_radio_column{key="Group_4";label = "引き出し線の角度";
                        :radio_button {key="Ang1";label="90度";allow_accept = true;}
                        :radio_button {key="Ang2";label="60度";allow_accept = true;}
                        :radio_button {key="Ang3";label="45度";allow_accept = true;}
                }
                :boxed_column {label="引出線";
                        :popup_list {label="レイヤー";key="Lay1";allow_accept=true;}
                        :popup_list {label="色";key="Col1";allow_accept=true;}
                        :popup_list {label="線種";key="LT1";allow_accept=true;}
                }
                }
                :column{
                :boxed_radio_column{key="Group_5";label = "文字サイズ";
                        :radio_button {key="TSize1";label="2.5";allow_accept = true;}
                        :radio_button {key="TSize2";label="3.0";allow_accept = true;}
                        :radio_button {key="TSize3";label="4.0";allow_accept = true;}
                }
                :boxed_column {label="文字";
                :popup_list {label="レイヤー";key="Lay2";allow_accept=true;}
                :popup_list {label="色";key="Col2";allow_accept=true;}
                :popup_list {label="線種";key="LT2";allow_accept=true;}
                }
                }
        }
        : spacer {height =1;}
        :row {
        :spacer {width = 1;}
        ok_button ;
        is_default=true;
        cancel_button ;
        :spacer {width = 1;}
        }
}


(defun c:SD_801( / dcl_id Act Flag Flag2 ObjNamePt
                                                Pt0 Pt1 Pt2 Pt3 Pt4 Pt5 Pt6 Pt7 PtList PtX Ang Ang2 LAng Co1 i m
                                                ObjPoly NewData  ObjNameL  ObjNameLeader
                                                TextL TextDataL MaxTextW LeaderBase Data Data0 DataL   HandleL HnL dim_scale)
        (if (= SD:Lang "E")
                (princ "\n Draw Annotation with arrow")               
                (princ "\n 注釈記入")
        )
        (princ "\n **********************************")
        (setq *error* *myerror*)   
        (SD1028)
        
          (if (= (getvar "ctab") "Model")
                  (setq dim_scale (getvar "DIMSCALE"))
                  (if (= (getvar "cvport") 1)
                        (setq dim_scale 1.0)
                        (setq dim_scale (getvar "DIMSCALE"))
                )
          )
        (get_layer&ltype&color)
        ;ダイアログ呼び出し
        (setq dcl_id (load_dialog "SD_801.dcl"))
        (if (= SD:Lang "E")
                (new_dialog "MakeCallOut" dcl_id)
                (new_dialog "MakeCallOut_J" dcl_id)
        )
        (start_list "Lay1")
                (mapcar 'add_list Laylist1)
        (end_list)
        (start_list "Col1")
                (mapcar 'add_list Laylist2)
        (end_list)
        (start_list "LT1")
                (mapcar 'add_list Laylist3)
        (end_list)
        
        (start_list "Lay2")
                (mapcar 'add_list Laylist1)
        (end_list)
        (start_list "Col2")
                (mapcar 'add_list Laylist2)
        (end_list)
        (start_list "LT2")
                (mapcar 'add_list Laylist3)
        (end_list)
        
        (RegistryRead_801)
        
        (action_tile "accept" "(get_data_801)(done_dialog 1)")
        (action_tile "cancel" "(done_dialog 0)")
        (setq Act (start_dialog))
        (unload_dialog dcl_id)
        (if (= Act 0) (exit))
        
        
        (setvar "OSMODE" 512)
        (while (= Flag nil)
                (if (= SD:Lang "E")
                        (setq ObjNamePt (entsel "\n Point Object to put Call Out on <Enter to Point>:"))
                        (setq ObjNamePt (entsel "\n 引き出し線をつける図形を指示。又は改行キーで任意の場所： "))
                )
                (if        ObjNamePt                                 (Object_Callout))
                (if (=(getvar "ERRNO") 52)         (Floating_Callout))
        )
        
        (Add_X_Data_801)
        
        (SD2056)
        (setq *error* nil)
        (princ)
)

;Objを指示する場合-----------------------------------------------------------------------------------------------
(defun Object_Callout ()
        (setq Flag T)
        (setq Pt0 (osnap (cadr ObjNamePt) "_near"))        ;UCS
        (setq Pt0Org Pt0)
        (GrRead_801)
)

;点を指示する場合-----------------------------------------------------------------------------------------------
(defun Floating_Callout ()
        (setq Flag T)
        (setq Pt0 (getpoint "Start Point :"))        ;UCS
        (setq Pt0Org Pt0)
        (GrRead_801)
)

;GrRead開始-----------------------------------------------------------------------------------------------
(defun GrRead_801()
        (setq Flag nil Flag2 nil)
        (while (/= (car PtX) 3)
                (setq PtX (grread T 1 0));カーソルの座標
                (setq Pt6 (cadr PtX))        ;UCS
                (setq Pt7 (mapcar '+ Pt6 (list 0 (* TextH dim_scale -0.5))))         ;UCS
                (setq Pt8 (mapcar '+ Pt7 (list 0 (* TextH dim_scale -0.5))))         ;UCS
                (if (not Flag2)                ;１回目は文字列を作る
                        (progn        (TextMake)
                                        (setq Flag2 T)
                        )
                )
                (setq Pt9 (mapcar  '+ Pt7 (list MaxTextW 0)))        ;UCS
                (PointCal_801)
        )
)

;点の計算-----------------------------------------------------------------------------------------------
(defun PointCal_801 ()
                (setq Ang (angle Pt0Org Pt7) Ang2 (angle Pt0Org Pt9))
                ;Co1=-1だと本来の向きとは逆の位置に引き出し線が出る
                (cond        ((<= 0 Ang LAng                        )                                (setq Co1 1)(TextMove_L))
                                ((<= LAng Ang2 (* 0.5 pi ))                                        (setq Co1 1)(setq Pt7 Pt9)(TextMove_R))
                                ((<= LAng Ang (* 0.5 pi ))                                        (setq Co1 -1)(TextMove_L))
                                ((<= (* 0.5 pi ) Ang (- pi LAng))                                (setq Co1 -1)(TextMove_L))
                                ((<= (* 0.5 pi ) Ang2 (- pi LAng))                        (setq Co1 1)(setq Pt7 Pt9)(TextMove_R))
                                ((<= (- pi LAng) Ang2 pi )                                        (setq Co1 -1)(setq Pt7 Pt9)(TextMove_R))
                                ((<= (- (* 2.0 pi) LAng) Ang (* 2.0 pi ))                (setq Co1 -1)(TextMove_L))
                                ((<= (+ pi LAng) Ang (* 1.5 pi ))                        (setq Co1 1)(TextMove_L))
                                ((<= (* 1.5 pi ) Ang2 (- (* 2.0 pi) LAng))                (setq Co1 -1)(setq Pt7 Pt9)(TextMove_R))
                                ((<= (* 1.5 pi ) Ang (- (* 2.0 pi) LAng))                (setq Co1 1)(TextMove_L))
                                ((<= (+ pi LAng) Ang2 (* 1.5 pi ))                        (setq Co1 -1)(setq Pt7 Pt9)(TextMove_R))
                                ((<= (* 1.5 pi ) Ang2 (- (* 2.0 pi) LAng))                (setq Co1 1)(setq Pt7 Pt9)(TextMove_R))
                                ((<= pi Ang2 (+ pi LAng))                                        (setq Co1 1)(setq Pt7 Pt9)(TextMove_R))
                                (T                                                                                        (setq Co1 1))
                 )
                (setq Pt5 (list         (+ (car Pt0Org) (* (/ (cos LAng) (sin LAng)) (* Co1 (- (cadr Pt7) (cadr Pt0Org)))))
                                                (cadr Pt7))
                )
               
                (setvar "Clayer" Lay1)
                (setvar "Cecolor" Col1)
                (setvar "Celtype" LT1)
                (cond        ((= ArrowType "Type1")        (LeaderMake1))
                                ((= ArrowType "Type2")        (LeaderMake2))
                                ((= ArrowType "Type3")        (LeaderMake3))
                                ((= ArrowType "Type4")        (LeaderMake4))
                                ((= ArrowType "Type5")        (LeaderMake5))
                )
                (setq Flag T)
)

;リーダー１黒丸タイプ-----------------------------------------------------------------------------------------------
(defun LeaderMake1 ()
                (setq         Pt0 (trans Pt0Org 1 0)
                                Pt1 (trans (mapcar '+ Pt0Org (list 0 SizeV)) 1 0)
                                Pt2 (trans (mapcar '- Pt0Org (list 0 SizeV)) 1 0)
                                Pt3 Pt1
                                Pt4 Pt0
                                Pt5 (trans Pt5 1 0)
                                Pt7 (trans Pt7 1 0)
                                PtList (list (car Pt0)(cadr Pt0)(car Pt1)(cadr Pt1)(car Pt2)(cadr Pt2)(car Pt3)(cadr Pt3)(car Pt4)(cadr Pt4)(car Pt5)(cadr Pt5)(car Pt7)(cadr Pt7))
                )
                (setq arraySpace (vlax-make-safearray vlax-vbdouble  (cons 0 (- (length PtList) 1))))
                (setq sArray (vlax-safearray-fill arraySpace PtList))
                (if Flag
                        (vla-put-Coordinates ObjPoly sArray)
                        (progn        
                                (if (= (getvar "ctab") "Model")
                                        (setq ObjPoly (vla-AddLightWeightPolyline *ModelSPace* sArray))
                                        (if (= (getvar "cvport") 1)
                                                (setq ObjPoly (vla-AddLightWeightPolyline *PaperSPace* sArray))
                                                (setq ObjPoly (vla-AddLightWeightPolyline *ModelSPace* sArray))
                                        )
                                )
                                        (vla-setbulge ObjPoly 1 1.0)
                                        (vla-setbulge ObjPoly 2 1.0)
                                        (vla-SetWidth  ObjPoly 1 ( * 2 SizeV) ( * 2 SizeV))
                                        (vla-SetWidth  ObjPoly 2 ( * 2 SizeV) ( * 2 SizeV))
                        )
                )
)               

;リーダー2 黒矢印-----------------------------------------------------------------------------------------------
(defun LeaderMake2 ()
                (setq         Pt0 (trans Pt0Org 1 0)
                                Pt1 (trans (polar Pt0Org (angle Pt0Org Pt5) (* 5.0 SizeV)) 1 0)
                                Pt5 (trans Pt5 1 0)
                                Pt7 (trans Pt7 1 0)
                                PtList (list (car Pt0)(cadr Pt0)(car Pt1)(cadr Pt1)(car Pt5)(cadr Pt5)(car Pt7)(cadr Pt7))
                )
                (setq arraySpace (vlax-make-safearray vlax-vbdouble  (cons 0 (- (length PtList) 1))))
                (setq sArray (vlax-safearray-fill arraySpace PtList))
                (if Flag
                        (vla-put-Coordinates ObjPoly sArray)
                        (progn        
                                (if (= (getvar "ctab") "Model")
                                        (setq ObjPoly (vla-AddLightWeightPolyline *ModelSPace* sArray))
                                        (if (= (getvar "cvport") 1)
                                                (setq ObjPoly (vla-AddLightWeightPolyline *PaperSPace* sArray))
                                                (setq ObjPoly (vla-AddLightWeightPolyline *ModelSPace* sArray))
                                        )
                                )
                                (vla-SetWidth  ObjPoly 0 0.0 ( * 2 SizeV))
                                (vla-put-layer ObjPoly Lay1)
                        )
                )
)

;リーダー3片方黒矢印-----------------------------------------------------------------------------------------------
(defun LeaderMake3 ()
                (setq         Pt0 (trans Pt0Org 1 0)
                                Pt1 (trans (polar Pt0Org (+ (angle Pt0Org Pt5) (* Co1 0.15)) (* 5.0 SizeV)) 1 0)
                                Pt2 Pt0
                                Pt5 (trans Pt5 1 0)
                                Pt7 (trans Pt7 1 0)
                                PtList (list (car Pt0)(cadr Pt0)(car Pt1)(cadr Pt1)(car Pt2)(cadr Pt2)(car Pt5)(cadr Pt5)(car Pt7)(cadr Pt7))
                )
                (setq arraySpace (vlax-make-safearray vlax-vbdouble  (cons 0 (- (length PtList) 1))))
                (setq sArray (vlax-safearray-fill arraySpace PtList))
                (if Flag
                        (vla-put-Coordinates ObjPoly sArray)
                        (progn        
                                (if (= (getvar "ctab") "Model")
                                        (setq ObjPoly (vla-AddLightWeightPolyline *ModelSPace* sArray))
                                        (if (= (getvar "cvport") 1)
                                                (setq ObjPoly (vla-AddLightWeightPolyline *PaperSPace* sArray))
                                                (setq ObjPoly (vla-AddLightWeightPolyline *ModelSPace* sArray))
                                        )
                                )
                                (vla-SetWidth  ObjPoly 1 (* 1.5 SizeV) 0.0)
                                (vla-put-layer ObjPoly Lay1)
                        )
                )
)

;リーダー4片矢印-----------------------------------------------------------------------------------------------
(defun LeaderMake4 ()
                (setq         Pt0 (trans Pt0Org 1 0)
                                Pt1 (trans (polar Pt0Org (+ (angle Pt0Org Pt5) (* Co1 0.3)) (* 5.0 SizeV)) 1 0)
                                Pt2 Pt0
                                Pt5 (trans Pt5 1 0)
                                Pt7 (trans Pt7 1 0)
                                PtList (list (car Pt0)(cadr Pt0)(car Pt1)(cadr Pt1)(car Pt2)(cadr Pt2)(car Pt5)(cadr Pt5)(car Pt7)(cadr Pt7))
                )
                (setq arraySpace (vlax-make-safearray vlax-vbdouble  (cons 0 (- (length PtList) 1))))
                (setq sArray (vlax-safearray-fill arraySpace PtList))
                (if Flag
                        (vla-put-Coordinates ObjPoly sArray)
                        (progn        
                                (if (= (getvar "ctab") "Model")
                                        (setq ObjPoly (vla-AddLightWeightPolyline *ModelSPace* sArray))
                                        (if (= (getvar "cvport") 1)
                                                (setq ObjPoly (vla-AddLightWeightPolyline *PaperSPace* sArray))
                                                (setq ObjPoly (vla-AddLightWeightPolyline *ModelSPace* sArray))
                                        )
                                )
                                (vla-put-layer ObjPoly Lay1)
                        )
                )
)
;リーダー5なし-----------------------------------------------------------------------------------------------
(defun LeaderMake5 ()
                (setq         Pt0 (trans Pt0Org 1 0)
                                Pt5 (trans Pt5 1 0)
                                Pt7 (trans Pt7 1 0)
                                PtList (list (car Pt0)(cadr Pt0)(car Pt5)(cadr Pt5)(car Pt7)(cadr Pt7))
                )
                (setq arraySpace (vlax-make-safearray vlax-vbdouble  (cons 0 (- (length PtList) 1))))
                (setq sArray (vlax-safearray-fill arraySpace PtList))
                (if Flag
                        (vla-put-Coordinates ObjPoly sArray)
                        (progn        
                                (if (= (getvar "ctab") "Model")
                                        (setq ObjPoly (vla-AddLightWeightPolyline *ModelSPace* sArray))
                                        (if (= (getvar "cvport") 1)
                                                (setq ObjPoly (vla-AddLightWeightPolyline *PaperSPace* sArray))
                                                (setq ObjPoly (vla-AddLightWeightPolyline *ModelSPace* sArray))
                                        )
                                )
                                (vla-put-layer ObjPoly Lay1)
                        )
                )
)

;文字データセット-----------------------------------------------------------------------------------------------
(defun TextMake()
        (setvar "Clayer" Lay2)
        (setvar "Cecolor" Col2)
        (setvar "Celtype" LT2)
        (setq TextDataL (mapcar '(lambda (x i)        (list        (cons 0 "TEXT")
                                                                                                                (cons 100 "AcDbEntity")        
                                                                                                                (cons 100 "AcDbText")
                                                                                                                (cons 10 (trans (mapcar '+ Pt8 (list 0 (* dim_scale -1.2 TextH        i))) 1 0))
                                                                                                                (cons 40 (* dim_scale TextH))
                                                                                                                (cons 50 (angle (trans '(0 0) 1 0)(trans  '(1 0) 1 0)))
                                                                                                                (cons 7  (getvar "TEXTSTYLE"))
                                                                                                                (cons 1 x)))
                                                                TextL '(0 1 2 3)))
        (setq ObjNameL (mapcar        '(lambda(x)        (progn (entmake x)(entlast)))TextDataL))
        (setq MaxTextW (apply 'max (mapcar '(lambda(x) (caadr (textbox (entget x)))) ObjNameL)))
)



;文字移動 左揃え-----------------------------------------------------------------------------------------------
(defun TextMove_L ()
        (setq i 0 j 0)
        (mapcar '( lambda (x)
                                (cond         ((= (cdr (assoc 0 (setq Data (entget x)))) "TEXT")
                                                (setq Data (subst        (cons 72 0)(assoc 72 Data) Data))
                                                (setq Data (subst        (cons 73 0)(assoc 73 Data) Data))
                                                (setq Data (subst         (cons 10 (trans (mapcar '+ Pt8 (list 0 (*        -1.2 dim_scale TextH        j))) 1 0))
                                                                                        (assoc 10 Data) Data)))
                                                ((= (cdr (assoc 0 Data)) "MTEXT")
                                                (setq Data (subst        (cons 71 1)(assoc 71 Data) Data))
                                                (setq Data (subst         (trans (cons 10 (mapcar '+ Pt6 (list 0 (*        -1.2 dim_scale TextH j))))1 0)(assoc 10 Data) Data)))        
                                )
                                (entmod Data)
                                (setq i (1+ i) j (+ j (setq Rows (MTextRow801 x ))))) ObjNameL )
)

;文字移動 右揃え-----------------------------------------------------------------------------------------------
(defun TextMove_R ()
        (setq i 0 j 0)
        (mapcar '( lambda (x)
                (cond         ((=(cdr(assoc 0 (setq Data (entget x)))) "TEXT")
                                (setq Data (subst        (cons 72 2)(assoc 72 Data) Data))
                                (setq Data (subst        (cons 73 0)(assoc 73 Data) Data))
                                (setq Data (subst         (cons 11 (trans (mapcar '+ Pt8 (list 0 (*        -1.2 dim_scale TextH j)) (list MaxTextW 0)) 1 0))
                                                        (assoc 11 Data) Data)))
                                ((=(cdr(assoc 0 Data)) "MTEXT")
                                (setq Data (subst        (cons 71 3)(assoc 71 Data) Data))
                                (setq Data (subst         (cons 10 (trans (mapcar '+ Pt6 (list 0 (*        -1.2 dim_scale TextH j)) (list MaxTextW 0)) 1 0)(assoc 10 Data) Data)))                                        )
                )
                (entmod Data)
                (setq i (1+ i) j (+ j (MTextRow801 x )))) ObjNameL )        
)

;最後にXデータを付加-----------------------------------------------------------------------------------------------
(defun Add_X_Data_801 ( )
        ;アプリケーション登録
        (mapcar '(lambda (x) (if         (not (tblsearch "APPID" x))
                                                                (regapp x)))
                                '( "SD801L" "SD801AT"  "SD801AS" "SD801"))        ;リーダー リーダータイプ 子供の場合親を親の場合子供を
        (setq DataL (mapcar 'entget ObjNameL))        ;親から始まるデータリスト
        (setq HandleL (mapcar '(lambda (x) (cdr (assoc 5 (entget x)))) ObjNameL))        ;親から始まるHnリスト
        (setq ObjPoly (vlax-vla-object->ename ObjPoly))
        (setq HnL (cdr (assoc 5 (entget ObjPoly))))                ;リーダーのHn
        ;Leader：親文字ハンドル名&#12539;矢印形式&#12539;矢印サイズを付加
        (entmod (append (entget ObjPoly) (list (list -3         (list "SD801" (cons 1000 (car HandleL)))
                                                                                                                (list "SD801AT" (cons 1000 ArrowType))
                                                                                                                (list "SD801AS" (cons 1000 ArrowSize))
                                                                                                                ))))
        ;親：LeaderのHnと、子供がいれば子供のHnを付加
        (setq Data0 (car DataL))
        (if (cdr HandleL)
                (setq Data0 (append Data0 (list (list -3         (list "SD801L" (cons 1000 HnL))(append '("SD801")        (mapcar '(lambda (x)  (cons 1000 x)) (cdr HandleL)))))))
                (setq Data0 (append Data0 (list (list -3         (list "SD801L" (cons 1000 HnL))))))
        )
        (entmod Data0)               
        ;子供：親のHnを付加
        (if (cdr ObjNameL)
        (mapcar 'entmod (mapcar '(lambda (x) (append x (list (list -3 (list "SD801" (cons 1000 (car HandleL))))))) (cdr DataL)))
        )
)


;レジストリからデータを取得-----------------------------------------------------------------------------------------------
(defun RegistryRead_801()
        (setq Path801 "HKEY_CURRENT_USER\\Software\\SpeedDraftLT\\SD_801")
        
        (if (vl-registry-read Path801 "Text1" )
                (mapcar '(lambda (x) (set_tile x (vl-registry-read Path801 x))) '("Text1" "Text2" "Text3" "Text4"))
        )
               
        (if (vl-registry-read Path801 "ArSize" )
                        (set_tile "Group_2" (vl-registry-read Path801 "ArSize" ))
                        (set_tile "Group_2"  "Size1")
        )
        (if (vl-registry-read Path801 "ArType" )
                        (set_tile "Group_3" (vl-registry-read Path801 "ArType" ))
                        (set_tile "Group_3" "Type1")
        )
        (if (vl-registry-read Path801 "LeadAng" )
                        (set_tile "Group_4" (vl-registry-read Path801 "LeadAng" ))
                        (set_tile "Group_4" "Ang2")
        )
        
        (if (vl-registry-read Path801 "TSize" )
                        (set_tile "Group_5" (vl-registry-read Path801 "TSize" ))
                        (set_tile "Group_5" "TSize1")
        )        
        
        (if (and (vl-registry-read Path801 "Lay1" )(member (vl-registry-read Path801 "Lay1") Laylist1))
                (progn         (set_tile "Lay1" (itoa (vl-position (vl-registry-read Path801 "Lay1") Laylist1)))
                                (setq Lay1 (vl-registry-read Path801 "Lay1"))
                )
                (progn         (setq Lay1 "0")(set_tile "Lay1" "0"))
        )
        (if (and (vl-registry-read Path801 "LT1" )(member (vl-registry-read Path801 "LT1") Laylist3))
                (progn         (set_tile "LT1" (itoa (vl-position (vl-registry-read Path801 "LT1") Laylist3)))
                                (setq LT1 (vl-registry-read Path801 "LT1"))
                )
                (progn         (setq LT1 "ByLayer")(set_tile "LT1" "0"))
        )
        (if (and (vl-registry-read Path801 "Col1" )(member (vl-registry-read Path801 "Col1") Laylist2))
                (progn         (set_tile "Col1" (itoa (vl-position (vl-registry-read Path801 "Col1") Laylist2)))
                                (setq Col1 (vl-registry-read Path801 "Col1"))
                )
                (progn         (setq Col1 "ByLayer")(set_tile "Col1" "0"))
        )
        
        (if (and (vl-registry-read Path801 "Lay2" )(member (vl-registry-read Path801 "Lay2") Laylist1))
                (progn         (set_tile "Lay2" (itoa (vl-position (vl-registry-read Path801 "Lay2") Laylist1)))
                                (setq Lay2 (vl-registry-read Path801 "Lay2"))
                )
                (progn         (setq Lay2 "0")(set_tile "Lay2" "0"))
        )
        (if (and (vl-registry-read Path801 "LT2" )(member (vl-registry-read Path801 "LT2") Laylist3))
                (progn         (set_tile "LT2" (itoa (vl-position (vl-registry-read Path801 "LT2") Laylist3)))
                                (setq LT2 (vl-registry-read Path801 "LT2"))
                )
                (progn         (setq LT2 "ByLayer")(set_tile "LT2" "0"))
        )
        (if (and (vl-registry-read Path801 "Col2" )(member (vl-registry-read Path801 "Col2") Laylist2))
                (progn         (set_tile "Col2" (itoa (vl-position (vl-registry-read Path801 "Col2") Laylist2)))
                                (setq Col2 (vl-registry-read Path801 "Col2"))
                )
                (progn         (setq Col2 "ByLayer")(set_tile "Col2" "0"))
        )
        
        (princ)
)

;ダイアログからデータを取得-----------------------------------------------------------------------------------------------
(defun get_data_801( )

        (setq TextL (mapcar 'get_tile  '("Text1" "Text2" "Text3" "Text4")))
        (mapcar '(lambda (x y)(set x (get_tile y))) '(ArrowSize ArrowType LeadAng TSize) '("Group_2" "Group_3" "Group_4" "Group_5"))

        ;レジストリ書込み
        (mapcar '(lambda (x y) (if (= y "") (vl-registry-write Path801 x "")(vl-registry-write Path801 x y)))
                                '("Text1" "Text2" "Text3" "Text4") TextL)
        (mapcar '(lambda (x y) (vl-registry-write Path801 x y)) '("ArSize" "ArType" "LeadAng") (list ArrowSize ArrowType LeadAng))
        
        (vl-registry-write Path801 "TSize" TSize)
        
        ;作図のときは空欄は詰める
        (setq TextL (vl-remove "" TextL))

        (cond        ((= ArrowSize "Size1")(setq SizeV ( / dim_scale 8)))
                        ((= ArrowSize "Size2")(setq SizeV ( / dim_scale 12)))
                        ((= ArrowSize "Size3")(setq SizeV ( / dim_scale 16)))
                        ((= ArrowSize "Size4")(setq SizeV ( / dim_scale 4)))
                        ((= ArrowSize "Size5")(setq SizeV ( / dim_scale 2)))
        )
        (cond        ((= TSize "TSize1")(setq TextH 2.5))
                        ((= TSize "TSize2")(setq TextH 3.0))
                        ((= TSize "TSize3")(setq TextH 4.0))
        )

        (cond        ((= LeadAng "Ang1")(setq LAng (* 0.5 pi)))
                        ((= LeadAng "Ang2")(setq LAng (* pi ( / 1.0 3.0))))
                        ((= LeadAng "Ang3")(setq LAng (* 0.25 pi)))
        )
        (setq Lay1 (nth (atoi (get_tile "Lay1")) Laylist1))
        (vl-registry-write Path801 "Lay1" Lay1)
        (setq Col1 (nth (atoi (get_tile "Col1")) Laylist2))
        (vl-registry-write Path801 "Col1" Col1)
        (setq LT1 (nth (atoi (get_tile "LT1")) Laylist3))
        (vl-registry-write Path801 "LT1" LT1)
        
        (setq Lay2 (nth (atoi (get_tile "Lay2")) Laylist1))
        (vl-registry-write Path801 "Lay2" Lay2)
        (setq Col2 (nth (atoi (get_tile "Col2")) Laylist2))
        (vl-registry-write Path801 "Col2" Col2)
        (setq LT2 (nth (atoi (get_tile "LT2")) Laylist3))
        (vl-registry-write Path801 "LT2" LT2)
        (princ)
)


;MTextRow------------------------------------------------------------------
(defun MTextRow801 (ObjName / Data1 Data40 Data43 Data44)
        (setq Data1 (entget ObjName))
        (cond         ((= (cdr (assoc 0 Data1)) "TEXT")
                        (setq Rows 1))
                        ((= (cdr (assoc 0 Data1)) "MTEXT")
                        (setq Data40 (cdr (assoc 40 Data1)))
                        (setq Data43 (cdr (assoc 43 Data1)))
                        (setq Data44 (cdr (assoc 44 Data1)))
                        (setq Rows (fix (1+ ( / (* (- Data43 Data40) 0.6 ) Data40 Data44)))))
        )
        Rows
)

;TextW=====================
(defun GetTextW_801 (ObjName / Data ObjName)
        (setq Data (entget ObjName))
        (cond        ((=(cdr(assoc 0 Data)) "TEXT")
                        (setq TextW (- (caadr (textbox Data)) (caar (textbox Data))))
                        )
                        ((=(cdr(assoc 0 Data)) "MTEXT")
                        (setq TextW (cdr(assoc 42 Data)))
                        )
        )
        TextW
)


;********************************
(defun get_layer&ltype&color()
        (setq         Lay (tblnext "LAYER" T)
                        LT (tblnext "LTYPE" T)
                        Laylist1 (list)
                        Laylist2 (list "ByLayer" "Red" "Yellow" "Green" "Cyan" "Blue" "Magenta" "B/W")
                        Laylist3 (list"ByLayer")
        )
        (While Lay
                (setq lay1 (list (cdr (assoc 2 Lay)))
                          lay2 (cdr (assoc 62 Lay))
                          lay3 (list (cdr (assoc 6 Lay)))
                          Laylist1 (append Laylist1 lay1)
                          Laylist3 (append Laylist3 lay3)
                          Lay (tblnext "LAYER")
                 )
                  (if (> lay2 7)(setq  lay2 (list (itoa lay2)) Laylist2 (append Laylist2 lay2)))
        )
        (While LT
                (setq lay3 (list (cdr (assoc 2 LT)))
                          Laylist3 (append Laylist3 lay3)
                          LT (tblnext "LTYPE")
                 )
        )
        (setq         Laylist1 (RemoveOverlap Laylist1)
                        Laylist2 (RemoveOverlap Laylist2)
                        Laylist3 (RemoveOverlap Laylist3))
)

;************************
(defun RemoveOverlap (        List2        /        List1        )
        (while List2
                (setq List1 (append List1 (list (car List2))))
                (setq List2 (vl-remove (car List2) List2))
        )
        List1
)

;*****************
(setq *ModelSpace*
           (vla-get-ModelSpace
                 (vla-get-ActiveDocument (vlax-get-acad-object))
           )
)
;*****************
(setq *PaperSpace*
           (vla-get-PaperSpace
                 (vla-get-ActiveDocument (vlax-get-acad-object))
           )
)



;共通コマンド
(defun SD1028 ()
  (setq OldCmdEcho (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (command "undo" "be")
  (setq OldOsmode (getvar "OSMODE"))
  (setq OldLayer (getvar "CLAYER"))
  (setq OldLType (getvar "CeLType"))
  (setq OldCeLWeight (getvar "CeLWeight"))
  (setq OldColor (getvar "CeColor"))
  (setq OldOrtho (getvar "ORTHOMODE"))
  (setq OldDStyle  (getvar "DIMSTYLE"))
  (setq OldExpert (getvar "Expert"))
  (setvar "EXPERT" 0)
  (setq Path_Lang "HKEY_CURRENT_USER\\Software\\SpeedDraftLT")
  (if (vl-registry-read Path_Lang "SD_Language" )
          (setq SD:Lang (vl-registry-read Path_Lang "SD_Language" ))
          (progn        (setq SD:Lang "J")
                          (vl-registry-write Path_Lang "SD_Language" "J")
          )
  )
  (princ)
)
;********************************
(defun SD2056 ()
  (setvar "OSMODE" OldOsmode)
  (command "undo" "end")
  (setvar "CLAYER" OldLayer)
  (setvar "CeLType" OldLType)
  (setvar "CeLWeight" OldCeLWeight)
  (setvar "CeColor" OldColor)
  (setvar "ORTHOMODE" OldOrtho)
  (setvar "Expert" OldExpert)
  (if (and (/= (getvar "DIMSTYLE") OldDStyle)(tblsearch "DIMSTYLE" OldDStyle))
          (command "-dimstyle" "Restore" OldDStyle)
  )
  (princ "\n (C)OffshoreCad&Management")
  (setvar "CMDECHO" OldCmdEcho)
  (princ)
)



(if (= SD:Lang "E")
        (princ "\n Command Name: SD_801 \n")
        (princ "\n コマンド名：SD_801 \n")
)
(princ)

浪子_无限

yaokui25 发表于 2014-6-28 16:18
MakeCallOut : dialog {        
        label = "Call Out Text" ;
        initial_focus="Text1";
...

代码如此强大，想想也是醉了

晒日光浴的雪人3

功能看来比较完美了．要是能自动对齐就更好