留言板
- lff763
- 求修改一下lsp，添加上比例设置http://bbs.xdcad.net/thread-676482-1-1.html
和http://bbs.xdcad.net/thread-676476-1-1.html
- lff763
- 请你给我写个程序，见我的贴子
- yoyoho
- 牢固版主你好!
【Gu_xl】动态复制、移动（可缩放、旋转、镜像、对齐等）程序有点问题
改基点[T]----有问题!
在未COPY前修改基点[T],基点位置正确,
但COPY 1个物件以后再修改基点[T],基点位置跑掉了(偏移了,不是想要的位置点)
期盼 牢固版主 拨空修正一下,谢谢!
- A82613035
- 牢固你好，謝謝你終於可以用，在一次謝謝你，小弟把 216D豆給你，要如何給你，因為我不會用請你指導一下
- A82613035
- 牢固你好，實在很抱歉，上次所提[右鍵菜單函數.LSP]是 wowan1314 所提出，小弟不知如何寫驅動函數的主程序，可以請你指導如何寫，下面是LISP程式在2013下 顯示 "沒有框" 可以提示小弟一下，也沒有動作
;;===================================================右鍵菜單函數V1.0--先關閉捕捉===========BY WOWAN1314
;; 思路來源----G版 程序製作：----WOWAN1314
;;主要參考資料: CAOYIN刷子函數及"流浪水手"的拖拽實例。其他不一一點名了。基本是拼湊出來的。
;; 感謝G版，caoyin 流浪水手 ...等。 一發程序發現大部分都是別人寫的。有的都不記的作者了。哎。怪不得好多人都不敢發
;;免責聲明：本著開源精神，本代碼可隨意複製。僅供參考、交流。實際工作不得使用，否則後果自負。
;;============================================================================================;;
;;PT表格產生點，len格子大小。tuxian為要作底的文字內容.
;;WZLST為要寫的文字表.LEN1橫向長度,共計5個參數TUXIAN可為NIL，其他必須有值.
;;表格橫向固定2格，豎向多少格由文字表決定. 橫向長度自定. 文字樣式隨當前
;;返回值：表(1 "DN15").第一個表示選擇的第幾格，第二項為文字內容.
;;============================================================================================;;
(DEFUN YY:YJCAIDAN (PT LEN LEN1 WZLST TUXIAN / DO_MOVE
X Y PMPT X1 X0 Y0 Y1
GPLST HANGSHU I BEEN P1 P2
P3 P4 PLST P1LST WIPE WZNAMLST
WZGZ WPT WZHIGH YH_SPC YH_TEXT WZ
OLDHI BEEND LOOP CODE NEWWZ
)
;;================================動態函數
(defun DO_MOVE (PT0 / I GPT WZGZ WZ HIGH WZ1)
(SETQ I -1)
(WHILE (AND I (< I (LENGTH GPLST)))
(SETQ I (1+ I)
WZGZ (NTH I GPLST)
)
(IF (AND (< (CAR (CAR WZGZ)) (CAR PT0) (CAR (CADR WZGZ)))
(< (CADR (CAR WZGZ)) (CADR PT0) (CADR (CADR WZGZ)))
(SETQ WZ (NTH I WZNAMLST))
)
(PROGN (SETQ
HIGH (* 1.2 (DXF_READ 40 (cadr WZ)))
)
(setq wz1 (car wz)
WZ (CADR WZ)
)
(if (/= WZ1 OLDWZ1)
(PROGN
(redraw)
(YY_SubUpd WZ 62 6)
(YY_SubUpd WZ 40 HIGH)
(YY_SubUpd OLDWZ 62 3)
(YY_SubUpd OLDWZ 40 OLDHI)
(setq oldwz1 wz1
OLDWZ WZ
)
(GRVECS (LIST -6
(CAR WZGZ)
(CADDR WZGZ)
-6
(CADDR WZGZ)
(CADR WZGZ)
-6
(CADR WZGZ)
(LAST WZGZ)
-6
(LAST WZGZ)
(CAR WZGZ)
)
)
)
)
(SETQ NUM (1+ I)
I NIL
)
)
)
)
(IF I
(PROGN (YY_SubUpd OLDWZ 62 3)
(YY_SubUpd OLDWZ 40 OLDHI)
(SETQ OLDWZ1 NIL
OLDWZ NIL
)
(redraw)
)
)
)
;|
;;主程序之起始參數
;;給定文字表及已選文字
(setq WZlst '("DN15" "DN20" "DN32" "DN40" "DN50"
"DN65" "DN75" "DN80" "DN100" "DN300" "DN150" "DN200" "你好"
)
)
(SETQ PT (GETPOINT)
len (p2u222 88)
OLDWZ "DN75"
LEN1 (* 0.26 (STRLEN (CAR WZLST)) LEN);;計算橫向長度
)
|;
;;主程序
(SETQ X (CAR PT)
Y (CADR PT)
)
(SETQ PMPT (YY_pm2pt)
X1 (+ X (* 2 LEN1))
X0 (CAR (CADR PMPT))
Y0 (CADR (CAR PMPT))
Y1 (- Y (* (ATOI (RTOS (* (LENGTH WZLST) 0.5) 2 0)) 0.5 LEN))
)
(AND (> X1 X0)
(SETQ X (- X (- X1 X0)))
) ;當超過屏幕右邊線
(AND (< Y1 Y0)
(SETQ Y (+ Y (- Y0 Y1)))
) ;當超過屏幕底邊線
;;計算起始點及WIPEOUT作底
(SETQ GPLST '())
(SETQ HANGSHU (1+ (ATOI (RTOS (* (LENGTH WZLST) 0.5) 2 0)))
i 1
BEEN (ENTLAST)
Y1 (- Y (* (ATOI (RTOS (* (LENGTH WZLST) 0.5) 2 0)) 0.5 LEN))
)
(SETQ P1 (LIST X Y 0)
P2 (LIST (+ X (* 2 LEN1)) Y 0)
P3 (LIST X Y1 0)
P4 (LIST (+ X (* 2 LEN1)) Y1 0)
)
;;先畫底框.用WIPEOUT作底比SOLID好些
;(VL-CMDF "WIPEOUT" P1 P2 P4 P3 "")
(gxl-makewipeout (LIST P1 P2 P4 P3))
;(YY:solid P1 P2 P3 P4 18)
(while (<= i hangshu)
(SETQ P1 (LIST X Y 0)
P2 (LIST (+ X (* 2 LEN1)) Y 0)
P3 (LIST (+ X LEN1) Y 0)
Y (- Y (* LEN 0.5))
)
(YY:MAKLINE P1 P2 62 "Continuous")
(IF (> I 1)
(SETQ GPLST
(CONS (LIST P3 (CADR PLST) P2 (LAST PLST))
(CONS (LIST P1 (LAST PLST) P3 (CAR PLST)) GPLST)
)
)
)
(SETQ PLST (LIST P1 P2 P3))
(IF (= I 1)
(SETQ P1LST PLST)
)
(SETQ I (1+ I))
)
;;畫橫線結束
(SETQ GPLST (REVERSE GPLST))
;;畫豎線
(YY:MAKLINE (CAR P1LST) (CAR PLST) 3 "Continuous")
(YY:MAKLINE (CADR P1LST) (CADR PLST) 3 "Continuous")
(YY:MAKLINE (CADDR P1LST) (CADDR PLST) 3 "Continuous")
(SETQ WIPE (ENTLAST)
WZNAMLST '()
)
(SETQ I -1)
(foreach WZ WZLST
(SETQ I (1+ I)
WZGZ (NTH I GPLST)
WPT (YY:Mid (CAR WZGZ) (CADR WZGZ))
)
(SETQ WZhigh (* 0.23 LEN))
(AND (= WZ TUXIAN)
(YY:solid (CAR WZGZ)
(CADDR WZGZ)
(LAST WZGZ)
(CADR WZGZ)
19
)
;;原文字對應的底框SOLID實體
;;(SETQ SOLD (ENTLAST))
)
(if (not *YH_doc*)
(setq *YH_doc* (vla-get-activedocument (vlax-get-acad-object)))
) ;獲取當前圖檔指針
(setq YH_spc (vla-get-modelspace *YH_doc*))
;獲取當前圖檔模型空間指針
(setq YH_text (vla-addtext YH_spc WZ (vlax-3d-point WPT) WZhigh))
;生成文字
(vla-put-alignment YH_text acAlignmentMiddle) ;對齊方式設為居中對齊
(vla-put-textalignmentpoint YH_text (vlax-3d-point WPT))
;將文字歸位
(vla-put-stylename YH_text (getvar "TEXTSTYLE")) ;修改文字的樣式
(vla-put-COLOR YH_text 3) ;修改文字的顏色
(SETQ WZNAMLST (CONS (LIST WZ (ENTLAST)) WZNAMLST))
)
(SETQ WZNAMLST (REVERSE WZNAMLST))
(SETQ WZ (NTH 0 WZNAMLST)
OLDHI (DXF_READ 40 (cadr WZ))
)
(SETQ BEEND (last_ent BEEN))
;;所有產生的物體的選擇集
;;動態部分
(SETQ LOOP T)
(WHILE LOOP
(setq code (grread NIL 13 2))
(cond
((NOT (member (car code) '(3 11 25))) (DO_MOVE (CADR CODE)))
;;移動
((member (car code) '(11 25)) (SETQ LOOP NIL))
;;右鍵 退出
((= (car code) 3)
(DO_move (CADR CODE))
(AND OLDWZ1 (SETQ LOOP NIL))
)
)
)
(IF OLDWZ1
(SETQ NEWWZ OLDWZ1)
)
(COMMAND "ERASE" BEEND "")
;;刪除過程物
(redraw)
(LIST NUM NEWWZ)
)
;;;======================函數取得EN之後生成的所有圖元的選擇集
(defun last_ent (en / ss)
(if en
(progn
(setq ss (ssadd))
(while (setq en (entnext en))
(if (not (member (cdr (assoc 0 (entget en)))
'("ATTRIB" "VERTEX" "SEQEND")
)
)
(ssadd en ss)
) ;if
) ;while
(if (zerop (sslength ss))
(setq ss nil)
)
ss
) ;progn
(ssget "_x")
) ;if
)
;;;===========================================ENTMAKE LINE
;;;調用形式 (YY:MAKLINE 起點坐標 終點坐標 顏色 線型)，如果成功，返回定義數據的圖元表
(defun YY:MAKLINE (listStartPoint listEndPoint COL LINETYLE)
(entmake (list '(0 . "LINE")
(cons 62 COL)
(cons 6 LINETYLE)
(cons 10 listStartPoint)
(cons 11 listEndPoint)
)
)
)
;;;=================================求中點函數
(defun YY:Mid (p1 P2 / X Y)
(if (= (length p1) (length p2))
nil
(setq p1 (list (car p1) (cadr p1))
p2 (list (car p2) (cadr p2))
)
)
(mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) P1 P2)
)
;;;================================製作SOLD填充函數
(defun YY:solid (p1 p2 p3 p4 COL)
(entmakex (list (cons 0 "SOLID")
(cons 100 "AcDbEntity")
(cons 62 COL)
(cons 100 "AcDbTrace")
(cons 10 P1)
(cons 11 P2)
(cons 12 P3)
(cons 13 P4)
)
)
)
;;===================================根據圖元名讀 組碼函數
(defun dxf_read (code ename)
(cdr (assoc code (entget ename)))
)
;;================================================(gxl-makewipeout pts) 繪製WipeOut By Gu_xl
;;用法: (gxl-makewipeout (list (getpoint "\n點:") (getpoint "\n點:") (getpoint "\n點:") (getpoint "\n點:")))
(defun gxl-makewipeout (PTS / LL UR wh w h CP LST ANG)
(if (not (member "acismui.arx" (arx)))
(ARXLOAD "acismui.arx")
)
(if (not (equal (car pts) (last pts) 1e-6))
(setq pts (cons (last pts) pts))
)
(setq ll (apply 'mapcar (cons 'min pts))
ur (apply 'mapcar (cons 'max pts))
wh (mapcar '- ur ll)
w (car wh)
h (cadr wh)
cp (mapcar '* (mapcar '+ ll ur) '(0.5 0.5 0.5))
)
(foreach pt pts
(setq lst (cons (list 14
(/ (car (setq pt (mapcar '- pt cp))) w)
(- (/ (cadr pt) h))
)
lst
)
)
)
(setq lst (reverse lst))
(entmakex
(append
(list
'(0 . "WIPEOUT")
'(100 . "AcDbEntity")
'(100 . "AcDbWipeout")
(cons 10 ll)
(list 11 w 0.0)
(list 12 0.0 h)
'(280 . 1)
'(71 . 2)
)
lst
)
)
)
;; YY_SubUpd =========更新組碼以修改實體函數
(defun YY_SubUpd (ename code val / ent x y i s1)
(IF (= (type ename) 'ENAME)
(PROGN
(setq ent (entget ename))
(if (and (= (type code) 'LIST) (= (type val) 'LIST))
(mapcar '(lambda (x y) (YY_SubUpd ename x y)) code val)
(progn
(if (= (dxf_read code ename) nil)
(entmod (append ent (list (cons code val))))
(entmod (subst (cons code val) (assoc code ent) ent))
)
(entupd ename)
)
)
)
)
ename
)
;;==========================求屏幕兩對角點
(defun YY_pm2pt (/ a b c d x)
(setq b (getvar "viewsize")
c (car (getvar "screensize"))
d (cadr (getvar "screensize"))
a (* b (/ c d))
x (trans (getvar "viewctr") 1 2)
c (trans (list (- (car x) (* a 0.5)) (- (cadr x) (* b 0.5)) 0.0)
2
1
)
d (trans (list (+ (car x) (* a 0.5)) (+ (cadr x) (* b 0.5)) 0.0)
2
1
)
)
(list c d)
)
;;;===========================================得到當前屏幕的大小比例
( defun p2u222 ( pix )
( * pix ( / ( getvar "viewsize" ) ( cadr ( getvar "screensize" ) ) ) )
)
;;;======================{ 示例代碼：修改替換管徑文字}====================;;
;;;
( DEFUN C:T11 ( / EN WZTXT WZLST LEN OLDWZ LEN1 SNAP WZ *error* error_end )
;;-------------------------------出錯函數
( defun *error* ( x ) ( error_end ) ( command "_.undo" "1" ) )
( defun error_end ( )
( AND snap ( setvar "osmode" snap ) ) ;打開捕捉
( command "_.undo" "e" ) ;結束編組
;回到當初
( REDRAW ) ;刷新當前
)
;;主函數
( command "_.undo" "Be" )
( WHILE ( SETQ EN ( entsel "\n選擇要修改管徑的文字：" ) )
( IF ( AND ( SETQ WZTXT ( DXF_READ 1 ( CAR EN ) ) )
( wcmatch WZTXT "DN15" )
) ;管徑
( PROGN
( SETQ WZLST ( LIST "DN15" "DN20" "DN32" "DN40"
"DN50" "DN65" "DN75" "DN80"
"DN100" "DN300" "DN150" "DN200"
"你好"
)
)
( SETQ len ( p2u222 88 )
OLDWZ WZTXT
LEN1 ( * 0 .26 4 LEN )
;;計算橫向長度
)
;(YY:YJCAIDAN PT LEN LEN1 WZLST TUXIAN)
( setq snap ( getvar "osmode" ) )
( setvar "osmode" 0 ) ;關閉
( IF ( SETQ WZ ( CADR ( YY:YJCAIDAN ( CADR EN ) LEN LEN1 WZLST OLDWZ ) ) ) ;;調用菜單函數
( YY_SubUpd ( CAR EN ) 1 WZ ) ;;此處放回調函數
) ; IF
);PROGN
) ;END IF
) ; WHILE
( error_end )
( PRINC )
) ;END DEFUN
- A82613035
- 牢固你好，小弟再修煉幾年LISP後估計只能看半懂，或是不懂，小弟把家產***D豆，與你換完整程式[右鍵菜單函數.LSP]，小弟需要此程式，或者是小弟不知如何寫驅動函數的主程序，可以請你指導如何寫
