(setq bb (cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 insert_def)))))
ip (cdr (assoc 10 insert_def))
ir (cdr (assoc 50 insert_def))
ix (cdr (assoc 41 insert_def))
iy (cdr (assoc 42 insert_def))
iz (cdr (assoc 43 insert_def))
a10 (mapcar
'*
(polar ip ir (distance ip
(mapcar '- (cdr (assoc 10 attdef_def)) bb)))
(list ix iy iz))
a11 (mapcar
'*
(polar ip ir (distance bb
(mapcar '- (cdr (assoc 11 attdef_def)) bb)))
(list ix iy iz)))
(DEFUN ENTMAKEBLOCK (BLOCKNAME BPOSITION BLAYER BCOLOR BLINETYPE BSCALE)
(SETQ IATTDEFS NIL)
(SETQ BATTLIST (LIST "TEST1" "TEST2"))
(IF (SETQ INSENT (TBLOBJNAME "BLOCK" BLOCKNAME))
(WHILE INSENT
(IF (= (CDR (ASSOC 0 (SETQ IBLOCKENT (ENTGET INSENT))))
"ATTDEF"
)
(SETQ IATTDEFS (CONS IBLOCKENT IATTDEFS))
)
(SETQ INSENT (ENTNEXT INSENT))
)
)
(SETQ SYMBOLINSBASE (CDR (ASSOC 10 (TBLSEARCH "BLOCK" BLOCKNAME))))
(ENTMAKE (LIST (CONS 0 "INSERT") (CONS 100 "AcDbBlockReference") (CONS 100 "AcDbEntity")
(CONS 2 BLOCKNAME) (CONS 6 BLINETYPE) (CONS 8 BLAYER) (CONS 10 BPOSITION)
(CONS 41 BSCALE) (CONS 42 BSCALE) (CONS 43 BSCALE) (CONS 50 0.0) (CONS 62 BCOLOR) (CONS 66 (IF IATTDEFS 1 0))))
(SETQ BCOUNT -1)
(WHILE IATTDEFS
(SETQ BATTENT (CAR IATTDEFS))
(SETQ IATTDEFS (CDR IATTDEFS))
(SETQ BATTSTR (NTH (SETQ BCOUNT (1+ BCOUNT)) BATTLIST))
(ENTMAKE (LIST (CONS 0 "ATTRIB")
(CONS 100 "AcDbAttribute")
(CONS 100 "AcDbEntity")
(CONS 1 (IF BATTSTR BATTSTR ""))
(ASSOC 2 BATTENT)
(ASSOC 6 BATTENT)
(ASSOC 7 BATTENT)
(ASSOC 8 BATTENT)
(CONS 10 (MAPCAR (QUOTE *) (POLAR BPOSITION 0.0 (DISTANCE BPOSITION (MAPCAR (QUOTE -) (CDR (ASSOC 10 BATTENT)) SYMBOLINSBASE)))
(LIST BSCALE BSCALE BSCALE)))
(CONS 11 (MAPCAR (QUOTE *) (POLAR BPOSITION 0.0 (DISTANCE SYMBOLINSBASE (MAPCAR (QUOTE -) (CDR (ASSOC 11 BATTENT)) SYMBOLINSBASE)))
(LIST BSCALE BSCALE BSCALE)))
(CONS 40 BSCALE)
(ASSOC 41 BATTENT)
(ASSOC 50 BATTENT)
(ASSOC 51 BATTENT)
(ASSOC 62 BATTENT)
(ASSOC 70 BATTENT)
(ASSOC 71 BATTENT)
(ASSOC 72 BATTENT)
(ASSOC 73 BATTENT)
(ASSOC 74 BATTENT))))
(ENTMAKE (LIST (CONS 0 "SEQEND") (CONS 8 BLAYER)))
(ENTLAST))
;;; ==========================================================================
;;; E_Insert - adapted from the swamp [ ABLKInsert ]
;;; place block with Emake instead of command INSERT
;;; usage: (E_Insert BlockName InsPunt insLayer )
;;; -
;;; these may have a preset value, which will be used and reset to nil:
;;; E_InsPt E_rAng E_dAng E_Color E_Scale
;;; ==========================================================================
(defun E_Insert (BlockName E_InsPt E_InsLay / Ename NextEnt Data Attdefs Attblk pt10 pt11)
(setq E_InsPt (ifnot E_InsPt '(0 0) E_InsPt)
E_rAng (if E_rAng ; wordt nil gemaakt aan einde
E_rAng
(if E_dAng ; E_dAng = angel in degrees.
(deg_rad E_dAng)
0
)
)
E_Color (ifnot E_Color 256) ; wordt nil gemaakt aan einde
E_Scale (ifnot E_Scale 1.0) ; wordt nil gemaakt aan einde
E_InsLay (ifnot E_InsLay (getvar "clayer"))
)
;; alleen als het block al bestaat ....
(cond ((setq Ename (tblobjname "block" BlockName)) ; tblsearch
;; get Parent entity name
(setq NextEnt (entnext Ename))
;; first sub entity
(while NextEnt
;; get ATTDEF subentities
(setq Data (entget NextEnt))
(if (= "ATTDEF" (cdr (assoc 0 Data)))
(setq Attdefs (cons Data Attdefs))
)
(setq NextEnt (entnext NextEnt))
)
(setq Attblk (if (= nil attdefs)
0
1
)
) ;(pri "attdefs")
(and (entmake ;; entmake insert
(list '(0 . "INSERT")
'(100 . "AcDbBlockReference")
(cons 8 E_InsLay) ; layer name
(cons 66 Attblk)
(cons 2 BlockName)
(cons 10 E_InsPt) ; Insert Point
(cons 41 E_Scale)
(cons 42 E_Scale)
(cons 43 E_Scale)
(cons 50 E_rAng) ; Rotation angle default = 0
(cons 62 E_Color) ; E_Color 256 = bylayer
)
)
(foreach x (reverse Attdefs)
;; voor de atributen met FIT alignments....
(setq pt10 (plusXY (cdr (assoc 10 x)) E_InsPt))
(setq pt11 (plusXY (cdr (assoc 11 x)) E_InsPt))
;; entmake ATTRIBs based on ATTDEFS
(entmake (list '(0 . "ATTRIB")
(assoc 8 x)
(cons 10 pt10)
(assoc 40 x)
(assoc 1 x)
(assoc 50 x)
(assoc 41 x)
(assoc 51 x)
(assoc 7 x)
(assoc 71 x)
(assoc 72 x)
(cons 11 pt11)
(assoc 2 x)
(assoc 70 x)
(assoc 73 x)
(assoc 74 x)
)
)
)
(entmake '((0 . "SEQEND") (8 . "0"))) ; entmake SEQEND
)
)
(t nil)
)
(setq ent (entlast)
E_InsPt nil
E_rAng nil
E_dAng nil
E_Color nil
E_Scale nil
)
)
;; ==========================================================================
;; used routine.. (cause i sometimes forget how mapcar works)
(defun Plusxy (p disp / p3) ; ipv polar mag 2D en 3D zijn.
(setq p3 (mapcar '+ p disp)) ; telt afstand (x,y,z) op bij punt (x,y,z)
)
;; littlebit shorter if nil check function
(defun ifnot (def new /)
(if def
def
new
)
)
(defun deg_rad (fDeg) (/ (* fDeg pi) 180))
some words may look funny, they are not! I am Dutch.