0 Members and 1 Guest are viewing this topic.
... the name of the UCS: "my_ucs" or "rbi_schnitte"?
(cdr (assoc -1 (entget (tblobjname "ucs" "my_ucs")))))
(tblobjname "ucs" "my_ucs")
Maybe gc 11 and 12 have to be unit vectors in AC?....
;;;rem:Use this function only for DEBUG mode(Defun ACRX_T(s183 / rr) (setq rr nil) (setq rr (if (= (type s183) (quote STR)) s183 (prompt "\nt183errorS**")))rr) (princ) ;;{$R dfn_cad_amain2};;rem:dfn_cad_amain(Defun C:PET() (setq;|a31827|; dfn_pp_v1chkR nil) (pp_peter2ucs_app))(setq const_systasserte nil acad__assertNo 0)(Defun asserte(mssg / rr) (setq;|a32447|; acad__assertNo (+ acad__assertNo 1)) (if (/= mssg nil) (setq;|a32489|; erprv erlsp erlsp mssg)) erlsp)(DeFun C:pp_peter2ucs_app() (pp_peter2ucs_app ))(prompt "\nCommand.com= PET[enter]\n")(Defun pp_peter2ucs_app( / ) ;;{$R (call_stas)};------------------------Stdcall pp_peter2ahsattarian (setq _ax (pp_peter2ahsattarian ));------------------------ ;;{$R dfn_cad_amain_callend2} (princ "\nEnd") T);(User Labels);(pp_peter2ahsattarian);;{$R pp_peter2ahsattarian}(setq m_NorthUcsName "my_ucs")(Defun pp_peter2ahsattarian( / $rr ask jcxz nop dof) (progn (setq;|a37166|; jcxz 1) (while (> jcxz 0) (progn (setq;|a37200|; ask (dfn_getx_readkey "[APXHCN]" (strcat m_NorthUcsName "->(P.peter) (A.ahsattarian)(N.newname)(C.checkExists)(X.Exit)(H.Help))"))) (if (= ask "H") (alert readme.txt) (if (= ask "P") (setq;|a37296|; m_NorthUcsName (pp_dviewpeter m_NorthUcsName)) (if (= ask "A") (setq;|a37338|; m_NorthUcsName (pp_dviewahsattarian m_NorthUcsName)) (if (= ask "N") (progn (setq;|a37396|; $rr (getstring (strcat "\nNewname(" m_NorthUcsName ")=")) $rr (if (= $rr nil) m_NorthUcsName $rr) $rr (if (> $rr "") $rr m_NorthUcsName) m_NorthUcsName (if (> $rr "") $rr "my_ucs"))) (if (= ask "C") (setq;|a37574|; jsr (list "\ndfn_ucs_remove=" (dfn_ucs_remove m_NorthUcsName T) (grread)) $rr (foreach dof jsr (princ dof))) (if (= ask "X") (setq;|a37702|; jcxz (- 1978.0920))))))))) (setq;|a37730|; jcxz (+ jcxz 1)))) $rr);Lib:free;;{$R dfn_ucs_remove};;Out:$rr=(1.ok)(<0.failed)(2.removedSucces)(0.already not exists)(Defun dfn_ucs_remove(ucs_name checkagain / $rr nop) (setq;|a40335|; $rr 0 nop (if (= (type ucs_name) (read "STR")) ucs_name nil)) (if (and nop (> nop "") (tblobjname "ucs" nop)) (progn (command_s "_ucs" "_world") (entdel (cdr (assoc (- 1) (entget (tblobjname "ucs" nop))))) (if checkagain (dfn_sleep 100)) (setq;|a40553|; $rr 1))) (if (and nop (= $rr 1) checkagain) (progn (setq;|a40601|; $rr (if (= (tblobjname "ucs" nop) nil) 2 RTCAN)))) $rr);;{$R dfn_getx_readkey};;Inf:Wait until press keys k;;Inp:k574:keys =("".none);;rem: m469=(nil.none)(else.prompt message);;Out:rr:char('A'..'Z');;Err: "t469errorStr". invalid type of variabile t469, must be STR;;ByA:DragneAdrian(defun dfn_getx_readkey(k574 t469 / retc kbd msg two chk lei tip) (setq;|a43704|; retc (chr 0) tip (quote STR) kbd (if (/= (type k574) tip) "" k574) msg (if (/= (type t469) tip) "\nt469errorStr:" t469)) (prompt msg) (progn (setq;|a43842|; chk (if (> (strlen kbd) 1) 0 1)) (while (= chk 0) (progn (setq;|a43898|; two 0) (while (/= two 2) (setq;|a43936|; lei (grread) two (car lei)) (setq;|a43984|; retc (strcase (chr (cadr lei)))) (setq;|a44024|; chk (if (/= kbd "") (if (wcmatch retc kbd) 1 0) 0)))))) (princ retc) retc);Lib:free;;{$R pp_dviewpeter}(Defun pp_dviewpeter(ucs1name / $rr p1 p2 z ucs_code) (setq;|a50089|; z 0 p1 (getpoint "\nFirst1Point=") p1 (if (= p1 nil) (getvar "VIEWCTR") p1) p2 (getpoint p1 "\nSecond2Point=") ucs1name (if (/= (type ucs1name) (read "STR")) "my_ucs" ucs1name) ucs1name (if (> ucs1name "") ucs1name "my_ucs") $rr (getstring (strcat "\nGet UcsName(" ucs1name ")="))) (setq;|a50335|; $rr (if (= $rr nil) ucs1name $rr)) (setq;|a50371|; $rr (if (> $rr "") $rr "my_ucs")) (if (and (> $rr "") (tblobjname "ucs" $rr)) (progn (command "_ucs" "_world") (entdel (cdr (assoc (- 1) (entget (tblobjname "ucs" $rr))))))) (princ "\nUcs1Name=") (princ $rr) (setq;|a50557|; ucs_code (if (> $rr "") (list (cons 0 "UCS") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbUCSTableRecord") (cons 2 $rr) (cons 70 0) (cons 10 (list (car p1) (cadr p1) z)) (cons 11 (list (- (car p2) (car p1)) (- (cadr p2) (cadr p1)) 0)) (cons 12 (list (* (- 1.0) (- (cadr p2) (cadr p1))) (- (car p2) (car p1)) 0)) (cons 79 0) (cons 146 0)) nil)) (if ucs_code (entmakex ucs_code)) (princ) $rr);Lib:free;;{$R pp_dviewahsattarian}(defun pp_dviewahsattarian (ucs2name / p3 p4 jsr z $rr j_bipush) (setq;|a57587|; z 0.0 jsr (list z z z) p3 (getpoint "\nFirst3Point=") p3 (if (= p3 nil) (getvar "VIEWCTR") p3) p4 (getpoint p3 "\nSecond4Point=") ucs2name (if (/= (type ucs2name) (read "STR")) "my_ucs" ucs2name) ucs2name (if (> ucs2name "") ucs2name "my_ucs") $rr (getstring (strcat "\nGet UcsName(" ucs2name ")=")) $rr (if (= $rr "") ucs2name $rr) $rr (if (= $rr nil) ucs2name $rr) $rr (if (> $rr "") $rr "my_ucs")) (if (and (> $rr "") (tblobjname "ucs" $rr)) (progn (command "_ucs" "_world") (entdel (cdr (assoc (- 1) (entget (tblobjname "ucs" $rr))))))) (princ "\nUcs2Name=") (princ $rr) (setq;|a58131|; j_bipush (list (cons 0 "UCS") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbUCSTableRecord") (cons 2 $rr) (cons 70 0) (cons 10 (acet-geom-unit-vector jsr (list (car p3) (cadr p3) z))) (cons 11 (acet-geom-unit-vector jsr (list (- (car p4) (car p3)) (- (cadr p4) (cadr p3)) 0))) (cons 12 (acet-geom-unit-vector jsr (list (- (cadr p3) (cadr p4)) (- (car p4) (car p3)) 0))) (cons 79 0) (cons 146 0))) (entmakex j_bipush) (command "ucs" "restore" "?" "*" "") (terpri) $rr);Lib:free;;{$R dfn_sleep}(Defun dfn_sleep(mili / rr strdelay) (setq;|a59542|; strdelay "CDATE") (progn (setq;|a59566|; rr (+ (getvar strdelay) (* mili 0.000000001))) (while (> rr (getvar strdelay)))) rr);Lib:free;;{$R coff_linkerarx} (setq readme.txt "entmake UCS: Bricscad sucess, Autocad fail? «zlib=../cl_aclayer/entviewe/2020/pp_peter2ucs.vlax»")
